1202 lines
38 KiB
Fortran
1202 lines
38 KiB
Fortran
!$Id: cac_anthro_mod.f,v 1.2 2012/03/01 22:00:26 daven Exp $
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: cac_anthro_mod
|
|
!
|
|
! !DESCRIPTION: Module CAC\_ANTHRO\_MOD contains variables and routines to
|
|
! read the Criteria Air Contaminant Canadian anthropogenic emissions
|
|
! (amv, phs, 1/28/2009)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
MODULE CAC_ANTHRO_MOD
|
|
!
|
|
! !USES:
|
|
!
|
|
IMPLICIT NONE
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: CLEANUP_CAC_ANTHRO
|
|
PUBLIC :: EMISS_CAC_ANTHRO
|
|
PUBLIC :: EMISS_CAC_ANTHRO_05x0666
|
|
PUBLIC :: GET_CANADA_MASK
|
|
PUBLIC :: GET_CAC_ANTHRO
|
|
!
|
|
! !PRIVATE MEMBER FUNCTIONS:
|
|
!
|
|
PRIVATE :: CAC_SCALE_FUTURE
|
|
PRIVATE :: READ_CANADA_MASK
|
|
PRIVATE :: READ_CANADA_MASK_05x0666
|
|
PRIVATE :: INIT_CAC_ANTHRO
|
|
PRIVATE :: TOTAL_ANTHRO_TG
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
! 18 Dec 2009 - Aaron van D - Added EMISS_CAC_ANTHRO_05x0666 routine
|
|
! 18 Dec 2009 - Aaron van D - Added READ_CANADA_MASK_05x0666 routine
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!
|
|
! !PRIVATE DATA MEMBERS:
|
|
!
|
|
|
|
! Arrays for data masks
|
|
INTEGER, ALLOCATABLE :: MASK_CANADA_1x1(:,:)
|
|
REAL*8, ALLOCATABLE :: MASK_CANADA(:,:)
|
|
|
|
! 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 :: NH3(:,:)
|
|
!
|
|
! !DEFINED PARAMETERS:
|
|
!
|
|
REAL*8, PARAMETER :: SEC_IN_YEAR = 86400d0 * 365.25d0
|
|
|
|
CONTAINS
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_canada_mask
|
|
!
|
|
! !DESCRIPTION: Function GET\_CANADA\_MASK returns the value of the Canadian
|
|
! geographic mask at grid box (I,J). MASK=1 if (I,J) is within Canada,
|
|
! MASK=0 otherwise. (amv, phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_CANADA_MASK( I, J ) RESULT( THISMASK )
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
! Longitude and latitude indices
|
|
INTEGER, INTENT(IN) :: I, J
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
! Local variables
|
|
REAL*8 :: THISMASK
|
|
|
|
!=================================================================
|
|
! GET_CANADA_MASK begins here!
|
|
!=================================================================
|
|
THISMASK = MASK_CANADA(I,J)
|
|
|
|
END FUNCTION GET_CANADA_MASK
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_cac_anthro
|
|
!
|
|
! !DESCRIPTION: Function GET\_CAC\_ANTHRO returns the Critical Air Contaminants
|
|
! emission for GEOS-Chem grid box (I,J) and tracer N. Emissions can be
|
|
! returned in units of [kg/s] or [molec/cm2/s]. (amv, phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_CAC_ANTHRO( I, J, N,
|
|
& MOLEC_CM2_S, KG_S ) RESULT( VALUE )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
! Longitude, latitude, and tracer indices
|
|
INTEGER, INTENT(IN) :: I, J, N
|
|
|
|
! OPTIONAL -- return emissions in [molec/cm2/s]
|
|
LOGICAL, INTENT(IN), OPTIONAL :: MOLEC_CM2_S
|
|
|
|
! OPTIONAL -- return emissions in [kg/s]
|
|
LOGICAL, INTENT(IN), OPTIONAL :: KG_S
|
|
!
|
|
! !RETURN VALUE:
|
|
!
|
|
! Emissions output
|
|
REAL*8 :: VALUE
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL :: DO_KGS, DO_MCS
|
|
|
|
!=================================================================
|
|
! GET_CAC_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 ( N == IDTNOx ) THEN
|
|
|
|
! NOx [kg/yr]
|
|
VALUE = NOx(I,J)
|
|
|
|
ELSE IF ( N == IDTCO ) THEN
|
|
|
|
! CO [kg/yr]
|
|
VALUE = CO(I,J)
|
|
|
|
ELSE IF ( N == IDTSO2 ) THEN
|
|
|
|
! SO2 [kg/yr]
|
|
VALUE = SO2(I,J)
|
|
|
|
ELSE IF ( N == IDTNH3 ) THEN
|
|
|
|
! NH3 [kg/month]
|
|
VALUE = NH3(I,J)
|
|
|
|
ELSE
|
|
|
|
! Otherwise return a negative value to indicate
|
|
! that there are no CAC emissions for tracer N
|
|
VALUE = -1d0
|
|
RETURN
|
|
|
|
ENDIF
|
|
|
|
!------------------------------
|
|
! Convert units (if necessary)
|
|
!------------------------------
|
|
IF ( DO_KGS ) THEN
|
|
|
|
IF ( N == IDTNH3 ) THEN
|
|
! Use 30 days per month (actual number of
|
|
! days may be required for the future)
|
|
! 2592000 = 30days*24hrs*60min*60sec
|
|
VALUE = VALUE / 2592000d0
|
|
ELSE
|
|
|
|
! Convert from [kg/yr] to [kg/s]
|
|
VALUE = VALUE / SEC_IN_YEAR
|
|
ENDIF
|
|
|
|
ELSE IF ( DO_MCS ) THEN
|
|
|
|
IF ( N == IDTNH3 ) THEN
|
|
VALUE = VALUE * XNUMOL(N) / ( A_CM2(J) * 2592000 )
|
|
ELSE
|
|
! Convert NOx from [kg/yr] to [molec/cm2/s]
|
|
! Updated on May 3, 2012 by Wai-Ho Lo: Not only NOx, but
|
|
! also NH3.
|
|
VALUE = VALUE * XNUMOL(N) / ( A_CM2(J) * SEC_IN_YEAR )
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
END FUNCTION GET_CAC_ANTHRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: emiss_cac_anthro
|
|
!
|
|
! !DESCRIPTION: Subroutine EMISS\_CAC\_ANTHRO reads the Critical Air
|
|
! Contaminants emission fields at 1x1 resolution and regrids them to the
|
|
! current model resolution. (amv, phs, 1/28/2009)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMISS_CAC_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
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_O3" ! FSCALYR
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!
|
|
! !REMARKS:
|
|
! (1 ) Emissions are read for a year b/w 2002-2005, and scaled
|
|
! (except NH3) between 1985-2003 if needed (phs, 3/10/08)
|
|
! (2 ) Now accounts for FSCALYR (phs, 3/17/08)
|
|
! 18 Dec 2009 - Aaron van D - Use 2005 scale factors for years beyond 2005
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: I, J, THISYEAR, SPECIES, SNo, ScNo
|
|
INTEGER :: THISMONTH
|
|
REAL*4 :: ARRAY(I1x1,J1x1,1)
|
|
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
|
|
REAL*8 :: GEOS_1x1_2002(I1x1,J1x1,1)
|
|
REAL*8 :: GEOS_1x1_2005(I1x1,J1x1,1)
|
|
REAL*8 :: SC_1x1(I1x1,J1x1)
|
|
REAL*8 :: TAU2002, TAU2005, TAU
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
CHARACTER(LEN=4) :: SYEAR, SNAME
|
|
CHARACTER(LEN=2) :: THISMONTHCHAR
|
|
REAL*8 :: NH3_SCALE(12)
|
|
|
|
! seasonal scalar for NH3 emission (lzh, amv, 12/11/2009)
|
|
! Updated on May 13, 2012 by Wai-Ho Lo, since Agriculture Canada's
|
|
! NH3 emission inventory is used, monthly scalars are not used
|
|
|
|
NH3_SCALE = (/
|
|
& 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 /)
|
|
!& 0.426d0, 0.445d0, 0.526d0, 0.718d0, 1.179d0, 1.447d0,
|
|
!& 1.897d0, 1.884d0, 1.577d0, 0.886d0, 0.571d0, 0.445d0 /)
|
|
|
|
!=================================================================
|
|
! EMISS_CAC_ANTHRO begins here!
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
CALL INIT_CAC_ANTHRO
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! Get emissions year
|
|
IF ( FSCALYR < 0 ) THEN
|
|
THISYEAR = GET_YEAR()
|
|
ELSE
|
|
THISYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
THISMONTH = GET_MONTH()
|
|
|
|
WRITE( THISMONTHCHAR, '(i2.2)' ) THISMONTH
|
|
THISMONTHCHAR = ADJUSTL( THISMONTHCHAR )
|
|
|
|
DO SPECIES = 1,4
|
|
|
|
IF ( SPECIES .eq. 1 ) THEN
|
|
SNAME = 'NOx'
|
|
SNo = 1
|
|
ScNo = 71
|
|
ELSEIF ( SPECIES .eq. 2 ) THEN
|
|
SNAME = 'CO'
|
|
SNo = 4
|
|
ScNo = 72
|
|
ELSEIF ( SPECIES .eq. 3 ) THEN
|
|
SNAME = 'SOx'
|
|
SNo = 26
|
|
ScNo = 73
|
|
ELSEIF ( SPECIES .eq. 4 ) THEN
|
|
SNAME = 'NH3'
|
|
SNo = 30
|
|
ScNo = 0
|
|
ENDIF
|
|
|
|
IF ( ( THISYEAR .le. 2002 ) .OR.
|
|
& ( THISYEAR .ge. 2005 ) ) THEN
|
|
|
|
! TAU values for 2002/2005
|
|
TAU = GET_TAU0( 1, 1, MIN( MAX( THISYEAR, 2002 ), 2005 ) )
|
|
WRITE( SYEAR, '(i4)' ) MIN( MAX( THISYEAR, 2002 ), 2005 )
|
|
|
|
! File name
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) // 'CAC_200801/CAC' //
|
|
& '2008-' // TRIM( SNAME ) // '-' //
|
|
& TRIM( THISMONTHCHAR ) //
|
|
& '.geos.1x1'
|
|
ELSE
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) // 'CAC_200801/CAC' //
|
|
& SYEAR // '-' // TRIM( SNAME ) // '.geos.1x1'
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - EMISS_CAC_ANTHRO: Reading ', a )
|
|
|
|
! Read data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
! Since currently the 2005 data is read, a monthly
|
|
! TAU value has to be read for 2008 for NH3 emissions
|
|
TAU = GET_TAU0( THISMONTH, 1, 2008 )
|
|
ENDIF
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
!phs & TAU, I1x1, J1x1-1,
|
|
& TAU, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_1x1(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! Apply annual scalar factor. Available for 1985-2006,
|
|
! and NOx, CO and SO2 only.
|
|
IF ( ( THISYEAR .lt. 2002 ) .and. SPECIES .ne. 4 ) THEN
|
|
|
|
CALL GET_ANNUAL_SCALAR_1x1( ScNo, 2002,
|
|
& THISYEAR, SC_1x1 )
|
|
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * SC_1x1(:,:)
|
|
|
|
ELSE IF ((THISYEAR .gt. 2005) .and. SPECIES .ne. 4) THEN
|
|
|
|
CALL GET_ANNUAL_SCALAR_1x1( ScNo, 2005,
|
|
& THISYEAR, SC_1x1 )
|
|
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * SC_1x1(:,:)
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
TAU2002 = GET_TAU0( 1, 1, 2002)
|
|
TAU2005 = GET_TAU0( 1, 1, 2005)
|
|
|
|
! File name for 2002 data
|
|
IF (SPECIES .eq. 4) THEN
|
|
FILENAME = TRIM(DATA_DIR_1x1 ) // 'CAC_200801/CAC' //
|
|
& '2008-' // TRIM( SNAME ) // '-' //
|
|
& TRIM( THISMONTHCHAR ) //
|
|
& '.geos.1x1'
|
|
ELSE
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) // 'CAC_200801/CAC2002-'
|
|
& // TRIM(SNAME) // '.geos.1x1'
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
|
|
! Read data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
! Since currently the 2002 or 2005 data is read, a
|
|
! monthly TAU value has to be read for 2008 for NH3
|
|
! emissions
|
|
TAU = GET_TAU0( THISMONTH, 1, 2008 )
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
!wl & TAU, I1x1, J1x1-1,
|
|
& TAU, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ELSE
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
!phs & TAU2002, I1x1, J1x1-1,
|
|
& TAU2002, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ENDIF
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_1x1_2002(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! File name for 2005 data
|
|
IF (SPECIES .eq. 4) THEN
|
|
FILENAME = TRIM(DATA_DIR_1x1 ) // 'CAC_200801/CAC' //
|
|
& '2008-' // TRIM( SNAME ) // '-' //
|
|
& TRIM( THISMONTHCHAR ) //
|
|
& '.geos.1x1'
|
|
ELSE
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) // 'CAC_200801/CAC2005-'
|
|
& // TRIM(SNAME) // '.geos.1x1'
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
|
|
! Read data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
! Since currently the 2002 or 2005 data is read, a
|
|
! monthly TAU value has to be read for 2008 for NH3
|
|
! emissions
|
|
TAU = GET_TAU0( THISMONTH, 1, 2008 )
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
!wl & TAU, I1x1, J1x1,
|
|
& TAU, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ELSE
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
!phs & TAU2005, I1x1, J1x1-1,
|
|
& TAU2005, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ENDIF
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_1x1_2005(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! Scale b/w 2002-2005
|
|
GEOS_1x1(:,:,1) = GEOS_1x1_2002(:,:,1) + ( THISYEAR - 2002.)
|
|
& / 3. *
|
|
& ( GEOS_1x1_2005(:,:,1) - GEOS_1x1_2002(:,:,1) )
|
|
|
|
!fp (check that it doesn't get negative)
|
|
DO I=1,I1x1
|
|
DO J=1,J1x1
|
|
|
|
IF ( GEOS_1x1(I,J,1) .LT. 0 ) THEN
|
|
GEOS_1x1(I,J,1) = 0d0
|
|
ENDIF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
! Regrid from GEOS 1x1 --> current model resolution
|
|
IF ( SPECIES .eq. 1 ) THEN
|
|
|
|
CALL DO_REGRID_1x1( 'kg/yr', GEOS_1x1, NOx )
|
|
|
|
ELSEIF ( SPECIES .eq. 2 ) THEN
|
|
|
|
CALL DO_REGRID_1x1( 'kg/yr', GEOS_1x1, CO )
|
|
|
|
ELSEIF ( SPECIES .eq. 3 ) THEN
|
|
|
|
! Convert SOx to SO2, where SOx is assumed to be 1.4% SO4 and
|
|
! 98.6% SO2 over NA, based upon Chin et al, 2000, and as
|
|
! utilized in sulfate_mod.f
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * 0.986
|
|
|
|
CALL DO_REGRID_1x1( 'kg/yr', GEOS_1x1, SO2 )
|
|
|
|
ELSEIF ( SPECIES .eq. 4 ) THEN
|
|
|
|
! Apply seasonality
|
|
! Using Agriculture Canada's NH3 emission inventory,
|
|
! no seasonality scalars are required
|
|
!GEOS_1x1(:,:,1) = NH3_SCALE(THISMONTH) * GEOS_1x1(:,:,1)
|
|
CALL DO_REGRID_1x1( 'kg/month', GEOS_1x1, NH3 )
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
!--------------------------
|
|
! Compute future emissions
|
|
!--------------------------
|
|
IF ( LFUTURE ) THEN
|
|
CALL CAC_SCALE_FUTURE
|
|
ENDIF
|
|
|
|
!--------------------------
|
|
! Print emission totals
|
|
!--------------------------
|
|
CALL TOTAL_ANTHRO_Tg( THISYEAR )
|
|
|
|
END SUBROUTINE EMISS_CAC_ANTHRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Dalhousie Atmospheric Compositional Analysis Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: emiss_cac_anthro_05x0666
|
|
!
|
|
! !DESCRIPTION: Subroutine EMISS\_CAC\_ANTHRO\_05x0666 reads the Critical Air
|
|
! Contaminants emission fields at nested NA resolution (1/2 x 2/3)
|
|
! (amv, phs, 11/03/2009)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMISS_CAC_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
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_O3" ! FSCALYR
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 03 Nov 2009 - A. van Donkelaar - Initial Version
|
|
!
|
|
! !REMARKS:
|
|
! (1 ) Emissions are read for a year b/w 2002-2005, and scaled
|
|
! (except NH3) between 1985-2003 if needed (phs, 3/10/08)
|
|
! (2 ) Now accounts for FSCALYR (phs, 3/17/08)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: I, J, THISYEAR, SPECIES, SNo, ScNo
|
|
INTEGER :: THISMONTH
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
|
|
REAL*8 :: GEOS_05x0666(IIPAR,JJPAR,1)
|
|
REAL*8 :: GEOS_05x0666_2002(IIPAR,JJPAR,1)
|
|
REAL*8 :: GEOS_05x0666_2005(IIPAR,JJPAR,1)
|
|
REAL*4 :: SC_05x0666(IIPAR,JJPAR)
|
|
REAL*8 :: TAU2002, TAU2005, TAU
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
CHARACTER(LEN=4) :: SYEAR, SNAME
|
|
CHARACTER(LEN=2) :: THISMONTHCHAR
|
|
REAL*8 :: NH3_SCALE(12)
|
|
|
|
! seasonal scalar for NH3 emission (lzh, amv, 12/11/2009)
|
|
! Updated on May 13, 2012 by Wai-Ho Lo, since Agriculture Canada's
|
|
! NH3 emission inventory is used, monthly scalars are not used
|
|
|
|
NH3_SCALE = (/
|
|
& 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 /)
|
|
!& 0.426d0, 0.445d0, 0.526d0, 0.718d0, 1.179d0, 1.447d0,
|
|
!& 1.897d0, 1.884d0, 1.577d0, 0.886d0, 0.571d0, 0.445d0 /)
|
|
|
|
!=================================================================
|
|
! EMISS_CAC_ANTHRO begins here!
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
CALL INIT_CAC_ANTHRO
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! Get emissions year
|
|
IF ( FSCALYR < 0 ) THEN
|
|
THISYEAR = GET_YEAR()
|
|
ELSE
|
|
THISYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
THISMONTH = GET_MONTH()
|
|
|
|
WRITE( THISMONTHCHAR, '(i2.2)' ) THISMONTH
|
|
THISMONTHCHAR = ADJUSTL( THISMONTHCHAR )
|
|
|
|
DO SPECIES = 1,4
|
|
|
|
IF ( SPECIES .eq. 1 ) THEN
|
|
SNAME = 'NOx'
|
|
SNo = 1
|
|
ScNo = 71
|
|
ELSEIF ( SPECIES .eq. 2 ) THEN
|
|
SNAME = 'CO'
|
|
SNo = 4
|
|
ScNo = 72
|
|
ELSEIF ( SPECIES .eq. 3 ) THEN
|
|
SNAME = 'SOx'
|
|
SNo = 26
|
|
ScNo = 73
|
|
ELSEIF ( SPECIES .eq. 4 ) THEN
|
|
SNAME = 'NH3'
|
|
SNo = 30
|
|
ScNo = 0
|
|
ENDIF
|
|
|
|
IF ( ( THISYEAR .le. 2002 ) .OR.
|
|
& ( THISYEAR .ge. 2005 ) ) THEN
|
|
|
|
! TAU values for 2002/2005
|
|
TAU = GET_TAU0( 1, 1, MIN( MAX( THISYEAR, 2002 ), 2005 ) )
|
|
WRITE( SYEAR, '(i4)' ) MIN( MAX( THISYEAR, 2002 ), 2005 )
|
|
|
|
! File name
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
FILENAME = TRIM( DATA_DIR ) // 'CAC_200911/CAC' //
|
|
& '2008-' // TRIM( SNAME ) // '-' //
|
|
& TRIM( THISMONTHCHAR ) //
|
|
& '.geos.1t2x2t3'
|
|
ELSE
|
|
FILENAME = TRIM( DATA_DIR ) // 'CAC_200911/CAC' //
|
|
& SYEAR // '-' // TRIM( SNAME ) //
|
|
& '.geos.na.1t2x2t3'
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - EMISS_CAC_ANTHRO_05x0666: Reading ', a )
|
|
|
|
! Read data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
! Since currently the 2002 or 2005 data is read, a
|
|
! monthly TAU value has to be read for 2008 for NH3
|
|
! emissions
|
|
TAU = GET_TAU0(THISMONTH, 1, 2008 )
|
|
ENDIF
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
& TAU, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_05x0666(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! Apply annual scalar factor. Available for 1985-2006,
|
|
! and NOx, CO and SO2 only.
|
|
IF ( ( THISYEAR .lt. 2002 ) .and. SPECIES .ne. 4 ) THEN
|
|
|
|
CALL GET_ANNUAL_SCALAR_05x0666_NESTED( ScNo, 2002,
|
|
& THISYEAR, SC_05x0666 )
|
|
|
|
GEOS_05x0666(:,:,1) = GEOS_05x0666(:,:,1)
|
|
& * SC_05x0666(:,:)
|
|
|
|
ELSE IF ((THISYEAR .gt. 2005) .and. SPECIES .ne. 4) THEN
|
|
|
|
CALL GET_ANNUAL_SCALAR_05x0666_NESTED( ScNo, 2005,
|
|
& THISYEAR, SC_05x0666 )
|
|
|
|
GEOS_05x0666(:,:,1) = GEOS_05x0666(:,:,1)
|
|
& * SC_05x0666(:,:)
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
TAU2002 = GET_TAU0( 1, 1, 2002)
|
|
TAU2005 = GET_TAU0( 1, 1, 2005)
|
|
|
|
! File name for 2002 data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
FILENAME = TRIM( DATA_DIR ) // 'CAC_200911/CAC' //
|
|
& '2008-' // TRIM( SNAME ) // '-' //
|
|
& TRIM(THISMONTHCHAR ) //
|
|
& '.geos.1t2x2t3'
|
|
ELSE
|
|
FILENAME = TRIM( DATA_DIR ) // 'CAC_200911/CAC2002-'
|
|
& // TRIM(SNAME) // '.geos.na.1t2x2t3'
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
|
|
! Read data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
! Since currently the 2002 or 2005 data is read, a
|
|
! monthly TAU value has to be read for 2008 for NH3
|
|
! emissions
|
|
TAU = GET_TAU0( THISMONTH, 1, 2008 )
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
& TAU, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ELSE
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
& TAU2002, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ENDIF
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_05x0666_2002(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! File name for 2005 data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
FILENAME = TRIM( DATA_DIR ) // 'CAC_200911/CAC' //
|
|
& '2008-' // TRIM( SNAME ) // '-' //
|
|
& TRIM(THISMONTHCHAR ) //
|
|
& '.geos.1t2x2t3'
|
|
ELSE
|
|
FILENAME = TRIM( DATA_DIR ) // 'CAC_200911/CAC2005-'
|
|
& // TRIM(SNAME) // '.geos.na.1t2x2t3'
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
|
|
! Read data
|
|
IF (SPECIES .eq. 4 ) THEN
|
|
! Since currently the 2002 or 2005 data is read, a
|
|
! monthly TAU value has to be read for 2008 for NH3
|
|
! emissions
|
|
TAU = GET_TAU0( THISMONTH, 1, 2008 )
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
& TAU, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ELSE
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo,
|
|
& TAU2005, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
ENDIF
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_05x0666_2005(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! Scale b/w 2002-2005
|
|
GEOS_05x0666(:,:,1) = GEOS_05x0666_2002(:,:,1) +
|
|
& ( THISYEAR - 2002.) / 3. *
|
|
& ( GEOS_05x0666_2005(:,:,1)
|
|
& - GEOS_05x0666_2002(:,:,1) )
|
|
|
|
DO I = 1, IIPAR
|
|
DO J = 1, JJPAR
|
|
|
|
IF ( GEOS_05x0666(I,J,1) .LT. 0D0 )
|
|
& GEOS_05x0666(I,J,1) = 0d0
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
IF ( SPECIES .eq. 1 ) THEN
|
|
|
|
NOx(:,:) = GEOS_05x0666(:,:,1)
|
|
|
|
ELSEIF ( SPECIES .eq. 2 ) THEN
|
|
|
|
CO(:,:) = GEOS_05x0666(:,:,1)
|
|
|
|
ELSEIF ( SPECIES .eq. 3 ) THEN
|
|
|
|
! Convert SOx to SO2, where SOx is assumed to be 1.4% SO4 and
|
|
! 98.6% SO2 over NA, based upon Chin et al, 2000, and as
|
|
! utilized in sulfate_mod.f
|
|
SO2(:,:) = GEOS_05x0666(:,:,1) * 0.986
|
|
|
|
ELSEIF ( SPECIES .eq. 4 ) THEN
|
|
|
|
! Apply seasonality
|
|
!GEOS_05X0666(:,:,1) = NH3_SCALE(THISMONTH)
|
|
! * GEOS_05X0666(:,:,1)
|
|
NH3(:,:) = GEOS_05x0666(:,:,1)
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
!--------------------------
|
|
! Compute future emissions
|
|
!--------------------------
|
|
IF ( LFUTURE ) THEN
|
|
CALL CAC_SCALE_FUTURE
|
|
ENDIF
|
|
|
|
!--------------------------
|
|
! Print emission totals
|
|
!--------------------------
|
|
CALL TOTAL_ANTHRO_Tg( THISYEAR )
|
|
|
|
END SUBROUTINE EMISS_CAC_ANTHRO_05x0666
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: cac_scale_future
|
|
!
|
|
! !DESCRIPTION: Subroutine CAC\_SCALE\_FUTURE applies the IPCC future scale
|
|
! factors to the Criteria Air Contaminant anthropogenic emissions.
|
|
! (amv, phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
|
|
SUBROUTINE CAC_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
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
|
|
!=================================================================
|
|
! STREETS_SCALE_FUTURE begins here!
|
|
!=================================================================
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Future NOx [kg NO2/yr]
|
|
NOx(I,J) = NOx(I,J) * GET_FUTURE_SCALE_NOxff( I, J )
|
|
|
|
! Future CO [kg CO /yr]
|
|
CO(I,J) = CO(I,J) * GET_FUTURE_SCALE_COff( I, J )
|
|
|
|
! Future SO2 [kg SO2/yr]
|
|
SO2(I,J) = SO2(I,J) * GET_FUTURE_SCALE_SO2ff( I, J )
|
|
|
|
! Future NH3 [kg NH3/yr]
|
|
NH3(I,J) = NH3(I,J) * GET_FUTURE_SCALE_NH3an( I, J )
|
|
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
END SUBROUTINE CAC_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. (amv, phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !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:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
REAL*8 :: T_NOX, T_CO, T_SO2, T_NH3
|
|
CHARACTER(LEN=3) :: UNIT
|
|
|
|
!=================================================================
|
|
! TOTAL_ANTHRO_TG begins here!
|
|
!=================================================================
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, 100 )
|
|
100 FORMAT( 'C. A. C. C A N A D I A N 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 NH3 [Tg NH3]
|
|
T_NH3 = SUM( NH3 ) * 1d-9
|
|
|
|
! Print totals in [kg]
|
|
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 ) 'NH3 ', YEAR, T_NH3, '[Tg NH3]'
|
|
|
|
! Format statement
|
|
110 FORMAT( 'C.A.C. Canadian anthro ', a5,
|
|
& 'for year ', i4, ': ', f11.4, 1x, a8 )
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
END SUBROUTINE TOTAL_ANTHRO_Tg
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_canada_mask
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_CANADA\_MASK reads and regrids the Canadian
|
|
! geographic mask from disk. (amv, phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_CANADA_MASK
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_G2G_1x1, DO_REGRID_1x1
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*4 :: ARRAY(I1x1,J1x1,1)
|
|
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
|
|
REAL*8 :: TAU2000
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! READ_CANADA_MASK begins here!
|
|
!=================================================================
|
|
|
|
TAU2000 = GET_TAU0(1,1,2000)
|
|
|
|
! File name
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'CAC_200801/CanadaMask.geos.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_CANADA_MASK: Reading ', a )
|
|
|
|
! Read data [unitless]
|
|
CALL READ_BPCH2( FILENAME, 'LANDMAP', 2,
|
|
& TAU2000, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_1x1(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! Save the 1x1 China mask for future use
|
|
MASK_CANADA_1x1(:,:) = GEOS_1x1(:,:,1)
|
|
|
|
! Regrid from GENERIC 1x1 GRID to GEOS 1x1 GRID
|
|
! CALL DO_REGRID_G2G_1x1( 'unitless', GEN_1x1, GEOS_1x1(:,:,1) )
|
|
|
|
! Regrid from GEOS 1x1 GRID to current model resolution
|
|
CALL DO_REGRID_1x1( 'unitless', GEOS_1x1, MASK_CANADA )
|
|
|
|
END SUBROUTINE READ_CANADA_MASK
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Dalhousie University Atmospheric Compositional Analysis Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_canada_mask_05x0666
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_CANADA\_MASK\_05x0666 reads the Canadian
|
|
! geographic mask from disk. (amv, phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_CANADA_MASK_05x0666
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_G2G_1x1, DO_REGRID_1x1
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 11 Nov 2009 - A. van Donkelaar - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
|
|
REAL*8 :: GEOS_05x0666(IIPAR,JJPAR,1)
|
|
REAL*8 :: TAU2000
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! READ_CANADA_MASK begins here!
|
|
!=================================================================
|
|
|
|
TAU2000 = GET_TAU0(1,1,2000)
|
|
|
|
! File name
|
|
FILENAME = TRIM( DATA_DIR ) //
|
|
& 'CAC_200911/CanadaMask.geos.na.1t2x2t3'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_CANADA_MASK_05x0666: Reading ', a )
|
|
|
|
! Read data [unitless]
|
|
CALL READ_BPCH2( FILENAME, 'LANDMAP', 2,
|
|
& TAU2000, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast to REAL*8 before regridding
|
|
MASK_CANADA(:,:) = ARRAY(:,:,1)
|
|
|
|
END SUBROUTINE READ_CANADA_MASK_05x0666
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: init_cac_anthro
|
|
!
|
|
! !DESCRIPTION: Subroutine INIT\_CAC\_ANTHRO allocates and zeroes all
|
|
! module arrays. (phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE INIT_CAC_ANTHRO
|
|
!
|
|
! !USES:
|
|
!
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE LOGICAL_MOD, ONLY : LCAC
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: AS, J
|
|
|
|
!=================================================================
|
|
! INIT_CAC_ANTHRO begins here!
|
|
!=================================================================
|
|
|
|
! Return if LCAC is false
|
|
IF ( .not. LCAC ) RETURN
|
|
|
|
!--------------------------------------------------
|
|
! Allocate and zero arrays for emissions
|
|
!--------------------------------------------------
|
|
|
|
ALLOCATE( NOx( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'NOx' )
|
|
NOx = 0d0
|
|
|
|
ALLOCATE( CO( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CO' )
|
|
CO = 0d0
|
|
|
|
ALLOCATE( SO2( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO2' )
|
|
SO2 = 0d0
|
|
|
|
ALLOCATE( NH3( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'NH3' )
|
|
NH3 = 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
|
|
|
|
!---------------------------------------------------
|
|
! Read & Regrid masks for CAC emissions
|
|
!---------------------------------------------------
|
|
|
|
ALLOCATE( MASK_CANADA_1x1( I1x1, J1x1 ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'MASK_CANADA_1x1' )
|
|
MASK_CANADA_1x1 = 0
|
|
|
|
ALLOCATE( MASK_CANADA( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'MASK_CANADA' )
|
|
MASK_CANADA = 0d0
|
|
|
|
! Read China & SE Asia masks from disk
|
|
CALL READ_CANADA_MASK
|
|
|
|
END SUBROUTINE INIT_CAC_ANTHRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: cleanup_cac_anthro
|
|
!
|
|
! !DESCRIPTION: Subroutine CLEANUP\_CAC\_ANTHRO deallocates all module
|
|
! arrays. (phs, 1/28/09)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE CLEANUP_CAC_ANTHRO
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!=================================================================
|
|
! CLEANUP_STREETS begins here!
|
|
!=================================================================
|
|
IF ( ALLOCATED( A_CM2 ) ) DEALLOCATE( A_CM2 )
|
|
IF ( ALLOCATED( MASK_CANADA_1x1) ) DEALLOCATE( MASK_CANADA_1x1)
|
|
IF ( ALLOCATED( MASK_CANADA ) ) DEALLOCATE( MASK_CANADA )
|
|
IF ( ALLOCATED( NOx ) ) DEALLOCATE( NOx )
|
|
IF ( ALLOCATED( CO ) ) DEALLOCATE( CO )
|
|
IF ( ALLOCATED( SO2 ) ) DEALLOCATE( SO2 )
|
|
IF ( ALLOCATED( NH3 ) ) DEALLOCATE( NH3 )
|
|
|
|
END SUBROUTINE CLEANUP_CAC_ANTHRO
|
|
!EOC
|
|
END MODULE CAC_ANTHRO_MOD
|
|
|