885 lines
34 KiB
Fortran
885 lines
34 KiB
Fortran
! $Id: setemis_adj.f,v 1.1 2010/04/01 07:09:43 daven Exp $
|
|
SUBROUTINE SETEMIS_ADJ( )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine SETEMIS_ADJ passes adjoints from SMVGEAR array adjoint REMIS_ADJ
|
|
! back to GEOS-Chem emission adjoint arrays, e.g., BIOFUEL_ADJ
|
|
!
|
|
! Based on forward code SETEMIS (lwh, jyl, gmg, djj, bdf, bmy, 6/8/98, 6/11/08)
|
|
!
|
|
! 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 LIGHTNING_NOX_MOD, ONLY : EMIS_LI_NOx
|
|
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, CSPEC_ADJ
|
|
USE COMODE_MOD, ONLY : CSPEC_ORIG, CSPEC_FOR_KPP
|
|
USE LOGICAL_MOD, ONLY : LDRYD, LPRT
|
|
USE LOGICAL_MOD, ONLY : LICOADSSHIP, LEDGARSHIP, LEMEPSHIP
|
|
USE DRYDEP_MOD, ONLY : SHIPO3DEP
|
|
USE ADJ_ARRAYS_MOD, ONLY : SHIPO3DEP_ADJ
|
|
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, SUNCOS_5hr
|
|
USE PARANOX_MOD, ONLY : INTERPOLATE_LUT2
|
|
USE PARANOX_ADJ_MOD, ONLY : INTERPOLATE_LUT2_ADJ
|
|
USE COMODE_MOD, ONLY : CHK_CSPEC
|
|
|
|
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_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : REMIS_ADJ
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_NOX" ! GEMISNOX2
|
|
# include "CMN_O3" ! EMISRR, EMISRRN
|
|
# include "comode.h" ! IDEMS, NEMIS
|
|
|
|
! 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
|
|
|
|
REAL*8 :: EMIS_BL_ADJ
|
|
REAL*4 :: FRACTION_NOX_ADJ
|
|
REAL*4 :: INT_OPE_ADJ
|
|
REAL*8 :: SHIP_ADJ
|
|
REAL*8 :: TOTO3_ADJ
|
|
REAL*8 :: O3_ADJ
|
|
REAL*8 :: NO_ADJ
|
|
REAL*8 :: NO2_ADJ
|
|
|
|
INTEGER :: M
|
|
|
|
!=================================================================
|
|
! SETEMIS_ADJ 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 )
|
|
|
|
M = 1
|
|
|
|
NCS = NCSURBAN
|
|
|
|
!$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+PRIVATE( EMIS_BL_ADJ, TOTO3_ADJ,INT_OPE_ADJ )
|
|
!$OMP+PRIVATE( FRACTION_NOX_ADJ,SHIP_ADJ )
|
|
!$OMP+PRIVATE( O3_ADJ, NO_ADJ, NO2_ADJ )
|
|
!$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
|
|
|
|
! 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)
|
|
|
|
!===========================================================
|
|
! Adjoint of biofuel burning source [molec/cm3/s]
|
|
!===========================================================
|
|
IF ( NBF /= 0 ) THEN
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,N) = REMIS(JLOOP,N) +
|
|
! ( EMIS_BL / VOLUME(JLOOP) )
|
|
! adj code:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N) / VOLUME(JLOOP)
|
|
|
|
! recalc DELTPRES
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! fwd code:
|
|
! Store in EMIS_BL.
|
|
!EMIS_BL = ( BIOFUEL(NBF,I,J) *
|
|
! VOLUME( JLOP(I,J,1) ) / COEF1 ) *
|
|
! ( DELTPRES / TOTPRES )
|
|
! * BIOFUEL_ICS(I,J,NBF)
|
|
IF ( NADJ_EBIOFUEL(NN) > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,NADJ_EBIOFUEL(NN))
|
|
& = EMS_SF_ADJ(I,J,M,NADJ_EBIOFUEL(NN))
|
|
& + ( BIOFUEL(NBF,I,J)
|
|
& * VOLUME( JLOP(I,J,1) ) / COEF1 )
|
|
& * ( DELTPRES / TOTPRES )
|
|
& * EMIS_BL_ADJ
|
|
ENDIF
|
|
|
|
ENDIF
|
|
EMIS_BL_ADJ = 0d0
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!===========================================================
|
|
! Adjoint of biomass burning source [molec/cm3/s]
|
|
!===========================================================
|
|
IF ( NBB /= 0 ) THEN
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,N) = REMIS(JLOOP,N) +
|
|
& ! ( EMIS_BL / VOLUME(JLOOP) )
|
|
! adj code:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N) / VOLUME(JLOOP)
|
|
|
|
! 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) )
|
|
|
|
! fwd code:
|
|
!EMIS_BL = ( BIOMASS(I,J,NBB) * A_CM2 / COEF1 ) *
|
|
! ( DELTPRES / TOTPRES )
|
|
! adj code:
|
|
IF ( NADJ_EBIOMASS(NN) > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,NADJ_EBIOMASS(NN))
|
|
& = EMS_SF_ADJ(I,J,M,NADJ_EBIOMASS(NN))
|
|
& + BIOMASS(I,J,NBB) * A_CM2 / COEF1
|
|
& * ( DELTPRES / TOTPRES )
|
|
& * EMIS_BL_ADJ
|
|
ENDIF
|
|
|
|
|
|
ENDIF
|
|
EMIS_BL_ADJ = 0d0
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!===========================================================
|
|
! Adjoints of non-NOx sources
|
|
!===========================================================
|
|
IF ( N /= IDENOX ) THEN
|
|
|
|
!========================================================
|
|
! Anthropogenic tracers other than NOx [molec/box/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!========================================================
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,N) = EMIS_BL / VOLUME(JLOOP)
|
|
! adj code:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N) / VOLUME(JLOOP)
|
|
|
|
! fwd code:
|
|
!EMIS_BL = ( EMISRR(I,J,N) / COEF1 ) *
|
|
! ( DELTPRES / TOTPRES )
|
|
! adj code:
|
|
IF ( NADJ_EANTHRO(NN) > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,NADJ_EANTHRO(NN))
|
|
& = EMS_SF_ADJ(I,J,M,NADJ_EANTHRO(NN))
|
|
& + ( EMISRR(I,J,N) / COEF1 )
|
|
& * ( DELTPRES / TOTPRES )
|
|
& * EMIS_BL_ADJ
|
|
ENDIF
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! fwd code:
|
|
!EMIS_BL = 0d0
|
|
! adj code:
|
|
EMIS_BL_ADJ = 0d0
|
|
|
|
! For NOx only....
|
|
ELSEIF( N == IDENOX ) THEN
|
|
|
|
!========================================================
|
|
! 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
|
|
|
|
! Recompute EMIS_BL, SHIP, FRACTION_NOX, INT_OPE
|
|
|
|
! 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. )
|
|
|
|
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)
|
|
! These values of CSPEC need to be forward model values from
|
|
! before KPP but after PARTITION
|
|
CALL INTERPOLATE_LUT2( I, J,
|
|
& CSPEC_ORIG(JLOOP,IDO3), CSPEC_ORIG(JLOOP,IDNO),
|
|
& CSPEC_ORIG(JLOOP,IDNO2), AIRDENS(JLOOP),
|
|
& JO1D, JNO2,
|
|
& FRACTION_NOx, INT_OPE)
|
|
|
|
!-----------------
|
|
! Ship O3
|
|
!-----------------
|
|
|
|
EMIS_BL = SHIP * (1D0 - FRACTION_NOX) * INT_OPE
|
|
|
|
!----------------------------
|
|
! adjoint code begins here
|
|
!----------------------------
|
|
EMIS_BL_ADJ = 0d0
|
|
TOTO3_ADJ = 0d0
|
|
INT_OPE_ADJ = 0d0
|
|
FRACTION_NOX_ADJ = 0d0
|
|
SHIP_ADJ = 0d0
|
|
|
|
! 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
|
|
|
|
! 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)
|
|
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,IDEOX) = REMIS(JLOOP,IDEOX)
|
|
! + EMIS_BL
|
|
! * ( DELTPRES / TOTPRES )
|
|
! * AREA_CM2 / VOLUME(JLOOP)
|
|
! adj code:
|
|
EMIS_BL_ADJ = EMIS_BL_ADJ
|
|
& + REMIS_ADJ(JLOOP,IDEOX)
|
|
& * ( DELTPRES / TOTPRES )
|
|
& * AREA_CM2 / VOLUME(JLOOP)
|
|
ENDDO
|
|
|
|
! fwd code:
|
|
!IF (LDRYD) SHIPO3DEP(I,J) = 0d0
|
|
! adj code:
|
|
SHIPO3DEP_ADJ(I,J) = 0d0
|
|
|
|
|
|
ELSE
|
|
|
|
! No change in REMIS
|
|
|
|
! Recalculate TOTO3
|
|
|
|
! 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_ORIG(JLOOP,IDO3)
|
|
|
|
ENDDO
|
|
|
|
|
|
! fwd code:
|
|
!IF (LDRYD) SHIPO3DEP(I,J) = ABS( EMIS_BL / TOTO3 )
|
|
! adj code:
|
|
!$OMP CRITICAL
|
|
IF ( LDRYD .and. ( TOTO3 .ge. 1d0 ) ) THEN
|
|
|
|
IF ( EMIS_BL / TOTO3 > 0 ) THEN
|
|
EMIS_BL_ADJ = SHIPO3DEP_ADJ(I,J) / TOTO3
|
|
TOTO3_ADJ = - EMIS_BL * SHIPO3DEP_ADJ(I,J)
|
|
& / ( TOTO3**2 )
|
|
ELSE
|
|
EMIS_BL_ADJ = - SHIPO3DEP_ADJ(I,J) / TOTO3
|
|
TOTO3_ADJ = EMIS_BL * SHIPO3DEP_ADJ(I,J)
|
|
& / ( TOTO3**2 )
|
|
ENDIF
|
|
|
|
! ensure that TOTO3_ADJ isn't inf or NaN
|
|
!IF ( TOTO3 < 1d-150 ) TOTO3_ADJ = 0d0
|
|
|
|
SHIPO3DEP_ADJ(I,J) = 0d0
|
|
|
|
ELSEIF (LDRYD) THEN
|
|
|
|
EMIS_BL_ADJ = 0d0
|
|
TOTO3_ADJ = 0d0
|
|
SHIPO3DEP_ADJ(I,J) = 0d0
|
|
|
|
ENDIF
|
|
!$OMP END CRITICAL
|
|
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP == 0 ) CYCLE
|
|
|
|
! fwd:
|
|
!TOTO3 = TOTO3 + ( BXHEIGHT(I,J,L) *
|
|
! 1d2 ) * CSPEC(JLOOP,IDO3)
|
|
! adj:
|
|
CSPEC_ADJ(JLOOP,IDO3) = CSPEC_ADJ(JLOOP,IDO3)
|
|
& + TOTO3_ADJ
|
|
& * BXHEIGHT(I,J,L) * 1d2
|
|
|
|
ENDDO
|
|
|
|
! fwd:
|
|
!TOTO3 = 0d0
|
|
! adj:
|
|
TOTO3_ADJ = 0d0
|
|
|
|
ENDIF
|
|
|
|
! fwd code:
|
|
!EMIS_BL = SHIP * (1D0 - FRACTION_NOX) * INT_OPE
|
|
! adj code: (SHIP_ADJ not used yet, but go ahead and include it)
|
|
SHIP_ADJ = EMIS_BL_ADJ
|
|
& * (1D0 - FRACTION_NOX) * INT_OPE
|
|
INT_OPE_ADJ = EMIS_BL_ADJ
|
|
& * SHIP * (1D0 - FRACTION_NOX)
|
|
FRACTION_NOX_ADJ = - EMIS_BL_ADJ
|
|
& * SHIP * INT_OPE
|
|
EMIS_BL_ADJ = 0d0
|
|
|
|
!-----------------
|
|
! Ship HNO3
|
|
!-----------------
|
|
|
|
! 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)
|
|
|
|
|
|
! fwd:
|
|
!REMIS(JLOOP,IDEHNO3) = REMIS(JLOOP,IDEHNO3)
|
|
! + ( EMIS_BL * AREA_CM2 )
|
|
! / VOLUME(JLOOP)
|
|
! adj:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,IDEHNO3)
|
|
& * AREA_CM2 / VOLUME(JLOOP)
|
|
|
|
! fwd:
|
|
!EMIS_BL = SHIP * ( 1D0 - FRACTION_NOX ) *
|
|
! ( DELTPRES / TOTPRES )
|
|
! adj:
|
|
SHIP_ADJ = SHIP_ADJ + EMIS_BL_ADJ
|
|
& * ( 1D0 - FRACTION_NOX )
|
|
& * ( DELTPRES / TOTPRES )
|
|
FRACTION_NOX_ADJ = FRACTION_NOX_ADJ
|
|
& - SHIP * EMIS_BL_ADJ
|
|
& * ( DELTPRES / TOTPRES )
|
|
|
|
ENDDO
|
|
|
|
|
|
!-----------------
|
|
! 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)
|
|
|
|
|
|
! fwd:
|
|
!REMIS(JLOOP,IDENOX) = REMIS(JLOOP,IDENOX)
|
|
! + ( EMIS_BL * AREA_CM2 )
|
|
! / VOLUME(JLOOP)
|
|
! adj:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,IDENOX)
|
|
& * AREA_CM2 / VOLUME(JLOOP)
|
|
! fwd:
|
|
!EMIS_BL = ( SHIP * FRACTION_NOX )
|
|
! * ( DELTPRES / TOTPRES )
|
|
! adj:
|
|
SHIP_ADJ = SHIP_ADJ + EMIS_BL_ADJ
|
|
& * ( DELTPRES / TOTPRES ) * FRACTION_NOX
|
|
FRACTION_NOX_ADJ = FRACTION_NOX_ADJ + EMIS_BL_ADJ
|
|
& * ( DELTPRES / TOTPRES ) * SHIP
|
|
|
|
ENDDO
|
|
|
|
JLOOP = JLOP(I,J,1)
|
|
|
|
! fwd code:
|
|
!CALL INTERPOLATE_LUT2( I, J,
|
|
! CSPEC(JLOOP,IDO3), CSPEC(JLOOP,IDNO),
|
|
! CSPEC(JLOOP,IDNO2), AIRDENS(JLOOP),
|
|
! JO1D, JNO2,
|
|
! FRACTION_NOx, INT_OPE)
|
|
! adj code:
|
|
CALL INTERPOLATE_LUT2_ADJ( I, J,
|
|
& CSPEC_ORIG(JLOOP,IDO3), O3_ADJ,
|
|
& CSPEC_ORIG(JLOOP,IDNO), NO_ADJ,
|
|
& CSPEC_ORIG(JLOOP,IDNO2), NO2_ADJ, AIRDENS(JLOOP),
|
|
& JO1D, JNO2, FRACTION_NOX,
|
|
& FRACTION_NOX_ADJ, INT_OPE, INT_OPE_ADJ )
|
|
|
|
|
|
CSPEC_ADJ(JLOOP,IDO3) = CSPEC_ADJ(JLOOP,IDO3) + O3_ADJ
|
|
CSPEC_ADJ(JLOOP,IDNO) = CSPEC_ADJ(JLOOP,IDNO) + NO_ADJ
|
|
CSPEC_ADJ(JLOOP,IDNO2)= CSPEC_ADJ(JLOOP,IDNO2)+NO2_ADJ
|
|
|
|
ENDIF
|
|
|
|
!========================================================
|
|
! Adjoint of Aircraft and Lightning NOx [molec/cm3/s]
|
|
!========================================================
|
|
|
|
! 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)
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
|
|
!-----------------
|
|
! Aircraft NOx
|
|
!-----------------
|
|
IF ( IS_AC_NOx ) THEN
|
|
|
|
! fwd:
|
|
!REMIS(JLOOP,N) = REMIS(JLOOP,N) + EMIS_BL
|
|
! adj:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N)
|
|
|
|
! fwd:
|
|
!EMIS_BL = EMIS_AC_NOx(I,J,L) / COEF1
|
|
! adj:
|
|
IF ( IDADJ_ENOX_ac > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,IDADJ_ENOX_ac)
|
|
& = EMS_SF_ADJ(I,J,M,IDADJ_ENOX_ac)
|
|
& + EMIS_AC_NOx(I,J,L) / COEF1
|
|
& * EMIS_BL_ADJ
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
!-----------------
|
|
! Lightning NOx
|
|
!-----------------
|
|
IF ( IS_LI_NOx ) THEN
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,N) = REMIS(JLOOP,N) + EMIS_BL
|
|
! adj code:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N)
|
|
|
|
! fwd code:
|
|
!EMIS_BL = EMIS_LI_NOx(I,J,L) / COEF1
|
|
! adj code:
|
|
IF ( IDADJ_ENOX_li > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,IDADJ_ENOX_li)
|
|
& = EMS_SF_ADJ(I,J,M,IDADJ_ENOX_li)
|
|
& + EMIS_LI_NOx(I,J,L) / COEF1
|
|
& * EMIS_BL_ADJ
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
! fwd code:
|
|
!EMIS_BL = 0d0
|
|
! adj code:
|
|
EMIS_BL_ADJ = 0d0
|
|
|
|
ENDDO
|
|
|
|
|
|
!========================================================
|
|
! Soil Nox emissions [molec/cm3/s]
|
|
! Distribute emissions thru the entire boundary layer
|
|
!========================================================
|
|
DO L = 1, TOP
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,N) = REMIS(JLOOP,N) +
|
|
! ( EMIS_BL / VOLUME(JLOOP) )
|
|
! adj code:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N) / VOLUME(JLOOP)
|
|
|
|
|
|
! fwd code:
|
|
!EMIS_BL = ( GEMISNOX2(I,J) *
|
|
! VOLUME( JLOP(I,J,1) ) / COEF1 ) *
|
|
! ( DELTPRES / TOTPRES )
|
|
! adj code:
|
|
IF ( IDADJ_ENOX_so > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,IDADJ_ENOX_so)
|
|
& = EMS_SF_ADJ(I,J,M,IDADJ_ENOX_so)
|
|
& + GEMISNOX2(I,J)
|
|
& * VOLUME( JLOP(I,J,1) ) / COEF1
|
|
& * DELTPRES / TOTPRES
|
|
& * EMIS_BL_ADJ
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
! fwd code:
|
|
!EMIS_BL = 0d0
|
|
! adj code:
|
|
EMIS_BL_ADJ = 0d0
|
|
|
|
ENDDO
|
|
|
|
!========================================================
|
|
! Adjoint of Anthropogenic NOx emissions [molec/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)
|
|
|
|
IF ( JLOOP /= 0 ) THEN
|
|
|
|
! Thickness of level L [mb]
|
|
DELTPRES = GET_PEDGE(I,J,L) - GET_PEDGE(I,J,L+1)
|
|
|
|
! fwd code:
|
|
!REMIS(JLOOP,N) = EMIS_BL / VOLUME(JLOOP)
|
|
! adj code:
|
|
EMIS_BL_ADJ = REMIS_ADJ(JLOOP,N) / VOLUME(JLOOP)
|
|
|
|
! fwd code:
|
|
!EMIS_BL = ( NOXTOT / COEF1 ) *
|
|
! ( DELTPRES / TOTPRES )
|
|
! adj code:
|
|
IF ( NADJ_EANTHRO(NN) > 0 ) THEN
|
|
EMS_SF_ADJ(I,J,M,NADJ_EANTHRO(NN))
|
|
& = EMS_SF_ADJ(I,J,M,NADJ_EANTHRO(NN))
|
|
& + ( NOXTOT / COEF1 ) *
|
|
& ( DELTPRES / TOTPRES ) *
|
|
& EMIS_BL_ADJ
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! fwd code:
|
|
!EMIS_BL = 0d0
|
|
! adj code:
|
|
EMIS_BL_ADJ = 0d0
|
|
|
|
ENDDO
|
|
|
|
! fwd code:
|
|
!NOXTOT = 0d0
|
|
!DO L = 1, NOXEXTENT
|
|
! NOXTOT = NOXTOT + EMISRRN(I,J,L)
|
|
!ENDDO
|
|
! adj code: could use this to distinguish between surface and stack emissions
|
|
!DO L = NOXEXTENT, 1, -1
|
|
! EMISRRN_ADJ(I,J,L) = NOXTOT_ADJ
|
|
!ENDDO
|
|
!! Reset adjoint
|
|
!NOXTOT_ADJ = 0d0
|
|
|
|
ENDIF
|
|
|
|
ENDDO ! I
|
|
ENDDO ! J
|
|
|
|
! ! fwd code:
|
|
! !DO JLOOP = 1, NTTLOOP
|
|
! ! REMIS(JLOOP,N) = 0d0
|
|
! !ENDDO
|
|
! ! adj code: take out of N loop
|
|
! DO JLOOP = 1, NTTLOOP
|
|
! REMIS_ADJ(JLOOP,N) = 0d0
|
|
! ENDDO
|
|
|
|
ENDDO ! N
|
|
!$OMP END PARALLEL DO
|
|
|
|
REMIS_ADJ(:,:) = 0d0
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE SETEMIS_ADJ
|