MODULE CARBON_ADJ_MOD ! !****************************************************************************** ! Module CARBON_ADJ_MOD contains arrays and routines for performing an offline ! carbonaceous aerosol adjoint simulation. Original code taken from forward ! routines in CARBON_MOD and modified accordingly. (dkh, 03/01/05) ! ! Module Variables: ! ============================================================================ ! (1 ) BCCONV_ADJ (REAL*8) : Adjoint of BCCONV ! (2 ) OCCONV_ADJ (REAL*8) : Adjoint of OCCONV ! ! Module Routines: ! ============================================================================ ! (1 ) ADJ_CHEMCARBON : Driver program for adjoint carbon aerosol chemistry ! (2 ) ADJ_CHEM_BCPO : Chemistry routine for hydrophobic BC (aka EC) ! (3 ) ADJ_CHEM_BCPI : Chemistry routine for hydrophilic BC (aka EC) ! (4 ) ADJ_CHEM_OCPO : Chemistry routine for hydrophobic OC ! (5 ) ADJ_CHEM_OCPI : Chemistry routine for hydrophilic OC ! ! GEOS-CHEM modules referenced by carbon_mod.f ! ============================================================================ ! (1 ) bpch2_mod.f : Module w/ routines for binary punch file I/O ! (2 ) dao_mod.f : Module w/ arrays for DAO met fields ! (3 ) diag_mod.f : Module w/ GEOS-CHEM diagnostic arrays ! (4 ) directory_mod.f : Module w/ GEOS-CHEM data & met field dirs ! (5 ) drydep_mod.f : Module w/ routines for dry deposition ! (6 ) error_mod.f : Module w/ I/O error and NaN check routines ! (7 ) global_no3_mod.f : Module w/ routines to read 3-D NO3 field ! (8 ) global_oh_mod.f : Module w/ routines to read 3-D OH field ! (9 ) global_o3_mod.f : Module w/ routines to read 3-D O3 field ! (10) grid_mod.f : Module w/ horizontal grid information ! (11) logical_mod.f : Module w/ GEOS-CHEM logical switches ! (12) megan_mod.f : Module w/ routines to read MEGAN biogenic emiss ! (13) pbl_mix_mod.f : Module w/ routines for PBL height & mixing ! (14) pressure_mod.f : Module w/ routines to compute P(I,J,L) ! (15) time_mod.f : Module w/ routines for computing time & date ! (16) tracer_mod.f : Module w/ GEOS-CHEM tracer array STT etc. ! (17) tracerid_mod.f : Module w/ pointers to tracers & emissions ! (18) transfer_mod.f : Module w/ routines to cast & resize arrays ! ! NOTES: ! (1 ) See original forward module for all notes. ! (2 ) Change BCCONV and OCCONV to ADJ_BCCONV and ADJ_OCCONV. (dkh, 03/22/07) ! (3 ) Updated to GCv8 (dkh, 09/09/09) ! !****************************************************************************** ! IMPLICIT NONE !================================================================= ! MODULE PRIVATE DECLARATIONS -- keep certain internal variables ! and routines from being seen outside "carbon_mod.f" !================================================================= ! Declare everything PRIVATE ... PRIVATE ! ... except these routines PUBLIC :: CHEMCARBON_ADJ PUBLIC :: EMISSCARBON_ADJ PUBLIC :: CLEANUP_CARBON_ADJ !================================================================= ! MODULE VARIABLES !================================================================= ! Comment out module variables from forward routine that we don't use ! for the adjoint. (dkh, 09/09/09) ! ! Scalars ! LOGICAL :: USE_MONTHLY_BIOB = .TRUE. ! INTEGER :: DRYBCPI, DRYOCPI, DRYBCPO, DRYOCPO ! INTEGER :: DRYALPH, DRYLIMO, DRYALCO ! INTEGER :: DRYSOG1, DRYSOG2, DRYSOG3, DRYSOG4 ! INTEGER :: DRYSOA1, DRYSOA2, DRYSOA3, DRYSOA4 ! INTEGER :: I1_NA, J1_NA ! INTEGER :: I2_NA, J2_NA ! INTEGER :: DRYSOAG, DRYSOAM ! ! ! Parameters ! INTEGER, PARAMETER :: MHC = 6 ! INTEGER, PARAMETER :: NPROD = 3 ! REAL*8, PARAMETER :: SMALLNUM = 1d-20 ! ! ! Arrays ! REAL*8, ALLOCATABLE :: ANTH_BLKC(:,:,:) ! REAL*8, ALLOCATABLE :: ANTH_ORGC(:,:,:) ! REAL*8, ALLOCATABLE :: BIOB_BLKC(:,:,:) ! REAL*8, ALLOCATABLE :: BIOB_ORGC(:,:,:) ! REAL*8, ALLOCATABLE :: BIOF_BLKC(:,:,:) ! REAL*8, ALLOCATABLE :: BIOF_ORGC(:,:,:) ! REAL*8, ALLOCATABLE :: EF_BLKC(:,:) ! REAL*8, ALLOCATABLE :: EF_ORGC(:,:) ! REAL*8, ALLOCATABLE :: TERP_ORGC(:,:) ! REAL*8, ALLOCATABLE :: BCCONV(:,:,:) ! REAL*8, ALLOCATABLE :: OCCONV(:,:,:) ! REAL*8, ALLOCATABLE :: BIOG_ALPH(:,:) ! REAL*8, ALLOCATABLE :: BIOG_LIMO(:,:) ! REAL*8, ALLOCATABLE :: BIOG_ALCO(:,:) ! REAL*8, ALLOCATABLE :: BIOG_TERP(:,:) ! REAL*8, ALLOCATABLE :: BIOG_SESQ(:,:) ! REAL*8, ALLOCATABLE :: DIUR_ORVC(:,:) ! REAL*8, ALLOCATABLE :: GEIA_ORVC(:,:) ! REAL*8, ALLOCATABLE :: TCOSZ(:,:) ! REAL*8, ALLOCATABLE :: ORVC_SESQ(:,:,:) ! REAL*8, ALLOCATABLE :: ORVC_TERP(:,:,:) ! REAL*8, ALLOCATABLE :: GPROD(:,:,:,:,:) ! REAL*8, ALLOCATABLE :: APROD(:,:,:,:,:) ! ! Cloud fraction - for cloud droplet uptake of dicarbonyls ! ! (tmf, 12/07/07) ! REAL*8, ALLOCATABLE :: VCLDF(:,:,:) REAL*8, ALLOCATABLE :: BCCONV_ADJ(:,:,:) REAL*8, ALLOCATABLE :: OCCONV_ADJ(:,:,:) ! Days per month (based on 1998) INTEGER :: NDAYS(12) = (/ 31, 28, 31, 30, 31, 30, & 31, 31, 30, 31, 30, 31 /) !================================================================= ! MODULE ROUTINES -- follow below the "CONTAINS" statement !================================================================= CONTAINS !------------------------------------------------------------------------------ SUBROUTINE CHEMCARBON_ADJ ! !****************************************************************************** ! Subroutine CHEMCARBON is the interface between the GEOS-CHEM main ! program and the adjoint carbon aerosol chemistry routines that calculates ! dry deposition and chemical conversion between hydrophilic and ! hydrophobic. ! ! NOTES: ! (1 ) Based on CHEMCARBON from forward model. (rjp, bmy, 4/1/04, 9/14/06) ! The only differences are: ! i. Use STT_ADJ instead of STT ! ii. Call CHEM_xxxx_ADJ rather than CHEM_xxxx ! ! NOTES: ! (1 ) See forword module for all notes. ! (2 ) Updated to GCv8 (dkh, 09/09/09) !****************************************************************************** ! ! References to F90 modules USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ USE DRYDEP_MOD, ONLY : DEPNAME, NUMDEP USE ERROR_MOD, ONLY : DEBUG_MSG USE ERROR_MOD, ONLY : ERROR_STOP USE GLOBAL_OH_MOD, ONLY : GET_GLOBAL_OH USE GLOBAL_NO3_MOD, ONLY : GET_GLOBAL_NO3 USE GLOBAL_O3_MOD, ONLY : GET_GLOBAL_O3 USE LOGICAL_MOD, ONLY : LSOA, LEMIS, LPRT USE TIME_MOD, ONLY : GET_MONTH, ITS_A_NEW_MONTH USE TRACER_MOD, ONLY : STT, ITS_AN_AEROSOL_SIM USE TRACERID_MOD, ONLY : IDTBCPI, IDTBCPO, IDTOCPI USE TRACERID_MOD, ONLY : IDTOCPO, IDTSOG4, IDTSOA4 USE TRACERID_MOD, ONLY : IDTSOAG, IDTSOAM # include "CMN_SIZE" ! Size parameters ! Local variables LOGICAL, SAVE :: FIRSTCHEM = .TRUE. INTEGER :: N, THISMONTH !================================================================= ! CHEMCARBON_ADJ begins here! !================================================================= ! First-time initialization IF ( FIRSTCHEM ) THEN ! Initialize arrays (if not already done before) CALL INIT_CARBON_ADJ ! Don't need to repeat the rest of this (dkh, 09/09/09) ! ! Find drydep species in DEPSAV ! DO N = 1, NUMDEP ! SELECT CASE ( TRIM( DEPNAME(N) ) ) ! CASE ( 'BCPI' ) ! DRYBCPI = N ! CASE ( 'OCPI' ) ! DRYOCPI = N ! CASE ( 'BCPO' ) ! DRYBCPO = N ! CASE ( 'OCPO' ) ! DRYOCPO = N ! CASE ( 'ALPH' ) ! DRYALPH = N ! CASE ( 'LIMO' ) ! DRYLIMO = N ! CASE ( 'ALCO' ) ! DRYALCO = N ! CASE ( 'SOG1' ) ! DRYSOG1 = N ! CASE ( 'SOG2' ) ! DRYSOG2 = N ! CASE ( 'SOG3' ) ! DRYSOG3 = N ! CASE ( 'SOG4' ) ! DRYSOG4 = N ! CASE ( 'SOA1' ) ! DRYSOA1 = N ! CASE ( 'SOA2' ) ! DRYSOA2 = N ! CASE ( 'SOA3' ) ! DRYSOA3 = N ! CASE ( 'SOA4' ) ! DRYSOA4 = N ! CASE ( 'SOAG' ) ! DRYSOAG = N ! CASE ( 'SOAM' ) ! DRYSOAM = N ! CASE DEFAULT ! ! Nothing ! END SELECT ! ENDDO ! ! ! Zero SOG4 and SOA4 (SOA from ISOP in gas & aerosol form) ! ! for offline aerosol simulations. Eventually we should have ! ! archived isoprene oxidation fields available for offline ! ! simulations but for now we just set them to zero. ! ! (dkh, bmy, 6/1/06) ! IF ( ITS_AN_AEROSOL_SIM() ) THEN ! ! ! temp fix for aerosol w/ 20 tracers simulation (phs) ! IF ( IDTSOG4 .NE. 0 ) THEN ! STT(:,:,:,IDTSOG4) = 0d0 ! STT(:,:,:,IDTSOA4) = 0d0 ! ENDIF ! ENDIF ! Reset first-time flag FIRSTCHEM = .FALSE. ENDIF !================================================================= ! Do chemistry for carbon aerosol tracers !================================================================= ! Chemistry for hydrophilic OC IF ( IDTOCPI > 0 ) THEN CALL CHEM_OCPI_ADJ( STT_ADJ(:,:,:,IDTOCPI) ) IF ( LPRT ) & CALL DEBUG_MSG( '### CHEMCARBON_ADJ: a CHEM_OCPI_ADJ' ) ENDIF ! Chemistry for hydrophobic OC IF ( IDTOCPO > 0 ) THEN CALL CHEM_OCPO_ADJ( STT_ADJ(:,:,:,IDTOCPO) ) IF ( LPRT ) & CALL DEBUG_MSG( '### CHEMCARBON_ADJ: a CHEM_OCPO_ADJ' ) ENDIF ! Chemistry for hydrophilic BC IF ( IDTBCPI > 0 ) THEN CALL CHEM_BCPI_ADJ( STT_ADJ(:,:,:,IDTBCPI) ) IF ( LPRT ) & CALL DEBUG_MSG( '### CHEMCARBON_ADJ: a CHEM_BCPI_ADJ' ) ENDIF ! Chemistry for hydrophobic BC IF ( IDTBCPO > 0 ) THEN CALL CHEM_BCPO_ADJ( STT_ADJ(:,:,:,IDTBCPO) ) IF ( LPRT ) & CALL DEBUG_MSG( '### CHEMCARBON_ADJ: a CHEM_BCPO_ADJ' ) ENDIF !================================================================= ! Do chemistry for secondary organic aerosols !================================================================= IF ( LSOA ) THEN CALL ERROR_STOP('SOA not supported yet for adjoint', & 'carbon_adj_mod.f') ! ! Read offline OH, NO3, O3 fields from disk ! IF ( ITS_AN_AEROSOL_SIM() ) THEN ! ! ! Current month ! THISMONTH = GET_MONTH() ! ! IF ( ITS_A_NEW_MONTH() ) THEN ! CALL GET_GLOBAL_OH( THISMONTH ) ! CALL GET_GLOBAL_NO3( THISMONTH ) ! CALL GET_GLOBAL_O3( THISMONTH ) ! ENDIF ! ! ! Compute time scaling arrays for offline OH, NO3 ! ! but only if it hasn't been done in EMISSCARBON ! IF ( LSOA .and. ( .not. LEMIS ) ) THEN ! CALL OHNO3TIME ! IF ( LPRT ) CALL DEBUG_MSG( '### CHEMCARB: a OHNO3TIME' ) ! ENDIF ! ENDIF ! ! ! Compute SOA chemistry ! ! NOTE: This is SOA production from the reversible mechanism only ! ! (tmf, 12/07/07) ! CALL SOA_CHEMISTRY ! IF ( LPRT ) CALL DEBUG_MSG( '### CHEMCARBON: a SOA_CHEM' ) ! ! ! If SOAG and SOAM are declared, switch on ! ! SOA production from dicarbonyls (tmf, 12/07/07) ! IF ( IDTSOAG > 0 ) THEN ! ! ! Get grid box cloud fraction ! ! (tmf, 2/26/07) ! CALL GET_VCLDF ! ! ! Cloud uptake ! CALL SOAG_CLOUD ! IF ( LPRT ) ! & CALL DEBUG_MSG('### CHEMCARBON: a SOAG_CLOUD') ! ! ! Aqueous aerosol uptake ! CALL SOAG_LIGGIO_DIFF ! IF ( LPRT ) ! & CALL DEBUG_MSG('### CHEMCARBON: a SOAG_LIGGIO_DIFF') ! ! ENDIF ! ! IF ( IDTSOAM > 0 ) THEN ! ! ! Get grid box cloud fraction ! ! (tmf, 2/26/07) ! CALL GET_VCLDF ! ! ! Cloud uptake ! CALL SOAM_CLOUD ! IF ( LPRT ) ! & CALL DEBUG_MSG('### CHEMCARBON: a SOAM_CLOUD') ! ! ! Aqueous aerosol uptake ! CALL SOAM_LIGGIO_DIFF ! IF ( LPRT ) ! & CALL DEBUG_MSG( '### CHEMCARBON: a SOAM_LIGGIO_DIFF' ) ! ! ! ! ENDIF ENDIF ! Return to calling program END SUBROUTINE CHEMCARBON_ADJ !----------------------------------------------------------------------------- SUBROUTINE CHEM_BCPO_ADJ( TC_ADJ ) ! !****************************************************************************** ! Subroutine ADJ_CHEM_BCPO converts hydrophobic BC to hydrophilic BC and ! calculates the dry deposition of hydrophobic BC adjoints. (dkh, 03/02/05) ! ! Based on forward model by (rjp, bmy, 4/1/04,10/25/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) TC (REAL*8) : Array of hydrophobic BC tracer ! ! NOTES: ! (1 ) See forward model. ! (2 ) Based on CHEM_OPCI from forward model. The only differences are: ! i. Check if ABS( CNEW ) < SMALLNUM ! ii. Include STT_ADJ ! iii. Take out ND44 stuff ! (3 ) Updated to include adjoint of OCPO --> OCPI. Comment out diagnostics ! from forward model. (dkh, 03/22/07) ! (4 ) Updated to GCv8 (dkh, 09/09/09) !****************************************************************************** ! ! References to F90 modules USE CARBON_MOD, ONLY : DRYBCPO USE DAO_MOD, ONLY : AD !USE DIAG_MOD, ONLY : AD44, AD07_BC USE DRYDEP_MOD, ONLY : DEPSAV USE GRID_MOD, ONLY : GET_AREA_CM2 USE PBL_MIX_MOD, ONLY : GET_FRAC_UNDER_PBLTOP USE TRACER_MOD, ONLY : XNUMOL USE TRACERID_MOD, ONLY : IDTBCPO USE TIME_MOD, ONLY : GET_TS_CHEM # include "CMN_SIZE" ! Size parameters !# include "CMN_DIAG" ! ND44, ND07, LD07 ! Arguments REAL*8, INTENT(INOUT) :: TC_ADJ(IIPAR,JJPAR,LLPAR) ! Local variables INTEGER :: I, J, L !REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR) REAL*8 :: DTCHEM, FLUX, KBC, FREQ, BL_FRAC REAL*8 :: TC0_ADJ, CNEW_ADJ, RKT, AREA_CM2 REAL*8, PARAMETER :: BC_LIFE = 1.15D0 !================================================================= ! CHEM_BCPO_ADJ begins here! !================================================================= ! Return if BCPO isn't defined IF ( IDTBCPO == 0 .or. DRYBCPO == 0 ) RETURN ! Initialize KBC = 1.D0 / ( 86400d0 * BC_LIFE ) DTCHEM = GET_TS_CHEM() * 60d0 !================================================================= ! For tracers with dry deposition, the loss rate of dry dep is ! combined in chem loss term. ! ! Conversion from hydrophobic to hydrophilic: ! e-folding time 1.15 days ! ---------------------------------------- ! Use an e-folding time of 1.15 days or a convertion rate ! of 1.0e-5 /sec. ! ! Hydrophobic(2) --> Hydrophilic(1) , k = 1.0e-5 ! Both aerosols are dry-deposited, kd = Dvel/DELZ (sec-1) !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, TC0_ADJ, FREQ, BL_FRAC, RKT, CNEW_ADJ ) !$OMP+PRIVATE( AREA_CM2, FLUX ) !$OMP+SCHEDULE( DYNAMIC ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! Store new concentration back into tracer array CNEW_ADJ = TC_ADJ(I,J,L) ! Zero drydep freq FREQ = 0d0 ! Fraction of box under the PBL top [unitless] BL_FRAC = GET_FRAC_UNDER_PBLTOP( I, J, L ) ! Only apply drydep to boxes w/in the PBL IF ( BL_FRAC > 0d0 ) THEN ! BC drydep frequency [1/s] -- PBLFRAC accounts for the fraction ! of each grid box (I,J,L) that is located beneath the PBL top FREQ = DEPSAV(I,J,DRYBCPO) * BL_FRAC ENDIF ! Prevent underflow condition !IF ( ABS( CNEW ) < SMALLNUM ) CNEW = 0d0 ! Amount of BCPO converted to BCPI [kg/timestep] ! fwd code: !BCCONV(I,J,L) = ( TC0 - CNEW ) * KBC / ( KBC + FREQ ) TC0_ADJ = BCCONV_ADJ(I,J,L) * KBC / ( KBC + FREQ ) ! CNEW_ADJ is calculated as: ! CNEW_ADJ = CNEW_ADJ - BCCONV_ADJ(I,J,L) * KBC / ( KBC + FREQ ) ! same thing, but faster: CNEW_ADJ = CNEW_ADJ - TC0_ADJ ! Amount of BCPO left after chemistry and drydep [kg] RKT = ( KBC + FREQ ) * DTCHEM ! fwd code: !CNEW = TC0 * EXP( -RKT ) TC0_ADJ = TC0_ADJ + CNEW_ADJ * EXP( -RKT ) ! !============================================================== ! ! ND44 diagnostic: drydep loss [atoms C/cm2/s] ! !============================================================== ! IF ( ND44 > 0 .AND. FREQ > 0d0 ) THEN ! ! ! Surface area [cm2] ! AREA_CM2 = GET_AREA_CM2( J ) ! ! ! Convert drydep loss from [kg/timestep] to [atoms C/cm2/s] ! ! XNUMOL is the ratio [molec tracer/kg tracer] ! FLUX = TC0 - CNEW - BCCONV(I,J,L) ! FLUX = FLUX * XNUMOL(IDTBCPO) / ( DTCHEM * AREA_CM2 ) ! ! ! Store in ND44_TMP as a placeholder ! ND44_TMP(I,J,L) = ND44_TMP(I,J,L) + FLUX ! ENDIF ! ! !============================================================== ! ! ND07 diagnostic: H-philic BC from H_phobic BC [kg/timestep] ! !============================================================== ! IF ( ND07 > 0 .and. L <= LD07 ) THEN ! AD07_BC(I,J,L) = AD07_BC(I,J,L) + BCCONV(I,J,L) ! ENDIF ! Initial BC mass [kg] ! fwd code: !TC0 = TC(I,J,L) TC_ADJ(I,J,L) = TC0_ADJ ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! !=============================================================== ! ! ND44: Sum drydep fluxes by level into the AD44 array in ! ! order to ensure that we get the same results w/ sp or mp ! !=============================================================== ! IF ( ND44 > 0 ) THEN !!$OMP PARALLEL DO !!$OMP+DEFAULT( SHARED ) !!$OMP+PRIVATE( I, J, L ) ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! DO L = 1, LLPAR ! AD44(I,J,DRYBCPO,1) = AD44(I,J,DRYBCPO,1) + ND44_TMP(I,J,L) ! ENDDO ! ENDDO ! ENDDO !!$OMP END PARALLEL DO ! ENDIF !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! fwd code: !BCCONV(I,J,L) = 0d0 BCCONV_ADJ(I,J,L) = 0d0 ! Initialize for drydep diagnostic ! IF ( ND44 > 0 ) ND44_TMP(I,J,L) = 0d0 ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE CHEM_BCPO_ADJ !------------------------------------------------------------------------------ SUBROUTINE CHEM_BCPI_ADJ( TC_ADJ ) ! !****************************************************************************** ! Subroutine CHEM_BCPI_ADJ calculates dry deposition of hydrophilic BC adjoint ! (dkh, 03/02/05) ! ! Based on forward code by (rjp, bmy, 4/1/04, 10/25/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) TC (REAL*8) : Array of hydrophilic BC adjoint ! ! NOTES: ! (1 ) Based on CHEM_BCPI from forward model. The only differences are: ! i. Check if ABS( CNEW ) < SMALLNUM ! ii. Return if IDADJBCPI is 0 ! iii. Include ADJ_STT ! (2 ) Updated to include adjoint of BCPO --> BCPI. Comment out diagnostics ! from forward model. (dkh, 03/22/07) ! (3 ) Updated to GCv8 (dkh, 09/09/09) !****************************************************************************** ! ! References to F90 modules USE CARBON_MOD, ONLY : DRYBCPI USE DAO_MOD, ONLY : AD USE DIAG_MOD, ONLY : AD44 USE DRYDEP_MOD, ONLY : DEPSAV USE PBL_MIX_MOD, ONLY : GET_FRAC_UNDER_PBLTOP USE GRID_MOD, ONLY : GET_AREA_CM2 USE TRACER_MOD, ONLY : XNUMOL USE TRACERID_MOD, ONLY : IDTBCPI USE TIME_MOD, ONLY : GET_TS_CHEM # include "CMN_SIZE" ! Size parameters !# include "CMN_DIAG" ! ND44 ! Arguments REAL*8, INTENT(INOUT) :: TC_ADJ(IIPAR,JJPAR,LLPAR) ! Local variables INTEGER :: I, J, L REAL*8 :: DTCHEM, FLUX, BL_FRAC, AREA_CM2, FREQ REAL*8 :: TC0_ADJ, CNEW_ADJ, CCV_ADJ ! REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR) !================================================================= ! CHEM_BCPI_ADJ begins here! !================================================================= ! Return if BCPI isn't defined IF ( IDTBCPI == 0 .or. DRYBCPI == 0 ) RETURN ! Chemistry timestep [s] DTCHEM = GET_TS_CHEM() * 60d0 !================================================================= ! Zero out the BCCONV_ADJ array for the next iteration !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! fwd code: !BCCONV(I,J,L) = 0.d0 BCCONV_ADJ(I,J,L) = 0.d0 ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! ! Initialize for ND44 diagnostic ! IF ( ND44 > 0 ) THEN !!$OMP PARALLEL DO !!$OMP+DEFAULT( SHARED ) !!$OMP+PRIVATE( I, J, L ) ! DO L = 1, LLPAR ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! ND44_TMP(I,J,L) = 0d0 ! ENDDO ! ENDDO ! ENDDO !!$OMP END PARALLEL DO ! ENDIF !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, TC0_ADJ, CCV_ADJ, FREQ, BL_FRAC ) !$OMP+PRIVATE( CNEW_ADJ, AREA_CM2, FLUX ) !$OMP+SCHEDULE( DYNAMIC ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! Save new concentration of H-philic IC in tracer array CNEW_ADJ = TC_ADJ(I,J,L) ! Fraction of grid box under the PBL top [unitless] BL_FRAC = GET_FRAC_UNDER_PBLTOP( I, J, L ) ! Only apply drydep to boxes w/in the PBL IF ( BL_FRAC > 0d0 ) THEN ! Drydep frequency FREQ = DEPSAV(I,J,DRYBCPI) * BL_FRAC !=========================================================== ! Note, This is an analytical solution of first order ! partial differential equations (w/ 2 solutions): ! ! #1) CNEW = Cphi * exp(-RKT) + Cconv/RKT * (1.-exp(-RKT)) ! #2) CNEW = ( Cphi + Cconv ) * exp(-RKT) !=========================================================== ! note -- this was already commented out of fwd code ! Comment out for now !CNEW = TC0 * EXP( -FREQ * DTCHEM ) ! + CCV / FREQ * ( 1.D0 - EXP( -FREQ * DTCHEM ) ) ! Amount of BCPI left after drydep [kg] ! fwd code: !CNEW = ( TC0 + CCV ) * EXP( -FREQ * DTCHEM ) TC0_ADJ = CNEW_ADJ * EXP( -FREQ * DTCHEM ) ! adjoint for CCV_ADJ is: ! CCV_ADJ = CNEW_ADJ * EXP( -FREQ * DTCHEM ) ! or, same but faster: CCV_ADJ = TC0_ADJ ! !=========================================================== ! ! ND44 diagnostic: drydep flux [atoms C/cm2/s] ! !=========================================================== ! IF ( ND44 > 0 .and. FREQ > 0d0 ) THEN ! ! ! Surface area [cm2] ! AREA_CM2 = GET_AREA_CM2( J ) ! ! ! Convert drydep loss from [kg/timestep] to [molec/cm2/s] ! FLUX = ( TC0 + CCV - CNEW ) ! FLUX = FLUX * XNUMOL(IDTBCPI) / ( AREA_CM2 * DTCHEM ) ! ! ! Store in ND44_TMP as a placeholder ! ND44_TMP(I,J,L) = ND44_TMP(I,J,L) + FLUX ! ENDIF ELSE ! Otherwise, omit the exponential to save on clock cycles ! fwd code: !CNEW = TC0 + CCV TC0_ADJ = CNEW_ADJ CCV_ADJ = CNEW_ADJ ENDIF ! Prevent underflow condition !IF ( ABS( CNEW ) < SMALLNUM ) CNEW = 0d0 ! H-philic BC that used to be H-phobic BC [kg] ! fwd code: !CCV = BCCONV(I,J,L) BCCONV_ADJ(I,J,L) = CCV_ADJ ! Initial H-philic BC [kg] ! fwd code: !TC0 = TC(I,J,L) TC_ADJ(I,J,L) = TC0_ADJ ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! !================================================================= ! ! ND44: Sum drydep fluxes by level into the AD44 array in ! ! order to ensure that we get the same results w/ sp or mp ! !================================================================= ! IF ( ND44 > 0 ) THEN !!$OMP PARALLEL DO !!$OMP+DEFAULT( SHARED ) !!$OMP+PRIVATE( I, J, L ) ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! DO L = 1, LLPAR ! AD44(I,J,DRYBCPI,1) = AD44(I,J,DRYBCPI,1) + ND44_TMP(I,J,L) ! ENDDO ! ENDDO ! ENDDO !!$OMP END PARALLEL DO ! ENDIF ! Return to calling program END SUBROUTINE CHEM_BCPI_ADJ !------------------------------------------------------------------------------ SUBROUTINE CHEM_OCPI_ADJ( TC_ADJ ) ! !****************************************************************************** ! Subroutine CHEM_OCPI_ADJ calculates dry deposition of hydrophilic OC adjoint ! (dkh, 03/02/05) ! ! Based on forward code by (rjp, bmy, 4/1/04, 10/25/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) TC (REAL*8) : Array of hydrophilic BC tracer ! ! NOTES: ! (1 ) Based on CHEM_OPCI from forward model. The only differences are: ! i. Check if ABS( CNEW ) < SMALLNUM ! ii. Return if IDADJOPCI is 0 ! iii. Include ADJ_STT ! (2 ) Updated to include adjoint of OCPO --> OCPI. Comment out diagnostics ! from forward model. (dkh, 03/22/07) ! (4 ) Updated to GCv8 (dkh, 09/09/09) ! (5 ) BUG FIX: now declare BL_FRAC thread private (dkh, 07/30/10) !****************************************************************************** ! ! References to F90 modules USE CARBON_MOD, ONLY : DRYOCPI USE DAO_MOD, ONLY : AD USE DIAG_MOD, ONLY : AD44 USE DRYDEP_MOD, ONLY : DEPSAV USE GRID_MOD, ONLY : GET_AREA_CM2 USE PBL_MIX_MOD, ONLY : GET_FRAC_UNDER_PBLTOP USE TRACER_MOD, ONLY : XNUMOL USE TRACERID_MOD, ONLY : IDTOCPI USE TIME_MOD, ONLY : GET_TS_CHEM # include "CMN_SIZE" ! Size parameters !# include "CMN_DIAG" ! ND44 ! Arguments REAL*8, INTENT(INOUT) :: TC_ADJ(IIPAR,JJPAR,LLPAR) ! Local variable INTEGER :: I, J, L REAL*8 :: DTCHEM, FLUX, BL_FRAC, AREA_CM2 REAL*8 :: TC0_ADJ, CNEW_ADJ, CCV_ADJ, FREQ ! REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR) !================================================================= ! CHEM_OCPI_ADJ begins here! !================================================================= IF ( IDTOCPI == 0 .or. DRYOCPI == 0 ) RETURN ! Chemistry timestep [s] DTCHEM = GET_TS_CHEM() * 60d0 ! ! Initialize for drydep diagnostic ! IF ( ND44 > 0 ) THEN !!$OMP PARALLEL DO !!$OMP+DEFAULT( SHARED ) !!$OMP+PRIVATE( I, J, L ) ! DO L = 1, LLPAR ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! ND44_TMP(I,J,L) = 0d0 ! ENDDO ! ENDDO ! ENDDO !!$OMP END PARALLEL DO ! ENDIF !================================================================= ! Zero OCCONV_ADJ array for next timestep !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! fwd code: !OCCONV(I,J,L) = 0d0 OCCONV_ADJ(I,J,L) = 0d0 ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! BUG FIX: BL_FRAC needs to be thread private (dkh, 07/30/10) !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, TC0_ADJ, CCV_ADJ, FREQ, CNEW_ADJ ) !$OMP+PRIVATE( AREA_CM2, FLUX ) !$OMP+PRIVATE( BL_FRAC ) !$OMP+SCHEDULE( DYNAMIC ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! Store modified concentration back in tracer array [kg] ! fwd code: !TC(I,J,L) = CNEW CNEW_ADJ = TC_ADJ(I,J,L) ! dkh -- don't take adjoint of this. It would require ! recalculation of fwd CNEW -- probably not worth while. ! Prevent underflow condition !IF ( ABS( CNEW ) < SMALLNUM ) CNEW = 0d0 ! Fraction of grid box under the PBL top [unitless] BL_FRAC = GET_FRAC_UNDER_PBLTOP( I, J, L ) ! Only apply drydep to boxes w/in the PBL IF ( BL_FRAC > 0d0 ) THEN ! Recalculate drydep frequency [1/s] FREQ = DEPSAV(I,J,DRYOCPI) * BL_FRAC !=========================================================== ! Note, This is an analytical solution of first order ! partial differential equations (w/ 2 solutions): ! ! #1) CNEW = Cphi * exp(-RKT) + Cconv/RKT * (1.-exp(-RKT)) ! #2) CNEW = ( Cphi + Cconv ) * exp(-RKT) !=========================================================== ! dkh -- this was already commented out of fwd code ! CNEW = TC0 * EXP( -FREQ * DTCHEM ) ! + CCV / FREQ * ( 1.D0 - EXP( -FREQ * DTCHEM ) ) ! Amount of BCPI left after drydep [kg]D ! fwd code: !CNEW = ( TC0 + CCV ) * EXP( -FREQ * DTCHEM ) TC0_ADJ = CNEW_ADJ * EXP( -FREQ * DTCHEM ) ! adjoint code for CCV is: ! CCV_ADJ = CNEW_ADJ * EXP( -FREQ * DTCHEM ) ! same thing, except faster: CCV_ADJ = TC0_ADJ ! !=========================================================== ! ! ND44 diagnostic: drydep loss [atoms C/cm2/s] ! !=========================================================== ! IF ( ND44 > 0 ) THEN ! ! ! Surface area [cm2] ! AREA_CM2 = GET_AREA_CM2( J ) ! ! ! Convert drydep loss from [kg/timestep] to [atoms C/cm2/s] ! FLUX = ( TC0 + CCV - CNEW ) ! FLUX = FLUX * XNUMOL(IDTOCPI) / ( AREA_CM2 * DTCHEM ) ! ! ! Store in ND44_TMP as a placeholder ! ND44_TMP(I,J,L) = ND44_TMP(I,J,L) + FLUX ! ENDIF ELSE ! Otherwise, avoid doing the exponential ! to preserve precision and clock cycles ! fwd code: !CNEW = TC0 + CCV TC0_ADJ = CNEW_ADJ CCV_ADJ = CNEW_ADJ ENDIF ! Initial H-philic OC [kg] ! fwd code: !TC0 = TC(I,J,L) TC_ADJ(I,J,L) = TC0_ADJ ! H-philic OC that used to be H-phobic OC [kg] ! fwd code: !CCV = OCCONV(I,J,L) OCCONV_ADJ(I,J,L) = CCV_ADJ ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! !================================================================= ! ! ND44: Sum drydep fluxes by level into the AD44 array in ! ! order to ensure that we get the same results w/ sp or mp ! !================================================================= ! IF ( ND44 > 0 ) THEN !!$OMP PARALLEL DO !!$OMP+DEFAULT( SHARED ) !!$OMP+PRIVATE( I, J, L ) ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! DO L = 1, LLPAR ! AD44(I,J,DRYOCPI,1) = AD44(I,J,DRYOCPI,1) + ND44_TMP(I,J,L) ! ENDDO ! ENDDO ! ENDDO !!$OMP END PARALLEL DO ! ENDIF ! Return to calling program END SUBROUTINE CHEM_OCPI_ADJ !------------------------------------------------------------------------------ SUBROUTINE CHEM_OCPO_ADJ( TC_ADJ ) ! !****************************************************************************** ! Subroutine CHEM_OCPO_ADJ converts adjoint of hydrophobic OC to hydrophilic OC and ! calculates the dry deposition of hydrophobic OC. (dkh, 03/02/05) ! ! Based on forward model by (rjp, bmy, 4/1/04, 10/25/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) TC (REAL*8) : Array of hydrophobic OC tracer [kg] ! ! NOTES: ! (1 ) Based on CHEM_OCPO from forward model. The only differences are: ! i. Check if ABS( CNEW ) < SMALLNUM ! ii. Return if IDADJOCPO is 0 ! iii. Include ADJ_STT ! (2 ) Updated to include adjoint of OCPO --> OCPI. Comment out diagnostics ! from forward model. (dkh, 03/22/07) ! (3 ) Updated to GCv8 (dkh, 09/09/09) !****************************************************************************** ! ! References to F90 modules USE CARBON_MOD, ONLY : DRYOCPO USE DAO_MOD, ONLY : AD USE DIAG_MOD, ONLY : AD44, AD07_OC USE DRYDEP_MOD, ONLY : DEPSAV USE GRID_MOD, ONLY : GET_AREA_CM2 USE PBL_MIX_MOD, ONLY : GET_FRAC_UNDER_PBLTOP USE TRACER_MOD, ONLY : XNUMOL USE TRACERID_MOD, ONLY : IDTOCPO USE TIME_MOD, ONLY : GET_TS_CHEM # include "CMN_SIZE" ! Size parameters !# include "CMN_DIAG" ! ND44, ND07, LD07 ! Arguments REAL*8, INTENT(INOUT) :: TC_ADJ(IIPAR,JJPAR,LLPAR) ! Local variable INTEGER :: I, J, L ! REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR) REAL*8 :: DTCHEM, FLUX, KOC, BL_FRAC REAL*8 :: TC0_ADJ, FREQ, CNEW_ADJ, RKT, AREA_CM2 REAL*8, PARAMETER :: OC_LIFE = 1.15D0 !================================================================= ! CHEM_OCPO_ADJ begins here! !================================================================= ! Return if OCPO isn't defined IF ( IDTOCPO == 0 .or. DRYOCPO == 0 ) RETURN ! Initialize KOC = 1.D0 / ( 86400d0 * OC_LIFE ) DTCHEM = GET_TS_CHEM() * 60d0 !================================================================= ! For tracers with dry deposition, the loss rate of dry dep is ! combined in chem loss term. ! ! Conversion from hydrophobic to hydrophilic: ! e-folding time 1.15 days ! ---------------------------------------- ! Use an e-folding time of 1.15 days or a convertion rate ! of 1.0e-5 /sec. ! Hydrophobic --> Hydrophilic, k = 1.0e-5 ! Aerosols are dry-deposited, kd = DEPSAV (sec-1) !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, TC0_ADJ, FREQ, BL_FRAC, RKT ) !$OMP+PRIVATE( CNEW_ADJ, AREA_CM2, FLUX ) !$OMP+SCHEDULE( DYNAMIC ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! Store modified OC concentration back in tracer array ! fwd code: !TC(I,J,L) = CNEW CNEW_ADJ = TC_ADJ(I,J,L) ! Zero drydep freq FREQ = 0d0 ! Fraction of box under the PBL top [unitless] BL_FRAC = GET_FRAC_UNDER_PBLTOP( I, J, L ) ! Only apply drydep to boxes w/in the PBL IF ( BL_FRAC > 0d0 ) THEN ! OC drydep frequency [1/s] -- PBLFRAC accounts for the fraction ! of each grid box (I,J,L) that is located beneath the PBL top FREQ = DEPSAV(I,J,DRYOCPO) * BL_FRAC ENDIF ! Amount of OCPO converted to OCPI [kg/timestep] ! fwd code: !OCCONV(I,J,L) = ( TC0 - CNEW ) * KOC / ( KOC + FREQ ) TC0_ADJ = OCCONV_ADJ(I,J,L) * KOC / ( KOC + FREQ ) ! adjoint code is: ! CNEW_ADJ = CNEW_ADJ - OCCONV_ADJ(I,J,L) * KOC / ( KOC + FREQ ) ! same thing, except faster: CNEW_ADJ = CNEW_ADJ - TC0_ADJ ! Amount of OCPO left after chemistry and drydep [kg] RKT = ( KOC + FREQ ) * DTCHEM ! fwd code: !CNEW = TC0 * EXP( -RKT ) TC0_ADJ = TC0_ADJ + CNEW_ADJ * EXP( -RKT ) ! dkh -- don't take adjoint of this ! Prevent underflow condition !IF ( ABS( CNEW ) < SMALLNUM ) CNEW = 0d0 ! !============================================================== ! ! ND44 diagnostic: drydep loss [atoms C/cm2/s] ! !============================================================== ! IF ( ND44 > 0 .AND. FREQ > 0d0 ) THEN ! ! ! Surface area [cm2] ! AREA_CM2 = GET_AREA_CM2( J ) ! ! ! Convert drydep loss from [kg/timestep] to [atoms C/cm2/s] ! ! XNUMOL is the ratio [molec tracer/kg tracer] ! FLUX = TC0 - CNEW - OCCONV(I,J,L) ! FLUX = FLUX * XNUMOL(IDTOCPO) / ( DTCHEM * AREA_CM2 ) ! ! ! Store in ND44_TMP as a placeholder ! ND44_TMP(I,J,L) = ND44_TMP(I,J,L) + FLUX ! ENDIF ! ! !============================================================== ! ! ND07 diagnostic: H-Philic OC from H-phobic [kg/timestep] ! !============================================================== ! IF ( ND07 > 0 .and. L <= LD07 ) THEN ! AD07_OC(I,J,L) = AD07_OC(I,J,L) + OCCONV(I,J,L) ! ENDIF ! Initial OC [kg] ! fwd code: !TC0 = TC(I,J,L) TC_ADJ(I,J,L) = TC0_ADJ ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! !================================================================= ! ! ND44: Sum drydep fluxes by level into the AD44 array in ! ! order to ensure that we get the same results w/ sp or mp ! !================================================================= ! IF ( ND44 > 0 ) THEN !!$OMP PARALLEL DO !!$OMP+DEFAULT( SHARED ) !!$OMP+PRIVATE( I, J, L ) ! DO J = 1, JJPAR ! DO I = 1, IIPAR ! DO L = 1, LLPAR ! AD44(I,J,DRYOCPO,1) = AD44(I,J,DRYOCPO,1) + ND44_TMP(I,J,L) ! ENDDO ! ENDDO ! ENDDO !!$OMP END PARALLEL DO ! ENDIF !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L ) DO L = 1, LLPAR DO J = 1, JJPAR DO I = 1, IIPAR ! fwd code: !OCCONV(I,J,L) = 0d0 OCCONV_ADJ(I,J,L) = 0d0 ! ! Initialize for drydep diagnostic ! IF ( ND44 > 0 ) ND44_TMP(I,J,L) = 0d0 ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE CHEM_OCPO_ADJ !------------------------------------------------------------------------------ SUBROUTINE EMISSCARBON_ADJ ! !****************************************************************************** ! Subroutine EMISSCARBON_ADJ is the adjoint of EMISSCARBON. (dkh, 04/26/06) ! It is based on the forward model subroutine EMISSCARBON which is the interface ! between the GEOS-CHEM modeland the CARBONACEOUS AEROSOL emissions ! (rjp, bmy, 1/24/02, 9/25/06) ! ! NOTES: ! (1 ) Updated to GCv8 (dkh, 11/10/09) ! (2 ) Add LEMS_ABS option (dkh, 02/17/11) !****************************************************************************** ! ! References to F90 modules USE DIAG_MOD, ONLY : AD07 USE DAO_MOD, ONLY : PBL USE ERROR_MOD, ONLY : DEBUG_MSG USE ERROR_MOD, ONLY : ERROR_STOP USE LOGICAL_MOD, ONLY : LSOA, LPRT USE TIME_MOD, ONLY : GET_MONTH, ITS_A_NEW_MONTH USE TRACER_MOD, ONLY : STT USE GFED2_BIOMASS_MOD, ONLY : GFED2_IS_NEW !USE TRACERID_MOD USE ADJ_ARRAYS_MOD, ONLY : EMS_SF_ADJ USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EBCPI_an, IDADJ_EBCPO_an USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EOCPI_an, IDADJ_EOCPO_an USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EBCPI_bb, IDADJ_EBCPO_bb USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EOCPI_bb, IDADJ_EOCPO_bb USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EBCPI_bf, IDADJ_EBCPO_bf USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EOCPI_bf, IDADJ_EOCPO_bf USE ADJ_ARRAYS_MOD, ONLY : EMS_ADJ USE CARBON_MOD, ONLY : ANTH_ORGC, ANTH_BLKC USE CARBON_MOD, ONLY : BIOB_ORGC, BIOB_BLKC USE CARBON_MOD, ONLY : BIOF_ORGC, BIOF_BLKC USE CARBON_MOD, ONLY : BIOMASS_CARB_GEOS !lzhang USE LOGICAL_ADJ_MOD, ONLY : LEMS_ABS # include "CMN_SIZE" ! Size parameters # include "CMN_DIAG" ! ND07 ! Local variables LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: I, J, MONTH, N REAL*8 :: BCSRC_ADJ(IIPAR,JJPAR,2) REAL*8 :: OCSRC_ADJ(IIPAR,JJPAR,2) !================================================================= ! EMISSCARBON_ADJ begins here! !================================================================= !lzhang IF ( GFED2_IS_NEW() .or. ITS_A_NEW_MONTH() ) THEN CALL BIOMASS_CARB_GEOS IF ( LPRT ) CALL DEBUG_MSG('### EMISSCARB_ADJ: a BB_CRB_GEOS') ENDIF ! fwd code: !CALL EMITHIGH( BCSRC, OCSRC ) ! adj code: CALL EMITHIGH_ADJ( BCSRC_ADJ, OCSRC_ADJ ) IF ( LPRT ) & CALL DEBUG_MSG( '### EMISCARB_ADJ: after EMITHIGH_ADJ' ) !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J ) DO J = 1, JJPAR DO I = 1, IIPAR ! fwd code: ! ! Total HYDROPHILIC BC source [kg] ! BCSRC(I,J,1)= ANTH_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_an) ! + BIOF_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_bf) ! + BIOB_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_bb) ! adj code: EMS_SF_ADJ(I,J,1,IDADJ_EBCPI_an) & = EMS_SF_ADJ(I,J,1,IDADJ_EBCPI_an) & + ANTH_BLKC(I,J,1) * BCSRC_ADJ(I,J,1) EMS_SF_ADJ(I,J,1,IDADJ_EBCPI_bf) & = EMS_SF_ADJ(I,J,1,IDADJ_EBCPI_bf) & + BIOF_BLKC(I,J,1) * BCSRC_ADJ(I,J,1) EMS_SF_ADJ(I,J,1,IDADJ_EBCPI_bb) & = EMS_SF_ADJ(I,J,1,IDADJ_EBCPI_bb) & + BIOB_BLKC(I,J,1) * BCSRC_ADJ(I,J,1) ! fwd code: ! ! Total HYDROPHOBIC BC source [kg] ! BCSRC(I,J,2)= ANTH_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPI_an) ! + BIOF_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_bf) ! + BIOB_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_bb) ! adj code: EMS_SF_ADJ(I,J,1,IDADJ_EBCPO_an) & = EMS_SF_ADJ(I,J,1,IDADJ_EBCPO_an) & + ANTH_BLKC(I,J,2) * BCSRC_ADJ(I,J,2) EMS_SF_ADJ(I,J,1,IDADJ_EBCPO_bf) & = EMS_SF_ADJ(I,J,1,IDADJ_EBCPO_bf) & + BIOF_BLKC(I,J,2) * BCSRC_ADJ(I,J,2) EMS_SF_ADJ(I,J,1,IDADJ_EBCPO_bb) & = EMS_SF_ADJ(I,J,1,IDADJ_EBCPO_bb) & + BIOB_BLKC(I,J,2) * BCSRC_ADJ(I,J,2) IF ( LSOA ) THEN CALL ERROR_STOP('LSOA not supported yet', & 'carbon_adj_mod.f') ! ! Total HYDROPHILIC OC source [kg] ! ! (Don't use archived TERP_ORGC if LSOA=T) ! OCSRC(I,J,1) = ANTH_ORGC(I,J,1) + ! & BIOF_ORGC(I,J,1) + ! & BIOB_ORGC(I,J,1) ELSE ! fwd code: ! ! Total HYDROPHILIC OC source [kg] ! (Use archived TERP_ORGC for if LSOA=F) ! OCSRC(I,J,1) ! = ANTH_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_an) ! + BIOF_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_bf) ! + BIOB_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_bb) ! + TERP_ORGC(I,J) ! adj code: EMS_SF_ADJ(I,J,1,IDADJ_EOCPI_an) & = EMS_SF_ADJ(I,J,1,IDADJ_EOCPI_an) & + ANTH_ORGC(I,J,1) * OCSRC_ADJ(I,J,1) EMS_SF_ADJ(I,J,1,IDADJ_EOCPI_bf) & = EMS_SF_ADJ(I,J,1,IDADJ_EOCPI_bf) & + BIOF_ORGC(I,J,1) * OCSRC_ADJ(I,J,1) EMS_SF_ADJ(I,J,1,IDADJ_EOCPI_bb) & = EMS_SF_ADJ(I,J,1,IDADJ_EOCPI_bb) & + BIOB_ORGC(I,J,1) * OCSRC_ADJ(I,J,1) ENDIF ! fwd code: ! ! Total HYDROPHOBIC OC source [kg] ! OCSRC(I,J,2) ! = ANTH_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_an) ! + BIOF_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_bf) ! + BIOB_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_bb) ! adj code: EMS_SF_ADJ(I,J,1,IDADJ_EOCPO_an) & = EMS_SF_ADJ(I,J,1,IDADJ_EOCPO_an) & + ANTH_ORGC(I,J,2) * OCSRC_ADJ(I,J,2) EMS_SF_ADJ(I,J,1,IDADJ_EOCPO_bf) & = EMS_SF_ADJ(I,J,1,IDADJ_EOCPO_bf) & + BIOF_ORGC(I,J,2) * OCSRC_ADJ(I,J,2) EMS_SF_ADJ(I,J,1,IDADJ_EOCPO_bb) & = EMS_SF_ADJ(I,J,1,IDADJ_EOCPO_bb) & + BIOB_ORGC(I,J,2) * OCSRC_ADJ(I,J,2) ENDDO ENDDO !$OMP END PARALLEL DO ! Optional diagnostic -- also save out the emissions adjoints (dkh, 02/17/11) ! (absolute sensitivities per emissions rather than per scaling factor) IF ( LEMS_ABS ) THEN !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J ) DO J = 1, JJPAR DO I = 1, IIPAR ! fwd code: ! ! Total HYDROPHILIC BC source [kg] ! BCSRC(I,J,1)= ANTH_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_an) ! + BIOF_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_bf) ! + BIOB_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_bb) ! adj code: EMS_ADJ(I,J,1,IDADJ_EBCPI_an) & = EMS_ADJ(I,J,1,IDADJ_EBCPI_an) + BCSRC_ADJ(I,J,1) EMS_ADJ(I,J,1,IDADJ_EBCPI_bf) & = EMS_ADJ(I,J,1,IDADJ_EBCPI_bf) + BCSRC_ADJ(I,J,1) EMS_ADJ(I,J,1,IDADJ_EBCPI_bb) & = EMS_ADJ(I,J,1,IDADJ_EBCPI_bb) + BCSRC_ADJ(I,J,1) ! fwd code: ! ! Total HYDROPHOBIC BC source [kg] ! BCSRC(I,J,2)= ANTH_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPI_an) ! + BIOF_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_bf) ! + BIOB_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_bb) ! adj code: EMS_ADJ(I,J,1,IDADJ_EBCPO_an) & = EMS_ADJ(I,J,1,IDADJ_EBCPO_an) + BCSRC_ADJ(I,J,2) EMS_ADJ(I,J,1,IDADJ_EBCPO_bf) & = EMS_ADJ(I,J,1,IDADJ_EBCPO_bf) + BCSRC_ADJ(I,J,2) EMS_ADJ(I,J,1,IDADJ_EBCPO_bb) & = EMS_ADJ(I,J,1,IDADJ_EBCPO_bb) + BCSRC_ADJ(I,J,2) IF ( LSOA ) THEN CALL ERROR_STOP('LSOA not supported yet', & 'carbon_adj_mod.f') ! ! Total HYDROPHILIC OC source [kg] ! ! (Don't use archived TERP_ORGC if LSOA=T) ! OCSRC(I,J,1) = ANTH_ORGC(I,J,1) + ! & BIOF_ORGC(I,J,1) + ! & BIOB_ORGC(I,J,1) ELSE ! fwd code: ! ! Total HYDROPHILIC OC source [kg] ! (Use archived TERP_ORGC for if LSOA=F) ! OCSRC(I,J,1) ! = ANTH_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_an) ! + BIOF_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_bf) ! + BIOB_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_bb) ! + TERP_ORGC(I,J) ! adj code: EMS_ADJ(I,J,1,IDADJ_EOCPI_an) & = EMS_ADJ(I,J,1,IDADJ_EOCPI_an) + OCSRC_ADJ(I,J,1) EMS_ADJ(I,J,1,IDADJ_EOCPI_bf) & = EMS_ADJ(I,J,1,IDADJ_EOCPI_bf) + OCSRC_ADJ(I,J,1) EMS_ADJ(I,J,1,IDADJ_EOCPI_bb) & = EMS_ADJ(I,J,1,IDADJ_EOCPI_bb) + OCSRC_ADJ(I,J,1) ENDIF ! fwd code: ! ! Total HYDROPHOBIC OC source [kg] ! OCSRC(I,J,2) ! = ANTH_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_an) ! + BIOF_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_bf) ! + BIOB_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_bb) ! adj code: EMS_ADJ(I,J,1,IDADJ_EOCPO_an) & = EMS_ADJ(I,J,1,IDADJ_EOCPO_an) + OCSRC_ADJ(I,J,2) EMS_ADJ(I,J,1,IDADJ_EOCPO_bf) & = EMS_ADJ(I,J,1,IDADJ_EOCPO_bf) + OCSRC_ADJ(I,J,2) EMS_ADJ(I,J,1,IDADJ_EOCPO_bb) & = EMS_ADJ(I,J,1,IDADJ_EOCPO_bb) + OCSRC_ADJ(I,J,2) ENDDO ENDDO !$OMP END PARALLEL DO ENDIF ! Return to calling program END SUBROUTINE EMISSCARBON_ADJ !------------------------------------------------------------------------------ SUBROUTINE EMITHIGH_ADJ( BCSRC_ADJ, OCSRC_ADJ ) ! !****************************************************************************** ! Subroutine EMITHIGH_ADJ is the adjoint of EMITHIGH (dkh, 04/26/06) ! ! Based on forward routine EMITHIGHT that mixes tracer completely from the ! surface to the PBL top. (rjp, bmy, 4/2/04, 2/17/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) BCSRC (REAL*8) : Array which holds Total BC (H-phobic & H-philic) ! (2 ) OCSRC (REAL*8) : Array which holds Total OC (H-phobic & H-philic) ! ! NOTES: ! (1 ) Updated to GCv8 (dkh, 11/11/09) ! (2 ) L Taken out of the OpenMP Loop (yd, 08/28/12) !****************************************************************************** ! ! References to F90 modules USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ USE ERROR_MOD, ONLY : ERROR_STOP USE PBL_MIX_MOD, ONLY : GET_FRAC_OF_PBL, GET_PBL_MAX_L USE TRACER_MOD, ONLY : STT USE TRACERID_MOD, ONLY : IDTBCPI, IDTBCPO, IDTOCPI, IDTOCPO USE TRACERID_MOD, ONLY : IDTALPH, IDTLIMO, IDTALCO # include "CMN_SIZE" ! Size parameters ! Arguments REAL*8, INTENT(OUT) :: BCSRC_ADJ(IIPAR,JJPAR,2) REAL*8, INTENT(OUT) :: OCSRC_ADJ(IIPAR,JJPAR,2) ! Local variables LOGICAL :: IS_BCPO, IS_OCPO, IS_BCPI, IS_OCPI LOGICAL :: IS_ALPH, IS_LIMO, IS_ALCO INTEGER :: I, J, L, PBL_MAX REAL*8 :: F_OF_PBL !================================================================= ! EMITHIGH_ADJ begins here! !================================================================= ! initialize BCSRC_ADJ = 0d0 OCSRC_ADJ = 0d0 ! Define logical flags for expediency IS_BCPI = ( IDTBCPI > 0 ) IS_OCPI = ( IDTOCPI > 0 ) IS_BCPO = ( IDTBCPO > 0 ) IS_OCPO = ( IDTOCPO > 0 ) IF ( IDTALPH > 0 ) & CALL ERROR_STOP( 'ALPH not supported', 'carbon_adj_mod') IF ( IDTLIMO > 0 ) & CALL ERROR_STOP( 'LIMO not supported', 'carbon_adj_mod') IF ( IDTALCO > 0 ) & CALL ERROR_STOP( 'ALCO not supported', 'carbon_adj_mod') IF ( IS_OCPI .AND. IS_BCPI.AND.IS_BCPO.AND.IS_OCPO ) THEN !lzhang ! Maximum extent of PBL [model levels] PBL_MAX = GET_PBL_MAX_L() !================================================================= ! Partition emissions throughout the boundary layer !================================================================= DO L = 1, PBL_MAX !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, F_OF_PBL ) DO J = 1, JJPAR DO I = 1, IIPAR ! Fraction of PBL spanned by grid box (I,J,L) [unitless] F_OF_PBL = GET_FRAC_OF_PBL( I, J, L ) ! Hydrophilic BLACK CARBON !ZL IF ( IS_BCPI ) THEN ! fwd code: !STT(I,J,L,IDTBCPI) = STT(I,J,L,IDTBCPI) + ! ( F_OF_PBL * BCSRC(I,J,1) ) ! adj code: BCSRC_ADJ(I,J,1) = BCSRC_ADJ(I,J,1) & + F_OF_PBL * STT_ADJ(I,J,L,IDTBCPI) !ZL ENDIF ! Hydrophilic ORGANIC CARBON !ZL IF ( IS_OCPI ) THEN ! fwd code: !STT(I,J,L,IDTOCPI) = STT(I,J,L,IDTOCPI) + ! ( F_OF_PBL * OCSRC(I,J,1) ) ! adj code: OCSRC_ADJ(I,J,1) = OCSRC_ADJ(I,J,1) & + F_OF_PBL * STT_ADJ(I,J,L,IDTOCPI) !ZL ENDIF ! Hydrophobic BLACK CARBON !ZL IF ( IS_BCPO ) THEN ! fwd code: !STT(I,J,L,IDTBCPO) = STT(I,J,L,IDTBCPO) + ! ( F_OF_PBL * BCSRC(I,J,2) ) ! adj code: BCSRC_ADJ(I,J,2) = BCSRC_ADJ(I,J,2) & + F_OF_PBL * STT_ADJ(I,J,L,IDTBCPO) !ZL ENDIF ! Hydrophobic ORGANIC CARBON !ZL IF ( IS_OCPO ) THEN ! fwd code: !STT(I,J,L,IDTOCPO) = STT(I,J,L,IDTOCPO) + ! ( F_OF_PBL * OCSRC(I,J,2) ) ! adj code: OCSRC_ADJ(I,J,2) = OCSRC_ADJ(I,J,2) & + F_OF_PBL * STT_ADJ(I,J,L,IDTOCPO) !ZL ENDIF ! remaining species not yet included in adjoint ! ! ALPHA-PINENE ! IF ( IS_ALPH ) THEN ! STT(I,J,L,IDTALPH) = STT(I,J,L,IDTALPH) + ! & ( F_OF_PBL * BIOG_ALPH(I,J) ) ! ENDIF ! ! ! LIMONENE ! IF ( IS_LIMO ) THEN ! STT(I,J,L,IDTLIMO) = STT(I,J,L,IDTLIMO) + ! & ( F_OF_PBL * BIOG_LIMO(I,J) ) ! ! ORVC_TERP(I,J,L) = ORVC_TERP(I,J,L) + ! & ( F_OF_PBL * BIOG_TERP(I,J) ) ! ENDIF ! ! ! ALCOHOL and SESQTERPENE (not a tracer) ! IF ( IS_ALCO ) THEN ! STT(I,J,L,IDTALCO) = STT(I,J,L,IDTALCO) + ! & ( F_OF_PBL * BIOG_ALCO(I,J) ) ! ! ORVC_SESQ(I,J,L) = ORVC_SESQ(I,J,L) + ! & ( F_OF_PBL * BIOG_SESQ(I,J) ) ! ENDIF ENDDO ENDDO !ZL ENDDO !$OMP END PARALLEL DO ENDDO ENDIF !lzhang ! Return to calling program END SUBROUTINE EMITHIGH_ADJ !------------------------------------------------------------------------------ SUBROUTINE INIT_CARBON_ADJ ! !****************************************************************************** ! Subroutine INIT_CARBON_ADJ initializes all module arrays (rjp, bmy, 4/1/04) ! ! NOTES: !****************************************************************************** ! References to F90 modules USE ERROR_MOD, ONLY : ALLOC_ERR # include "CMN_SIZE" ! Size parameters ! Local variables LOGICAL, SAVE :: IS_INIT = .FALSE. INTEGER :: AS !================================================================= ! INIT_CARBON_ADJ begins here! !================================================================= ! Return if we already allocated arrays IF ( IS_INIT ) RETURN ALLOCATE( BCCONV_ADJ( IIPAR, JJPAR, LLPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'BCCONV_ADJ' ) BCCONV_ADJ = 0d0 ALLOCATE( OCCONV_ADJ( IIPAR, JJPAR, LLPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'OCCONV_ADJ' ) OCCONV_ADJ = 0d0 ! Reset IS_INIT IS_INIT = .TRUE. ! Return to calling program END SUBROUTINE INIT_CARBON_ADJ !------------------------------------------------------------------------------ SUBROUTINE CLEANUP_CARBON_ADJ ! !****************************************************************************** ! Subroutine CLEANUP_CARBON_ADJ deallocates all module arrays (rjp, bmy, 4/1/04) ! ! NOTES: !****************************************************************************** ! !================================================================= ! CLEANUP_CARBON_ADJ begins here! !================================================================= IF ( ALLOCATED( BCCONV_ADJ ) ) DEALLOCATE( BCCONV_ADJ ) IF ( ALLOCATED( OCCONV_ADJ ) ) DEALLOCATE( OCCONV_ADJ ) ! Return to calling program END SUBROUTINE CLEANUP_CARBON_ADJ !------------------------------------------------------------------------------ END MODULE CARBON_ADJ_MOD