582 lines
16 KiB
Fortran
582 lines
16 KiB
Fortran
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: icoads_ship_mod
|
|
!
|
|
! !DESCRIPTION: Module ICOADS\_SHIP\_MOD contains variables and routines to
|
|
! read the International Comprehensive Ocean-Atmosphere Data Set (ICOADS)
|
|
! ship emissions. Base year is 2002.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
MODULE ICOADS_SHIP_MOD
|
|
!
|
|
! !USES:
|
|
!
|
|
IMPLICIT NONE
|
|
# include "define.h"
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: CLEANUP_ICOADS_SHIP
|
|
PUBLIC :: EMISS_ICOADS_SHIP
|
|
PUBLIC :: GET_ICOADS_SHIP
|
|
!
|
|
! !PRIVATE MEMBER FUNCTIONS:
|
|
!
|
|
PRIVATE :: ICOADS_SCALE_FUTURE
|
|
PRIVATE :: INIT_ICOADS_SHIP
|
|
PRIVATE :: TOTAL_ICOADS_SHIP_TG
|
|
!
|
|
! !REMARKS:
|
|
! Source: ICOADS Emissions data for NOx, SOx, and CO were downloaded from
|
|
! http://coast.cms.udel.edu/GlobalShipEmissions/Inventories/
|
|
!
|
|
! Reference: Wang, C., J. J. Corbett, and J. Firestone, \emph{Improving
|
|
! Spatial representation of Global Ship Emissions Inventories},
|
|
! Environ. Sci. Technol., 42, (1), 193-199, 2008.
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !PRIVATE DATA MEMBERS:
|
|
!
|
|
! Array for surface area
|
|
REAL*8, ALLOCATABLE :: A_CM2(:)
|
|
|
|
! Arrays for emissions
|
|
REAL*8, ALLOCATABLE :: NOx(:,:)
|
|
REAL*8, ALLOCATABLE :: CO(:,:)
|
|
REAL*8, ALLOCATABLE :: SO2(:,:)
|
|
|
|
CONTAINS
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_icoads_ship
|
|
!
|
|
! !DESCRIPTION: Function GET\_ICOADS\_SHIP returns the ICOADS ship emissions
|
|
! for GEOS-Chem grid box (I,J) and tracer N. Emissions can be returned in
|
|
! units of [kg/s] or [molec/cm2/s].
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_ICOADS_SHIP( I, J, N,
|
|
& MOLEC_CM2_S, KG_S ) RESULT( VALUE )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3
|
|
USE TIME_MOD, ONLY : GET_YEAR, GET_MONTH
|
|
!
|
|
! !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:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL :: DO_KGS, DO_MCS
|
|
INTEGER :: YEAR, MONTH
|
|
REAL*8 :: SEC_IN_MONTH
|
|
|
|
!=================================================================
|
|
! GET_ICOADS_SHIP 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/month]
|
|
VALUE = NOx(I,J)
|
|
|
|
ELSE IF ( N == IDTCO ) THEN
|
|
|
|
! CO [kg/month]
|
|
VALUE = CO(I,J)
|
|
|
|
ELSE IF ( N == IDTSO2 ) THEN
|
|
|
|
! SO2 [kg/month]
|
|
VALUE = SO2(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)
|
|
!------------------------------
|
|
! Get emissions year
|
|
YEAR = GET_YEAR()
|
|
|
|
! Get emissions month
|
|
MONTH = GET_MONTH()
|
|
|
|
IF ( (MONTH == 4) .OR. (MONTH == 6) .OR.
|
|
& (MONTH == 9) .OR. (MONTH == 11) ) THEN
|
|
|
|
SEC_IN_MONTH = 86400D0*30.0D0
|
|
|
|
ELSE IF (MONTH == 2) THEN
|
|
|
|
! ICOADS ship emissions for 2002
|
|
IF (MOD(YEAR,4) == 0) THEN
|
|
SEC_IN_MONTH = 86400D0*29.0D0
|
|
ELSE
|
|
SEC_IN_MONTH = 86400D0*28.0D0
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
SEC_IN_MONTH = 86400D0*31.0D0
|
|
|
|
ENDIF
|
|
|
|
IF ( DO_KGS ) THEN
|
|
|
|
! Convert from [kg/box/month] to [kg/box/s]
|
|
VALUE = VALUE / SEC_IN_MONTH
|
|
|
|
ELSE IF ( DO_MCS ) THEN
|
|
|
|
! Convert NOx from [kg/month] to [molec/cm2/s]
|
|
VALUE = VALUE * XNUMOL(N) / ( A_CM2(J) * SEC_IN_MONTH )
|
|
|
|
ENDIF
|
|
|
|
END FUNCTION GET_ICOADS_SHIP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: emiss_icoads_ship
|
|
!
|
|
! !DESCRIPTION: Subroutine EMISS\_ICOADS\_SHIP reads the ICOADS emission fields
|
|
! at 1x1 resolution and regrids them to the current model resolution.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMISS_ICOADS_SHIP
|
|
!
|
|
! !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
|
|
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!USE CMN_O3_MOD ! FSCALYR
|
|
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!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 :: SC_1x1(I1x1,J1x1)
|
|
REAL*8 :: TAU
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
CHARACTER(LEN=4) :: SYEAR, SNAME
|
|
CHARACTER (LEN=2) :: SMONTH
|
|
|
|
!=================================================================
|
|
! EMISS_ICOADS_SHIP begins here!
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
CALL INIT_ICOADS_SHIP
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! Get emissions year
|
|
IF ( FSCALYR < 0 ) THEN
|
|
THISYEAR = GET_YEAR()
|
|
ELSE
|
|
THISYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
! Get emissions month
|
|
THISMONTH = GET_MONTH()
|
|
|
|
WRITE( SMONTH, '(i2.2)' ) THISMONTH
|
|
|
|
|
|
DO SPECIES = 1,3
|
|
|
|
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
|
|
ENDIF
|
|
|
|
|
|
! TAU values for 2002
|
|
TAU = GET_TAU0( 1, 1, 2002 )
|
|
|
|
! File name
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //'ICOADS_200907/' //
|
|
& TRIM( SNAME ) // '_' // SMONTH // '.geos.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - EMISS_ICOADS_SHIP: Reading ', a )
|
|
|
|
! Read data
|
|
CALL READ_BPCH2( FILENAME, 'ICOADS-$', SNo,
|
|
& TAU, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast to REAL*8 before regridding
|
|
GEOS_1x1(:,:,1) = ARRAY(:,:,1)
|
|
|
|
! Convert [kg S/month] to [kg SO2/month]
|
|
IF ( SPECIES .eq. 3 ) THEN
|
|
GEOS_1X1 = GEOS_1x1*64.0D0/32.0D0
|
|
ENDIF
|
|
|
|
! Apply annual scalar factor
|
|
CALL GET_ANNUAL_SCALAR_1x1( ScNo, 2002, THISYEAR, SC_1x1 )
|
|
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * SC_1x1(:,:)
|
|
|
|
! Regrid from GEOS 1x1 --> current model resolution
|
|
IF ( SPECIES .eq. 1 ) THEN
|
|
|
|
GEOS_1x1 = GEOS_1x1 * 46d0 / 14d0
|
|
CALL DO_REGRID_1x1( 'kg/month', GEOS_1x1, NOx )
|
|
|
|
ELSEIF ( SPECIES .eq. 2 ) THEN
|
|
|
|
CALL DO_REGRID_1x1( 'kg/month', 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/month', GEOS_1x1, SO2 )
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
!--------------------------
|
|
! Compute future emissions
|
|
!--------------------------
|
|
IF ( LFUTURE ) THEN
|
|
CALL ICOADS_SCALE_FUTURE
|
|
ENDIF
|
|
|
|
!--------------------------
|
|
! Print emission totals
|
|
!--------------------------
|
|
CALL TOTAL_ICOADS_SHIP_TG( THISYEAR )
|
|
|
|
END SUBROUTINE EMISS_ICOADS_SHIP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: icoads_scale_future
|
|
!
|
|
! !DESCRIPTION: applies the IPCC future scale factors
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
|
|
SUBROUTINE ICOADS_SCALE_FUTURE
|
|
!
|
|
! !USES:
|
|
!
|
|
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_SO2ff
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
|
|
!=================================================================
|
|
! ICOADS_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/month]
|
|
NOx(I,J) = NOx(I,J) * GET_FUTURE_SCALE_NOxff( I, J )
|
|
|
|
! Future CO [kg CO /month]
|
|
CO(I,J) = CO(I,J) * GET_FUTURE_SCALE_COff( I, J )
|
|
|
|
! Future SO2 [kg SO2/month]
|
|
SO2(I,J) = SO2(I,J) * GET_FUTURE_SCALE_SO2ff( I, J )
|
|
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
END SUBROUTINE ICOADS_SCALE_FUTURE
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: total_icoads_ship_Tg
|
|
!
|
|
! !DESCRIPTION: Subroutine TOTAL\_ICOADS\_SHIP\_TG prints the totals for
|
|
! ship emissions of NOx, CO, and SO2.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE TOTAL_ICOADS_SHIP_TG( MONTH )
|
|
!
|
|
! !USES:
|
|
!
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: MONTH ! Month of data to compute totals
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
REAL*8 :: T_NOX, T_CO, T_SO2
|
|
CHARACTER(LEN=3) :: UNIT
|
|
|
|
!=================================================================
|
|
! TOTAL_ICOADS_SHIP_TG begins here!
|
|
!=================================================================
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, 100 )
|
|
100 FORMAT( 'I. C. O. A. D. S. S H I P 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 )
|
|
|
|
! Print totals in [kg]
|
|
WRITE( 6, 110 ) 'NOx ', MONTH, T_NOx, '[Tg N ]'
|
|
WRITE( 6, 110 ) 'CO ', MONTH, T_CO, '[Tg CO ]'
|
|
WRITE( 6, 110 ) 'SO2 ', MONTH, T_SO2, '[Tg S ]'
|
|
|
|
! Format statement
|
|
110 FORMAT( 'ICOADS ship ', a5,
|
|
& 'for month ', i4, ': ', f11.4, 1x, a8 )
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
END SUBROUTINE TOTAL_ICOADS_SHIP_TG
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: init_icoads_ship
|
|
!
|
|
! !DESCRIPTION: Subroutine INIT\_ICOADS\_SHIP allocates and zeroes all
|
|
! module arrays.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE INIT_ICOADS_SHIP
|
|
!
|
|
! !USES:
|
|
!
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE LOGICAL_MOD, ONLY : LICOADSSHIP
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: AS, J
|
|
|
|
!=================================================================
|
|
! INIT_ICOADS_SHIP begins here!
|
|
!=================================================================
|
|
|
|
! Return if LICOADSSHIP is false
|
|
IF ( .not. LICOADSSHIP ) 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
|
|
|
|
!---------------------------------------------------
|
|
! 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
|
|
|
|
END SUBROUTINE INIT_ICOADS_SHIP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: cleanup_icoads_ship
|
|
!
|
|
! !DESCRIPTION: Subroutine CLEANUP\_ICOADS\_SHIP deallocates all module
|
|
! arrays.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE CLEANUP_ICOADS_SHIP
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 21 Jul 2009 - Chulkyu Lee & P. Le Sager - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
IF ( ALLOCATED( A_CM2 ) ) DEALLOCATE( A_CM2 )
|
|
IF ( ALLOCATED( NOx ) ) DEALLOCATE( NOx )
|
|
IF ( ALLOCATED( CO ) ) DEALLOCATE( CO )
|
|
IF ( ALLOCATED( SO2 ) ) DEALLOCATE( SO2 )
|
|
|
|
END SUBROUTINE CLEANUP_ICOADS_SHIP
|
|
!EOC
|
|
END MODULE ICOADS_SHIP_MOD
|