901 lines
39 KiB
Fortran
901 lines
39 KiB
Fortran
! $Id: setemis.f,v 1.2 2010/07/30 23:47:05 daven Exp $
|
|
SUBROUTINE SETEMIS( EMISRR, EMISRRN )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine SETEMIS places emissions computed from GEOS-Chem
|
|
! subroutines into arrays for SMVGEAR II chemistry.
|
|
! (lwh, jyl, gmg, djj, bdf, bmy, 6/8/98, 6/11/08)
|
|
!
|
|
! SETEMIS converts from units of [molec tracer/box/s] to units of
|
|
! [molec chemical species/cm3/s], and stores in the REMIS array. For
|
|
! hydrocarbons that are carried through the GEOS-CHEM model as [molec C],
|
|
! these are converted back to [molec hydrocarbon], and then stored in REMIS.
|
|
!
|
|
! REMIS(JLOOP,N) = emis. rate of species corr. to tracer N in box JLOOP
|
|
! (reaction number NTEMIS(N))
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) EMISRR (REAL*8 ) : CO, hydrocarbon emission [molec tracer/box/s ]
|
|
! (2 ) EMISRRN (REAL*8 ) : Multi-level NOx emissions [molec NOx/box/s ]
|
|
!
|
|
! Variables taken from F90 Modules:
|
|
! ============================================================================
|
|
! (1 ) BIOFUEL (REAL*8 ) : Biofuel burning emissions [molec (C)/cm3/s ]
|
|
! (2 ) BFTRACE (INTEGER) : Index array for biofuels [CTM tracer # ]
|
|
! (3 ) NBFTRACE (INTEGER) : Number of biofuel species [unitless ]
|
|
! (4 ) BURNEMIS (REAL*8 ) : Biomass burning emissions [molec (C)/cm3/s ]
|
|
! (5 ) BIOTRCE (INTEGER) : Index array for bioburn [CTM tracer # ]
|
|
! (6 ) NBIOTRCE (INTEGER) : Number of bioburn species [unitless ]
|
|
! (7 ) JLOP (INTEGER) : SMVGEAR grid box index [unitless ]
|
|
! (8 ) REMIS (REAL*8 ) : SMVGEAR emissions array [molec species/cm3/s]
|
|
! (9 ) VOLUME (REAL*8 ) : SMVGEAR volume array [cm3 ]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Original code from Harvard Tropospheric Chemistry Module for 3-D
|
|
! applications by Larry Horowitz, Jinyou Liang, Gerry Gardner,
|
|
! Prof. Daniel Jacob of Harvard University (Release V2.0)
|
|
! (2 ) New version 3.0 by Bob Yantosca to place NOx emissions into boxes
|
|
! above the surface. (bmy, 6/8/98)
|
|
! (3 ) Also now do chemistry up to the location of the annual mean
|
|
! tropopause (bmy, 12/9/99)
|
|
! (4 ) BURNEMIS is now dynamically allocatable and is contained in F90
|
|
! module "biomass_mod.f". BIOTRCE and NBIOTRCE are also contained
|
|
! in "biomass_mod.f". (bmy, 9/12/00)
|
|
! (5 ) BIOFUEL is now dynamically allocatable and is contained in F90
|
|
! module "biofuel_mod.f". BFTRACE and NBFTRACE are also contained
|
|
! in "biofuel_mod.f" (bmy, 9/12/00, 4/17/01)
|
|
! (6 ) BURNEMIS and BIOFUEL are now treated as true global arrays,
|
|
! and need to be referenced by the global offset variables
|
|
! IREF = I + I0 and JREF = J + J0 (bmy, 9/12/00)
|
|
! (7 ) Now reference JLOP, REMIS, VOLUME from F90 module "comode_mod.f",
|
|
! in order to save memory (bmy, 10/19/00)
|
|
! (8 ) Now add in up to NBFTRACE biofuel species (bmy, 4/17/01)
|
|
! (9 ) Add new subroutine header, updated comments, cosmetic changes.
|
|
! (bmy, 4/17/01)
|
|
! (10) Updated comments -- GEMISNOX is [molec/cm3/s]. (bdf, bmy, 6/7/01)
|
|
! (11) For GEOS-3, we now distributes surface emissions throughout the
|
|
! boundary layer. This is necessary since the first couple of GEOS-3
|
|
! surface layers are very thin. Piling up of emissions into a small
|
|
! layer will cause SMVGEAR to choke. (bdf, bmy, 6/15/01)
|
|
! (12) Also now reference BFTRACE and NBFTRACE from "biofuel_mod.f",
|
|
! and reference AD12 from "diag_mod.f". (bdf, bmy, 6/15/01)
|
|
! (13) For GEOS-1, GEOS-STRAT, emit into the surface layer, as we did
|
|
! in prior versions. (bmy, 6/26/01)
|
|
! (14) Bug fix: corrected a typo for the biofuel emissions (bmy, 7/10/01)
|
|
! (15) Bug fix: make sure BIOMASS and BIOFUEL, and SOIL NOx emissions have
|
|
! units of [molec/box/s] before distributing thru the boundary layer.
|
|
! This involves multiplication by VOLUME(JLOOP1) and division by
|
|
! VOLUME(JLOOP). (bmy, 7/16/01)
|
|
! (16) XTRA2(IREF,JREF,5) is now XTRA2(I,J). BIOFUEL(:,IREF,JREF) is now
|
|
! BIOFUEL(:,I,J). BURNEMIS(:,IREF,JREF) is now BURNEMIS(:,I,J).
|
|
! Replace PW(I,J) with P(I,J). (bmy, 9/28/01)
|
|
! (17) Removed obsolete code from 9/01 (bmy, 10/24/01)
|
|
! (18) Now references GET_PEDGE from "pressure_mod.f", to compute P at
|
|
! the bottom edge of grid box (I,J,L). (dsa, bdf, bmy, 8/21/02)
|
|
! (19) Now reference IDTNOX, IDENOX, etc from "tracerid_mod.f" (bmy, 11/6/02)
|
|
! (20) Remove references to IREF, JREF (bmy, 2/11/03)
|
|
! (21) NEMIS is now NEMIS(NCS) for SMVGEAR II (gcc, bdf, bmy, 4/1/03)
|
|
! (22) Added parallel loop over N. Also directly substituted JLOP(I,J,1)
|
|
! for all instances of JLOOP1. Updated comments. (hamid, bmy, 3/19/04)
|
|
! (23) Bug fix for COMPAQ compiler...do not use EXIT from w/in parallel loop.
|
|
! (auvray, bmy, 11/29/04)
|
|
! (24) Now replace XTRA2 with GET_PBL_TOP_L in "pbl_mix_mod.f". Now remove
|
|
! reference to CMN, it's obsolete. Now references GET_TPAUSE_LEVEL
|
|
! from "tropopause_mod.f" (bmy, 8/22/05)
|
|
! (25) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (26) Now updated for new "biomass_mod.f" (bmy, 4/5/06)
|
|
! (27) Now account for the different definition of tropopause in case
|
|
! of variable tropopause. The BIOMASS array from "biomass_mod.f" is
|
|
! now in units of [molec CO/cm2/s]. Adjust unit conversion accordingly.
|
|
! Also replace NBIOMAX with NBIOMAX_GAS, since aerosol biomass is
|
|
! handled elsewhere. (bdf, phs, bmy, 9/27/06)
|
|
! (28) Now replace GEMISNOX array (from CMN_NOX) with module arrays
|
|
! EMIS_LI_NOx and EMIS_AC_NOx (ltm, bmy, 10/3/07)
|
|
! (29) Bug fix: resize EMISRR to be consistent w/ CMN_O3 (bmy, jaf, 6/11/08)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE AIRCRAFT_NOX_MOD, ONLY : EMIS_AC_NOx
|
|
USE BIOFUEL_MOD, ONLY : BIOFUEL, BFTRACE, NBFTRACE
|
|
USE BIOMASS_MOD, ONLY : BIOMASS, BIOTRCE, NBIOMAX_GAS
|
|
USE COMODE_MOD, ONLY : JLOP, REMIS, VOLUME
|
|
USE COMODE_MOD, ONLY : IYSAVE
|
|
USE DIAG_MOD, ONLY : AD12
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE LOGICAL_MOD, ONLY : LVARTROP
|
|
USE LOGICAL_MOD, ONLY : LICOADSSHIP, LEDGARSHIP, LEMEPSHIP
|
|
USE LIGHTNING_NOX_MOD, ONLY : EMIS_LI_NOx
|
|
USE LOGICAL_MOD, ONLY : LRCPSHIP
|
|
USE PBL_MIX_MOD, ONLY : GET_PBL_TOP_L
|
|
USE PRESSURE_MOD, ONLY : GET_PEDGE
|
|
USE TRACERID_MOD, ONLY : CTRMB, IDEMIS, IDENOX
|
|
USE TROPOPAUSE_MOD, ONLY : GET_TPAUSE_LEVEL
|
|
! Ship plume emissions moved from calcrate.F
|
|
USE EDGAR_MOD, ONLY : GET_EDGAR_NOx
|
|
USE ICOADS_SHIP_MOD, ONLY : GET_ICOADS_SHIP
|
|
USE EMEP_MOD, ONLY : GET_EMEP_ANTHRO, GET_EUROPE_MASK
|
|
USE EMISSIONS_MOD, ONLY : NOx_SCALING
|
|
USE COMODE_MOD, ONLY : CSPEC, AIRDENS
|
|
USE RCP_MOD, ONLY : GET_RCP_EMISSION
|
|
USE LOGICAL_MOD, ONLY : LDRYD, LPRT
|
|
USE DIAG_MOD, ONLY : AD32_SHIP, AD32_SHIP_COUNT
|
|
USE DIAG_MOD, ONLY : AD36_SHIP, AD36_SHIP_COUNT
|
|
USE DIAG_MOD, ONLY : AD63, AD63_COUNT
|
|
USE DRYDEP_MOD, ONLY : SHIPO3DEP
|
|
USE TRACERID_MOD, ONLY : IDTNO, IDTNOX, IDTHNO3
|
|
USE TRACERID_MOD, ONLY : IDO3, IDHNO3, IDNO2, IDNO
|
|
USE TRACERID_MOD, ONLY : IDEHNO3, IDEOX
|
|
USE DAO_MOD, ONLY : BXHEIGHT, SUNCOS
|
|
USE PARANOX_MOD, ONLY : INTERPOLATE_LUT2
|
|
!USE DIAG63_MOD, ONLY : DO_SAVE_DIAG63
|
|
|
|
! adj_group
|
|
USE ADJ_ARRAYS_MOD, ONLY : NADJ_EANTHRO
|
|
USE ADJ_ARRAYS_MOD, ONLY : NADJ_EBIOMASS
|
|
USE ADJ_ARRAYS_MOD, ONLY : NADJ_EBIOFUEL
|
|
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ENOX_so
|
|
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ENOX_li
|
|
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ENOX_ac
|
|
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_NOX" ! GEMISNOX2
|
|
# include "CMN_DIAG" ! Diagnostic flags
|
|
# include "comode.h" ! IDEMS, NEMIS
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(IN) :: EMISRR(IIPAR,JJPAR,NEMPARA+NEMPARB)
|
|
REAL*8, INTENT(IN) :: EMISRRN(IIPAR,JJPAR,NOXEXTENT)
|
|
|
|
! Local variables
|
|
LOGICAL :: IS_LI_NOx, IS_AC_NOx
|
|
INTEGER :: I, J, JLOOP, JLOOP1, LTROP
|
|
INTEGER :: L, LL, N, NN, NBB, NBF, TOP
|
|
REAL*8 :: COEF1, TOTPRES, DELTPRES
|
|
REAL*8 :: EMIS_BL, NOXTOT, TOTAL, A_CM2
|
|
|
|
REAL*8 :: SHIP, TOTO3, JNO2, JO1D
|
|
REAL*8 :: DTSRCE, AREA_CM2
|
|
REAL*4 :: FRACTION_NOX, INT_OPE
|
|
INTEGER :: NK
|
|
CHARACTER*8 :: SPECNAME
|
|
REAL*8, EXTERNAL :: FJFUNC
|
|
|
|
! adj_group
|
|
INTEGER :: M
|
|
|
|
!=================================================================
|
|
! SETEMIS begins here!
|
|
!=================================================================
|
|
|
|
! Test if the EMIS_LI_NOx and EMIS_AC_NOx arrays are allocated
|
|
IS_LI_NOx = ALLOCATED( EMIS_LI_NOx )
|
|
IS_AC_NOX = ALLOCATED( EMIS_AC_NOX )
|
|
|
|
! adj_group
|
|
!M = GET_M
|
|
M = 1
|
|
|
|
! Now reset REMIS here
|
|
REMIS(:,:) = 0d0
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( N, NN, NBB, NBF, I )
|
|
!$OMP+PRIVATE( J, L, JLOOP, COEF1, TOP )
|
|
!$OMP+PRIVATE( TOTPRES, NOXTOT, DELTPRES, EMIS_BL, A_CM2 )
|
|
!$OMP+PRIVATE( TOTO3, SHIP, AREA_CM2, FRACTION_NOX, INT_OPE )
|
|
!$OMP+PRIVATE( NK, JNO2, JO1D, SPECNAME )
|
|
!$OMP+SCHEDULE( DYNAMIC )
|
|
|
|
! Loop over emission species
|
|
DO N = 1, NEMIS(NCS)
|
|
|
|
! Get CTM tracer number NN corresponding to emission species N
|
|
NN = IDEMS(N)
|
|
IF ( NN == 0 ) CYCLE
|
|
|
|
! We have to search for the biomass burning species in
|
|
! BIOTRCE with the same CTM tracer number NN as in IDEMS
|
|
NBB = 0
|
|
IF ( ALLOCATED( BIOMASS ) ) THEN
|
|
DO I = 1, NBIOMAX_GAS
|
|
IF ( BIOTRCE(I) == NN ) THEN
|
|
NBB = I
|
|
#if defined( COMPAQ )
|
|
! COMPAQ has an issue with EXIT from w/in parallel loop
|
|
! (auvray, bmy, 11/29/04)
|
|
#else
|
|
EXIT
|
|
#endif
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! We have to search for the biofuel burning species in
|
|
! BFTRACE with the same CTM tracer number NN as in IDEMS
|
|
NBF = 0
|
|
IF ( ALLOCATED( BIOFUEL ) ) THEN
|
|
DO I = 1, NBFTRACE
|
|
IF ( BFTRACE(I) == NN ) THEN
|
|
NBF = I
|
|
#if defined( COMPAQ )
|
|
! COMPAQ has an issue with EXIT from w/in parallel loop
|
|
! (auvray, bmy, 11/29/04)
|
|
#else
|
|
EXIT
|
|
#endif
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! Need to do this outside the N loop because ship alters REMIS fir multiple N
|
|
! ! Initialize REMIS(*,N) -- the emission rate array
|
|
! DO JLOOP = 1, NTTLOOP
|
|
! REMIS(JLOOP,N) = 0d0
|
|
! ENDDO
|
|
|
|
! COEF1 = molecules of emission species / molecules of tracer
|
|
COEF1 = 1.0 + CTRMB(NN, IDEMIS(NN))
|
|
|
|
! Loop over Lat and Long boxes
|
|
DO J = 1, NLAT
|
|
DO I = 1, NLONG
|
|
|
|
!===========================================================
|
|
! For GEOS-3: distribute surface emissions throughout the
|
|
! entire boundary layer. Define some variables here.
|
|
! (bdf, 6/15/01)
|
|
!===========================================================
|
|
|
|
! Top level of the boundary layer
|
|
! guard for b.l. being in first level.
|
|
TOP = FLOOR( GET_PBL_TOP_L( I, J ) )
|
|
IF ( TOP == 0 ) TOP = 1
|
|
|
|
! Pressure thickness of entire boundary layer [hPa]
|
|
TOTPRES = GET_PEDGE(I,J,1) - GET_PEDGE(I,J,TOP+1)
|
|
|
|
! For NOx only....
|
|
IF ( N == IDENOX ) THEN
|
|
|
|
!========================================================
|
|
! Anthropogenic NOx emissions [molec/box/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!========================================================
|
|
|
|
! Sum anthro NOx emissions over all levels [molec NOx/box/s]
|
|
NOXTOT = 0d0
|
|
DO L = 1, NOXEXTENT
|
|
NOXTOT = NOXTOT + EMISRRN(I,J,L)
|
|
ENDDO
|
|
|
|
! Loop over the boundary layer
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! Of the total anthro NOx, the fraction DELTPRES/TOTPRES
|
|
! goes into level L, since that is the fraction of the
|
|
! boundary layer occupied by level L. Also divide NOx
|
|
! by COEF1 to convert from [molec NOx/box/s] to
|
|
! [molec NO/box/s], which is really what gets emitted.
|
|
! adj_group: apply scaling factors (dkh, 03/30/10)
|
|
IF ( NADJ_EANTHRO(NN) > 0 ) THEN
|
|
EMIS_BL = ( NOXTOT / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES ) *
|
|
& EMS_SF(I,J,M,NADJ_EANTHRO(NN))
|
|
ELSE
|
|
EMIS_BL = ( NOXTOT / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES )
|
|
ENDIF
|
|
|
|
! Convert anthro NOx emissions from [molec NO/box/s]
|
|
! to [molec NO/cm3/s] and store in the REMIS array
|
|
REMIS(JLOOP,N) = EMIS_BL / VOLUME(JLOOP)
|
|
ENDIF
|
|
ENDDO
|
|
|
|
!========================================================
|
|
! Soil Nox emissions [molec/cm3/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!========================================================
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! Soil NOx is in [molec/cm3/s], so we need to multiply
|
|
! by VOLUME(JLOP(I,J,1)) to convert it to [molec/box/s],
|
|
! VOLUME(JLOP(I,J,1)) is the volume in cm3 of the surface
|
|
! grid box (I,J,1). Then we need to divide that by
|
|
! COEF1 to convert from [molec NOx/box/s] to
|
|
! [molec NO/box/s], which is really what gets emitted.
|
|
! Of the total soil NOx, the fraction DELTPRES/TOTPRES
|
|
! goes into level L, since that is the fraction of the
|
|
! boundary layer occupied by level L. Store in EMIS_BL.
|
|
! adj_group: apply scaling factors (dkh, 03/30/10)
|
|
IF ( IDADJ_ENOX_so > 0 ) THEN
|
|
EMIS_BL = ( GEMISNOX2(I,J) *
|
|
& VOLUME( JLOP(I,J,1) ) / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES ) *
|
|
& EMS_SF(I,J,M,IDADJ_ENOX_so)
|
|
ELSE
|
|
EMIS_BL = ( GEMISNOX2(I,J) *
|
|
& VOLUME( JLOP(I,J,1) ) / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES )
|
|
ENDIF
|
|
|
|
! Since EMIS_BL is in [molec NO/box/s], we have to
|
|
! divide by VOLUME(JLOOP), which is the volume of the
|
|
! grid box (I,J,L) to convert back to [molec/cm3/s].
|
|
! Store in the REMIS array for SMVGEAR.
|
|
REMIS(JLOOP,N) = REMIS(JLOOP,N) +
|
|
& ( EMIS_BL / VOLUME(JLOOP) )
|
|
ENDIF
|
|
ENDDO
|
|
|
|
!========================================================
|
|
! Aircraft and Lightning NOx [molec/cm3/s]
|
|
! Distribute emissions in the troposphere
|
|
!========================================================
|
|
|
|
! bdf - variable tropopause is a tropospheric box
|
|
IF ( LVARTROP ) THEN
|
|
LTROP = GET_TPAUSE_LEVEL( I, J )
|
|
ELSE
|
|
LTROP = GET_TPAUSE_LEVEL( I, J ) - 1
|
|
ENDIF
|
|
|
|
|
|
DO L = 1, LTROP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
!-----------------
|
|
! Lightning NOx
|
|
!-----------------
|
|
IF ( IS_LI_NOx ) THEN
|
|
|
|
! Divide lightning NOx by COEF1 to convert
|
|
! from [molec NOx/cm3/s] to [molec NO/cm3/s], since
|
|
! NO is the actual emission species for NOx.
|
|
! adj_group: apply scaling factors
|
|
IF ( IDADJ_ENOX_li > 0 ) THEN
|
|
EMIS_BL = EMIS_LI_NOx(I,J,L) / COEF1 *
|
|
& EMS_SF(I,J,M,IDADJ_ENOX_li)
|
|
ELSE
|
|
EMIS_BL = EMIS_LI_NOx(I,J,L) / COEF1
|
|
ENDIF
|
|
|
|
! Save lightning NOx [molec NO/cm3/s] in REMIS
|
|
REMIS(JLOOP,N) = REMIS(JLOOP,N) + EMIS_BL
|
|
ENDIF
|
|
|
|
!-----------------
|
|
! Aircraft NOx
|
|
!-----------------
|
|
IF ( IS_AC_NOx ) THEN
|
|
|
|
! Divide aircraft NOx by COEF1 to convert
|
|
! from [molec NOx/cm3/s] to [molec NO/cm3/s], since
|
|
! NO is the actual emission species for NOx.
|
|
! adj_group: apply scaling factors
|
|
IF ( IDADJ_ENOX_ac > 0 ) THEN
|
|
EMIS_BL = EMIS_AC_NOx(I,J,L) / COEF1 *
|
|
& EMS_SF(I,J,M,IDADJ_ENOX_ac)
|
|
ELSE
|
|
EMIS_BL = EMIS_AC_NOx(I,J,L) / COEF1
|
|
ENDIF
|
|
|
|
! Save aircraft NOx [molec NO/cm3/s] in REMIS
|
|
REMIS(JLOOP,N) = REMIS(JLOOP,N) + EMIS_BL
|
|
ENDIF
|
|
|
|
ENDIF
|
|
ENDDO
|
|
|
|
!========================================================
|
|
! Ship NOx (emitted as NO, O3, HNO3 after plume evolution)
|
|
! [molec/cm3/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!========================================================
|
|
|
|
! Update only if ship emissions are turned on
|
|
IF ( LICOADSSHIP .or. LEDGARSHIP .or. LEMEPSHIP ) THEN
|
|
|
|
! Surface area of grid box
|
|
AREA_CM2 = GET_AREA_CM2( J )
|
|
|
|
! Reset
|
|
SHIP = 0D0
|
|
|
|
! handle global inventory first
|
|
IF ( LEDGARSHIP ) THEN
|
|
|
|
! Get SHIP EDGAR emissions for NOx [molec/cm2/s]
|
|
SHIP = GET_EDGAR_NOx( I, J,
|
|
& MOLEC_CM2_S=.TRUE., SHIP=.TRUE.)
|
|
|
|
! ICOADS ship emissions (cklee,7/09/09)
|
|
ELSE IF ( LICOADSSHIP ) THEN
|
|
|
|
! Get ICOADS emissions for NOx [molec/cm2/s]
|
|
SHIP = GET_ICOADS_SHIP( I, J, IDTNOX,
|
|
& MOLEC_CM2_S=.TRUE. )
|
|
|
|
! RCP ship emissions (cdh, 10/14/11)
|
|
ELSE IF ( LRCPSHIP ) THEN
|
|
|
|
! Get SHIP RCP emissions for NOx [molec/cm2/s]
|
|
SHIP = GET_RCP_EMISSION( I, J, IDTNOX,
|
|
& LAND=.FALSE., SHIP=.TRUE.)
|
|
|
|
ENDIF
|
|
|
|
! Overwrite Europe
|
|
IF ( LEMEPSHIP ) THEN
|
|
|
|
! Prevent overwriting ICOADS data with a 0 value from EMEP
|
|
IF (GET_EUROPE_MASK( I, J ) > 0d0) THEN
|
|
|
|
! Get SHIP EMEP emissions for NOx [molec/cm2/s]
|
|
SHIP = GET_EMEP_ANTHRO( I, J, IDTNOX,
|
|
& SHIP=.TRUE. )
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
! Add possible scaling of NOx emissions
|
|
SHIP = SHIP * NOx_SCALING
|
|
|
|
!----------------------------------
|
|
! Get J-Values for J(NO2) and J(O3)
|
|
!----------------------------------
|
|
|
|
! Check if sun is up
|
|
!Need to replace with SUNCOS. Careful -- SUNCOS has JLOOP 1D index.
|
|
!Need to convert from I,J
|
|
JLOOP = JLOP(I,J,1)
|
|
IF (SUNCOS(JLOOP) > 0d0 ) THEN
|
|
|
|
! Loop over photolysis reactions to find NO2, O3
|
|
DO L = 1, JPHOTRAT(NCS)
|
|
|
|
! Reaction number
|
|
NK = NRATES(NCS) + L
|
|
|
|
! Name of species being photolyzed
|
|
SPECNAME = NAMEGAS(IRM(1,NK,NCS))
|
|
|
|
! Check if this is NO2 or O3, store values, 1/s
|
|
SELECT CASE ( TRIM( SPECNAME ) )
|
|
CASE ( 'NO2' )
|
|
JNO2 = FJFUNC(I,J,1,L,1,SPECNAME)
|
|
CASE ( 'O3' )
|
|
JO1D = FJFUNC(I,J,1,L,1,SPECNAME)
|
|
CASE DEFAULT
|
|
END SELECT
|
|
|
|
ENDDO
|
|
|
|
ELSE
|
|
|
|
! J-values are zero when sun is down
|
|
JNO2 = 0d0
|
|
JO1D = 0d0
|
|
|
|
ENDIF
|
|
|
|
! Determine fraction of NOx remaining and integrated Ozone
|
|
! Production Efficiency for ship emiss (gvinken,mpayer,2/7/12)
|
|
! Uses surface-layer concentrations of O3, NO, NO2 (molec/cm3)
|
|
! from CSPEC and air density (molec/cm3)
|
|
CALL INTERPOLATE_LUT2( I, J,
|
|
& CSPEC(JLOOP,IDO3), CSPEC(JLOOP,IDNO),
|
|
& CSPEC(JLOOP,IDNO2), AIRDENS(JLOOP),
|
|
& JO1D, JNO2,
|
|
& FRACTION_NOx, INT_OPE)
|
|
|
|
!-----------------
|
|
! Ship NO
|
|
!-----------------
|
|
|
|
! Loop over the boundary layer
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP == 0 ) CYCLE
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! LNLPBL not yet supported for adjoint code
|
|
! ! Add option for non-local PBL (Lin, 03/31/09)
|
|
! IF (LNLPBL) DELTPRES = TOTPRES
|
|
|
|
! Of the total ship NOx, the fraction FRACTION_NOX
|
|
! survives after plume dilution and chemistry.
|
|
! The fraction DELTPRES/TOTPRES goes into level L,
|
|
! since that is the fraction of the boundary layer
|
|
! mass occupied by level L.
|
|
! Final units: molec(NO)/cm2/s
|
|
EMIS_BL = ( SHIP * FRACTION_NOX )
|
|
& * ( DELTPRES / TOTPRES )
|
|
|
|
! Convert anthro NOx emissions from [molec NO/cm2/s]
|
|
! to [molec NO/cm3/s] and store in the REMIS array
|
|
REMIS(JLOOP,IDENOX) = REMIS(JLOOP,IDENOX)
|
|
& + ( EMIS_BL * AREA_CM2 )
|
|
& / VOLUME(JLOOP)
|
|
|
|
|
|
ENDDO
|
|
|
|
!-----------------
|
|
! Ship HNO3
|
|
!-----------------
|
|
|
|
! Loop over the boundary layer
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP == 0 ) CYCLE
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! LNLPBL not yet supported for adjoint code
|
|
! ! Add option for non-local PBL (Lin, 03/31/09)
|
|
! IF (LNLPBL) DELTPRES = TOTPRES
|
|
|
|
! Of the total ship NOx, the fraction (1d0-FRACTION_NOX)
|
|
! is converted to HNO3 during plume dilution and chemistry.
|
|
! The fraction DELTPRES/TOTPRES goes into level L,
|
|
! since that is the fraction of the boundary layer
|
|
! mass occupied by level L. Also, divide by COEF11
|
|
! to convert from [molec tracer/cm2/s] to
|
|
! [molec chem species/cm2/s].
|
|
! Final units: molec(HNO3)/cm2/s
|
|
EMIS_BL = SHIP * ( 1D0 - FRACTION_NOX ) *
|
|
& ( DELTPRES / TOTPRES )
|
|
|
|
! Convert ship HNO3 emissions from [molec HNO3/cm2/s]
|
|
! to [molec HNO3/cm3/s] and store in the REMIS array
|
|
REMIS(JLOOP,IDEHNO3) = REMIS(JLOOP,IDEHNO3)
|
|
& + ( EMIS_BL * AREA_CM2 )
|
|
& / VOLUME(JLOOP)
|
|
|
|
ENDDO
|
|
|
|
!-----------------
|
|
! Ship O3
|
|
!-----------------
|
|
|
|
! Total emissions over the boundary layer
|
|
! Of the total ship NOx, the fraction
|
|
! (1d0-FRACTION_NOX)*INT_OPE is converted to O3 during
|
|
! plume dilution and chemistry.
|
|
! Final units: molec(O3)/cm2/s
|
|
EMIS_BL = SHIP * (1D0 - FRACTION_NOX) * INT_OPE
|
|
|
|
! Ship plume chemistry can create or destroy net O3
|
|
! Treat positive O3 production as emissions
|
|
! Treat O3 *destruction* in plume as dry deposition
|
|
! (cdh, 3/21/2013)
|
|
IF (EMIS_BL >= 0d0) THEN
|
|
|
|
! No need for deposition when net O3 production from
|
|
! ships is positive
|
|
!$OMP CRITICAL
|
|
IF (LDRYD) SHIPO3DEP(I,J) = 0d0
|
|
!$OMP END CRITICAL
|
|
|
|
! Loop over the boundary layer
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP == 0 ) CYCLE
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! LNLPBL not yet supported for adjoint code
|
|
! ! Add option for non-local PBL (Lin, 03/31/09)
|
|
! IF (LNLPBL) DELTPRES = TOTPRES
|
|
|
|
! The fraction DELTPRES/TOTPRES goes into level L,
|
|
! since that is the fraction of the boundary layer
|
|
! mass occupied by level L.
|
|
! The ratio ( AREA_CM2 / VOLUME(JLOOP) ) converts
|
|
! molec/cm2 to molec/cm3
|
|
! Final units: molec(O3)/cm3/s
|
|
REMIS(JLOOP,IDEOX) = REMIS(JLOOP,IDEOX)
|
|
& + EMIS_BL
|
|
& * ( DELTPRES / TOTPRES )
|
|
& * AREA_CM2 / VOLUME(JLOOP)
|
|
|
|
ENDDO
|
|
|
|
ELSE
|
|
|
|
! No change in REMIS
|
|
|
|
! Initialize
|
|
TOTO3 = 0d0
|
|
|
|
! Loop over the boundary layer
|
|
! If LNLPBL, then TOP=1
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP == 0 ) CYCLE
|
|
|
|
! Cumulative O3 in the PBL, molec(O3)/cm2
|
|
TOTO3 = TOTO3 + ( BXHEIGHT(I,J,L) *
|
|
& 1d2 ) * CSPEC(JLOOP,IDO3)
|
|
|
|
ENDDO
|
|
|
|
! Effective O3 deposition frequency
|
|
! EMIS_BL (negative) is total O3 destruction in the
|
|
! column, molec(O3)/cm2/s
|
|
! TOTO3 is the total O3 content of the PBL, molec(O3)/cm2
|
|
! Final units: 1/s
|
|
!$OMP CRITICAL
|
|
IF ( LDRYD .and. ( TOTO3 .ge. 1d0 ) )
|
|
& SHIPO3DEP(I,J) = ABS( EMIS_BL / TOTO3 )
|
|
!$OMP END CRITICAL
|
|
|
|
ENDIF
|
|
|
|
!-----------------
|
|
! Ship diagnostics
|
|
!-----------------
|
|
|
|
!ND36 = Anthro source diagnostic [molec/cm2/s]
|
|
! We need separate arrays for ship emissions because
|
|
! other emissions are calculated at different model times
|
|
IF ( ND36 > 0 ) THEN
|
|
|
|
AD36_SHIP(I,J,IDEHNO3) = AD36_SHIP(I,J,IDEHNO3) +
|
|
& SHIP * (1D0 - FRACTION_NOx)
|
|
|
|
AD36_SHIP(I,J,IDEOX) = AD36_SHIP(I,J,IDEOX) +
|
|
& SHIP * (1D0 - FRACTION_NOx) * INT_OPE
|
|
|
|
AD36_SHIP(I,J,IDENOX) = AD36_SHIP(I,J,IDENOX) +
|
|
& SHIP * FRACTION_NOx
|
|
|
|
! Increment counter, only once per time step
|
|
IF ( (I == 1) .and. (J==1) ) THEN
|
|
AD36_SHIP_COUNT = AD36_SHIP_COUNT + 1
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
! ND32 = save anthro NOx for levels L=1,NOXEXTENT
|
|
! [molec/cm2/s]
|
|
IF ( ND32 > 0 ) THEN
|
|
|
|
AD32_ship(I,J) = AD32_ship(I,J) +
|
|
& ( SHIP * FRACTION_NOx )
|
|
|
|
! Increment counter, only once per time step
|
|
IF ( (I == 1) .and. (J==1) ) THEN
|
|
AD32_SHIP_COUNT = AD32_SHIP_COUNT + 1
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
! ND63 = save the fraction of NOx remaining, integrated OPE
|
|
! and total emissions of NOx and O3
|
|
! IF ( DO_SAVE_DIAG63 ) THEN
|
|
!
|
|
! ! Surviving fraction of emitted NOx, mol/mol
|
|
! AD63(I,J,1) = AD63(I,J,1) + FRACTION_NOx
|
|
!
|
|
! ! Integraed OPE, mol/mol
|
|
! AD63(I,J,2) = AD63(I,J,2) + INT_OPE
|
|
!
|
|
! ! Surviving NOx, molec/cm2
|
|
! ! (converted to molec/cm2/s in diag63_mod)
|
|
! AD63(I,J,3) = AD63(I,J,3) +
|
|
! & SHIP * FRACTION_NOx
|
|
!
|
|
! ! Ozone produced, molec/cm2
|
|
! ! (converted to molec/cm2/s in diag63_mod)
|
|
! AD63(I,J,4) = AD63(I,J,4) +
|
|
! & SHIP * (1D0 - FRACTION_NOx) * INT_OPE
|
|
!
|
|
! ! NOx emitted at ship stack, molec/cm2
|
|
! ! (converted to molec/cm2/s in diag63_mod)
|
|
! AD63(I,J,5) = AD63(I,J,5) + SHIP
|
|
!
|
|
! ! Increment counter, only once per time step
|
|
! IF ( (I == 1) .and. (J==1) ) THEN
|
|
! AD63_COUNT = AD63_COUNT + 1d0
|
|
! ENDIF
|
|
!
|
|
! ENDIF
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
!========================================================
|
|
! Anthropogenic tracers other than NOx [molec/box/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!========================================================
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! Of the total tracer, the fraction DELTPRES/TOTPRES
|
|
! goes into level L, since that is the fraction of the
|
|
! boundary layer occupied by level L. Also divide the
|
|
! tracer by COEF1 to convert from [molec tracer/box/s]
|
|
! to [molec species/box/s]. For example, ISOPRENE is
|
|
! carried by GEOS-CHEM as 5 carbons, so you would divide
|
|
! by 5 to get "effective molecules" of ISOPRENE.
|
|
! adj_group: apply scaling factors (dkh, 03/30/10)
|
|
IF ( NADJ_EANTHRO(NN) > 0 ) THEN
|
|
EMIS_BL = ( EMISRR(I,J,N) / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES ) *
|
|
& EMS_SF(I,J,M,NADJ_EANTHRO(NN))
|
|
! ! dkh debug
|
|
! IF ( I == IFD .and. J == JFD .and. L == LFD ) THEN
|
|
! print*, 'ddd fwd EMISRR', EMISRR(I,J,N)
|
|
! print*, 'ddd fwd COEF1', COEF1
|
|
! print*, 'ddd fwd DELTPRES ', DELTPRES
|
|
! print*, 'ddd fwd TOTPRES ', TOTPRES
|
|
! print*, 'ddd fwd EMIS_BL ', EMIS_BL
|
|
! print*, 'ddd EMS_SF ',
|
|
! & EMS_SF(I,J,M,NADJ_EANTHRO(NN)), N, NN,
|
|
! & NADJ_EANTHRO(NN)
|
|
! ENDIF
|
|
ELSE
|
|
EMIS_BL = ( EMISRR(I,J,N) / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES )
|
|
ENDIF
|
|
|
|
! Convert emissions from [molec species/box/s] to
|
|
! [molec species/cm3/s] and store in the REMIS array
|
|
REMIS(JLOOP,N) = EMIS_BL / VOLUME(JLOOP)
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!===========================================================
|
|
! Add biomass burning source [molec/cm3/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!===========================================================
|
|
IF ( NBB /= 0 ) THEN
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! Grid box area [cm2]
|
|
A_CM2 = GET_AREA_CM2( IYSAVE(JLOOP) )
|
|
|
|
! Biomass burning is in [molec/cm2/s], so we need to
|
|
! multiply by A_CM2 to convert it to [molec/box/s].
|
|
! Then we need to divide that by COEF1 to convert from
|
|
! [molec tracer/box/s] to [molec species/box/s].
|
|
! Of the total biomass burning emissions, the fraction
|
|
! DELTPRES/TOTPRES goes into level L, since that is the
|
|
! fraction of the boundary layer occupied by level L.
|
|
! Store in EMIS_BL.
|
|
IF ( NADJ_EBIOMASS(NN) > 0 ) THEN
|
|
EMIS_BL = ( BIOMASS(I,J,NBB) * A_CM2 / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES ) *
|
|
& EMS_SF(I,J,M,NADJ_EBIOMASS(NN))
|
|
ELSE
|
|
EMIS_BL = ( BIOMASS(I,J,NBB) * A_CM2 / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES )
|
|
ENDIF
|
|
! Since EMIS_BL is in [molec species/box/s], we
|
|
! have to divide by VOLUME(JLOOP), which is the
|
|
! volume of the grid box (I,J,L) to convert back to
|
|
! [molec species/cm3/s]. Store in the REMIS array.
|
|
REMIS(JLOOP,N) = REMIS(JLOOP,N) +
|
|
& ( EMIS_BL / VOLUME(JLOOP) )
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!===========================================================
|
|
! Add biofuel burning source [molec/cm3/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!===========================================================
|
|
IF ( NBF /= 0 ) THEN
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
EMIS_BL = 0d0
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! Biofuel burning is in [molec/cm3/s], so we need to
|
|
! multiply by VOLUME(JLOP(I,J,1)) to convert it to
|
|
! [molec/box/s], VOLUME(JLOP(I,J,1)) is the volume in cm3
|
|
! of the surface grid box (I,J,1). Then we need to
|
|
! divide that by COEF1 to convert from
|
|
! [molec tracer/box/s] to [molec species/box/s].
|
|
! Of the total biofuel burning emissions, the fraction
|
|
! DELTPRES/TOTPRES goes into level L, since that is the
|
|
! fraction of the boundary layer occupied by level L.
|
|
! Store in EMIS_BL.
|
|
! adj_group: apply scaling factors (dkh, 03/30/10)
|
|
IF ( NADJ_EBIOFUEL(NN) > 0 ) THEN
|
|
EMIS_BL = ( BIOFUEL(NBF,I,J) *
|
|
& VOLUME( JLOP(I,J,1) ) / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES ) *
|
|
& EMS_SF(I,J,M,NADJ_EBIOFUEL(NN))
|
|
ELSE
|
|
EMIS_BL = ( BIOFUEL(NBF,I,J) *
|
|
& VOLUME( JLOP(I,J,1) ) / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES )
|
|
ENDIF
|
|
|
|
! Since EMIS_BL is in [molec species/box/s], we
|
|
! have to divide by VOLUME(JLOOP), which is the
|
|
! volume of the grid box (I,J,L) to convert back to
|
|
! [molec species/cm3/s]. Store in the REMIS array.
|
|
REMIS(JLOOP,N) = REMIS(JLOOP,N) +
|
|
& ( EMIS_BL / VOLUME(JLOOP) )
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!===========================================================
|
|
! ND12 Diagnostic: Save the fraction of the boundary layer
|
|
! occupied by level L into the AD12 diagnostic array.
|
|
!===========================================================
|
|
IF ( N == 1 .and. ND12 > 0 ) THEN
|
|
DO L = 1, MIN( TOP, LD12 )
|
|
|
|
! Thickness of layer L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! Save boundary layer fraction into AD12
|
|
AD12(I,J,L) = AD12(I,J,L) + ( DELTPRES / TOTPRES )
|
|
ENDDO
|
|
ENDIF
|
|
|
|
ENDDO ! I
|
|
ENDDO ! J
|
|
ENDDO ! N
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE SETEMIS
|