Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
926eb40b05a9add408c8fa5f3bb1a47d3f58a328
GEOS-Chem-adjoint-v35-note/code/modified/carbon_mod.f
Xuesong (Steve) cffebb9cd6 Add files via upload
2018-08-28 00:37:54 -04:00

6556 lines
239 KiB
Fortran
Raw Blame History

! $Id: carbon_mod.f,v 1.4 2011/02/23 00:08:48 daven Exp $
MODULE CARBON_MOD
!
!******************************************************************************
! Module CARBON_MOD contains arrays and routines for performing a
! carbonaceous aerosol simulation. Original code taken from Mian Chin's
! GOCART model and modified accordingly. (rjp, bmy, 4/2/04, 2/19/09)
!
! 4 Aerosol species : Organic and Black carbon
! : hydrophilic (soluble) and hydrophobic of each
! For secondary organic aerosol (SOA) simulation orginal code developed
! by Chung and Seinfeld [2002] and Hong Liao from John Seinfeld's group
! at Caltech was taken and further modified accordingly (rjp, bmy, 7/15/04)
! This simulation introduces additional following species:
! ALPH, LIMO, ALCO, SOA1, SOA2, SOA3, SOA4, SOG1, SOG2, SOG3, SOG4
!
! References for BC/OC emissions:
! --------------------------------
! Bond, T.C. et al.: Historical emissions of black and organic carbon
! aerosol fromenergy-related combustion, 1850-2000, Global Biogeochem. Cycles,
! 21 GB2018, doi: 10.1029/2006GB002840, 2007.
!
! Base Year is 2000. More at http://www.hiwater.org
!
! Module Variables:
! ============================================================================
! (1 ) ANTH_BLKC (REAL*8 ) : BC anthropogenic emissions [kg C ]
! (2 ) ANTH_ORGC (REAL*8 ) : OC anthropogenic emissions [kg C ]
! (3 ) APROD (REAL*8 ) : Aerosol mass ratio
! (4 ) BCCONV (REAL*8 ) : Hydrophilic BC from Hydrophobic [kg C ]
! (5 ) BIOB_BLKC (REAL*8 ) : BC biomass emissions [kg C ]
! (6 ) BIOB_ORGC (REAL*8 ) : OC biomass emissions [kg C ]
! (7 ) BIOF_BLKC (REAL*8 ) : BC biofuel emissions [kg C ]
! (8 ) BIOF_ORGC (REAL*8 ) : OC biofuel emissions [kg C ]
! (9 ) BIOG_ALPH (REAL*8 ) : A-PINENE biogenic emissions [kg]
! (10) BIOG_LIMO (REAL*8 ) : LIMONENE biogenic emissions [kg]
! (11) BIOG_ALCO (REAL*8 ) : ALCOHOL biogenic emissions [kg]
! (12) BIOG_TERP (REAL*8 ) : TERPENE biogenic emissions [kg]
! (13) BIOG_SESQ (REAL*8 ) : SESQTERPENE biogenic emissions [kg]
! (14) DIUR_ORVC (REAL*8 ) : Diurnal variation of NVOC [kg C]
! (15) DRYBCPI (INTEGER) : Index for BCPI in drydep array
! (16) DRYOCPI (INTEGER) : Index for OCPI in drydep array
! (17) DRYBCPO (INTEGER) : Index for BCPO in drydep array
! (18) DRYOCPO (INTEGER) : Index for OCPO in drydep array
! (19) DRYALPH (INTEGER) : Index for ALPH in drydep array
! (20) DRYLIMO (INTEGER) : Index for LIMO in drydep array
! (21) DRYALCO (INTEGER) : Index for ALCO in drydep array
! (22) DRYSOG1 (INTEGER) : Index for SOG1 in drydep array
! (23) DRYSOG2 (INTEGER) : Index for SOG2 in drydep array
! (24) DRYSOG3 (INTEGER) : Index for SOG3 in drydep array
! (25) DRYSOA1 (INTEGER) : Index for SOA1 in drydep array
! (26) DRYSOA2 (INTEGER) : Index for SOA2 in drydep array
! (27) DRYSOA3 (INTEGER) : Index for SOA3 in drydep array
! (28) EF_BLKC (REAL*8 ) : Emission factors for BC [kg/kg]
! (29) EF_ORGC (REAL*8 ) : Emission factors for OC [kg/kg]
! (30) GEIA_ORVC (REAL*8 ) : NVOC emissions from GEIA [kg C ]
! (31) I1_NA (REAL*8 ) : Starting lon index for N. America region
! (32) I2_NA (REAL*8 ) : Ending lon index for N. America region
! (33) J1_NA (REAL*8 ) : Starting lat index for N. America region
! (34) J2_NA (REAL*8 ) : Ending lat index for N. America region
! (35) GPROD (REAL*8 ) : Gas mass ratio
! (36) MHC (INTEGER) : Number of VOC clasees
! (37) NDAYS (INTEGER) : Array w/ number of days per month
! (38) NPROD (INTEGER) : Number of products by oxdation
! (39) OCCONV (REAL*8 ) : Hydrophilic OC from Hydrophobic [kg C ]
! (40) ORVC_SESQ (REAL*8 ) : SESQTERPENE concentration [kg]
! (41) ORVC_TERP (REAL*8 ) : MONOTERPENES concentration [kg]
! (42) TCOSZ (REAL*8 ) : Summing array for SUNCOS
! (43) TERP_ORGC (REAL*8 ) : Lumped terpene emissions [kg C ]
! (44) SMALLNUM (REAL*8 ) : A small positive number
! (45) USE_BOND_BIOBURN (LOGICAL) : Flag to use annual biomass emiss.
!
! Module Routines:
! ============================================================================
! (1 ) CHEMCARBON : Driver program for carbon aerosol chemistry
! (2 ) CHEM_BCPO : Chemistry routine for hydrophobic BC (aka EC)
! (3 ) CHEM_BCPI : Chemistry routine for hydrophilic BC (aka EC)
! (4 ) CHEM_OCPO : Chemistry routine for hydrophobic OC
! (5 ) CHEM_OCPI : Chemistry routine for hydrophilic OC
! (6 ) SOA_CHEMISTRY : Driver routine for SOA chemistry
! (7 ) SOA_EQUIL : Determines mass of SOA
! (8 ) ZEROIN : Finds root of an equation by bisection method
! (9 ) SOA_PARA : Gets SOA yield parameters
! (10) CHEM_NVOC : Computes oxidation of HC by O3, OH, NO3
! (11) SOA_PARTITION : Partitions mass of SOA gas & aerosol tracers
! (12) SOA_LUMP : Returns organic gas & aerosol back to STT
! (13) SOA_DEPO : Performs dry deposition of SOA tracers & species
! (14) EMISSCARBON : Driver routine for carbon aerosol emissions
! (15) BIOGENIC_OC : Computes biogenic OC [each time step]
! (16) ANTHRO_CARB_TBOND : Computes anthropogenic OC/EC [annual data]
! (17) ANTHRO_CARB_COOKE : Computes anthropogenic OC/EC [monthly data]
! (18) BIOMASS_CARB_TBOND : Computes biomass burning OC/EC [annual data]
! (19) BIOMASS_CARB_GEOS : Computes biomass burning OC/EC [monthly data]
! (20) EMITHIGH : Computes complete mixing of emission within PBL
! (21) OHNO3TIME : Computes the sum of the cosine of SZA
! (22) GET_OH : Returns monthly-mean OH conc. at grid box (I,J,L)
! (23) GET_NO3 : Returns monthly-mean O3 conc. at grid box (I,J,L)
! (24) GET_O3 : Returns monthly-mean NO3 conc. at grid box (I,J,L)
! (25) GET_DOH : Returns ISOP lost to rxn w/ OH at grid box (I,J,L)
! (26) INIT_CARBON : Allocates and zeroes all module arrays
! (27) CLEANUP_CARBON : Deallocates all module arrays
!
! NOTE: Choose either (16) or (17) for ANTHROPOGENIC emission
! Choose either (18) or (19) for BIOMASS BURNING emission.
!
! 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 ) Added code from the Caltech group for SOA chemistry (rjp, bmy, 7/15/04)
! (2 ) Now references "directory_mod.f", "logical_mod.f", "tracer_mod.f".
! (bmy, 7/20/04)
! (3 ) Now read data from carbon_200411/ subdir of DATA_DIR. Also added
! some extra debug output. Now read T. Bond yearly emissions as
! default, but overwrite N. America with the monthly Cooke/RJP
! emissions. Added module variables I1_NA, I2_NA, J1_NA, J2_NA.
! (rjp, bmy, 12/1/04)
! (4 ) Now can read seasonal or interannual BCPO, OCPO biomass emissions.
! Also parallelize loop in OHNO3TIME. (rjp, bmy, 1/18/05)
! (5 ) Now references "pbl_mix_mod.f". Bug fix: now make sure only to save
! up to LD07 levels for the ND07 diagnostic in SOA_LUMP. (bmy, 3/4/05)
! (6 ) Now can read data for both GEOS and GCAP grids (bmy, 8/16/05)
! (7 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (8 ) Now references "megan_mod.f". Also now references XNUMOL and
! XNUMOLAIR from "tracer_mod.f" (tmf, bmy, 10/25/05)
! (9 ) Bug fix for GCAP in BIOGENIC_OC (bmy, 4/11/06)
! (10) Updated for SOA production from ISOP (dkh, bmy, 5/22/06)
! (11) Updated for IPCC future emission scale factors. Also added function
! GET_DOH to return ISOP that has reacted w/ OH. (swu, dkh, bmy, 6/1/06)
! (12) Now add SOG condensation onto SO4, NH4, NIT (rjp, bmy, 8/3/06)
! (13) Minor fix for 20 carbon tracers. (phs, 9/14/06)
! (14) Now remove reading of biomass emissions from "carbon_mod.f", since
! they are better done in gc_biomass_mod.f. This will allow us to
! standardize treatment of GFED2 or default BB emissions. Also applied
! a typo fix in SOA_LUMP. (tmf, bmy, 10/16/06)
! (15) Prevent seg fault error in BIOMASS_CARB_GEOS (bmy, 11/3/06)
! (16) Corrected typos in SOA_LUMP. Now also save GPROD and APROD to disk
! for each new diagnostic interval. (dkh, tmv, havala, bmy, 2/6/07)
! (17) Modifications for 0.5 x 0.666 nested grids (yxw, dan, bmy, 11/6/08)
! (18) Now account for various GFED2 products (yc, phs, 12/23/08)
! (19) Now add future scaling to BIOMASS_CARB_GEOS (hotp, swu, 2/19/09)
! (20) Added SOA production from dicarbonyls (tmf, 3/2/09)
! (21) Bugfix: cleanup ORVC_TERP and ORVC_SESQ (tmf, 3/2/09)
! (22) Replace USE_MONTHLY_BIOB with USE_BOND_BIOBURN, since this hardwired
! flag is a switc b/w annual Bond biomass burning emissions, and default
! GC source, which can be monthly/8 days/3hr.
! Implement changes for reading new Bond files (eml, phs, 5/18/09)
! (23) Add option for non-local PBL scheme (lin, 06/09/08)
! (24) Modified to include GFED3 (psk, 1/5/11)
!******************************************************************************
!
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
PUBLIC :: CLEANUP_CARBON
PUBLIC :: EMISSCARBON
PUBLIC :: WRITE_GPROD_APROD
PUBLIC :: BIOMASS_CARB_GEOS !lzhang
! adj_group: make these public (dkh, 09/09/09)
PUBLIC :: DRYBCPI, DRYOCPI, DRYBCPO, DRYOCPO
! ... and these (dkh, 11/11/09)
PUBLIC :: ANTH_ORGC, ANTH_BLKC, BIOB_ORGC, BIOB_BLKC
PUBLIC :: BIOF_ORGC, BIOF_BLKC
!=================================================================
! MODULE VARIABLES
!=================================================================
! Scalars
!LOGICAL :: USE_MONTHLY_BIOB = .TRUE.
LOGICAL :: USE_BOND_BIOBURN = .FALSE.
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(:,:,:)
! 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
!
!******************************************************************************
! Subroutine CHEMCARBON is the interface between the GEOS-CHEM main program
! and the carbon aerosol chemistry routines that calculates dry deposition,
! chemical conversion between hydrophilic and hydrophobic, and SOA production.
! (rjp, bmy, 4/1/04, 9/14/06)
!
! NOTES:
! (1 ) Added code from the Caltech group for SOA chemistry. Also now
! reference "global_oh_mod.f", "global_o3_mod.f", "global_no3_mod.f".
! (rjp, bmy, 7/8/04)
! (2 ) Now reference LSOA and LEMIS from CMN_SETUP. Now only call OHNO3TIME
! if it hasn't been done before w/in EMISSCARBON. (rjp, bmy, 7/15/04)
! (3 ) Now reference LSOA, LEMIS, LPRT from "logical_mod.f". Now reference
! STT and ITS_AN_AEROSOL_SIM from "tracer_mod.f" (bmy, 7/20/04)
! (4 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (5 ) Now updated for SOA production from ISOP. (dkh, bmy, 6/1/06)
! (6 ) Bug fix for aerosol sim w/ 20 tracers (phs, 9/14/06)
!******************************************************************************
!
! References to F90 modules
USE DRYDEP_MOD, ONLY : DEPNAME, NUMDEP
USE ERROR_MOD, ONLY : DEBUG_MSG
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 begins here!
!=================================================================
! First-time initialization
IF ( FIRSTCHEM ) THEN
! Initialize arrays (if not already done before)
CALL INIT_CARBON
! 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 hydrophobic BC
IF ( IDTBCPO > 0 ) THEN
CALL CHEM_BCPO( STT(:,:,:,IDTBCPO) )
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMCARBON: a CHEM_BCPO' )
ENDIF
! Chemistry for hydrophilic BC
IF ( IDTBCPI > 0 ) THEN
CALL CHEM_BCPI( STT(:,:,:,IDTBCPI) )
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMCARBON: a CHEM_BCPI' )
ENDIF
! Chemistry for hydrophobic OC
IF ( IDTOCPO > 0 ) THEN
CALL CHEM_OCPO( STT(:,:,:,IDTOCPO) )
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMCARBON: a CHEM_OCPO' )
ENDIF
! Chemistry for hydrophilic OC
IF ( IDTOCPI > 0 ) THEN
CALL CHEM_OCPI( STT(:,:,:,IDTOCPI) )
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMCARBON: a CHEM_OCPI' )
ENDIF
!=================================================================
! Do chemistry for secondary organic aerosols
!=================================================================
IF ( LSOA ) THEN
! 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
!-----------------------------------------------------------------------------
SUBROUTINE CHEM_BCPO( TC )
!
!******************************************************************************
! Subroutine CHEM_BCPO converts hydrophobic BC to hydrophilic BC and
! calculates the dry deposition of hydrophobic BC. (rjp, bmy, 4/1/04,10/25/05)
!
! Arguments as Input:
! ============================================================================
! (1 ) TC (REAL*8) : Array of hydrophobic BC tracer
!
! NOTES:
! (1 ) Remove reference to "CMN", it's obsolete (bmy, 7/20/04)
! (2 ) Replace PBLFRAC from "drydep_mod.f" with GET_FRAC_UNDER_PBLTOP
! from "pbl_mix_mod.f" (bmy, 2/17/05)
! (3 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
!******************************************************************************
!
! References to F90 modules
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(IIPAR,JJPAR,LLPAR)
! Local variables
INTEGER :: I, J, L
REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR)
REAL*8 :: DTCHEM, FLUX, KBC, FREQ
REAL*8 :: TC0, CNEW, RKT, AREA_CM2, BL_FRAC
REAL*8, PARAMETER :: BC_LIFE = 1.15D0
!=================================================================
! CHEM_BCPO 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
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
BCCONV(I,J,L) = 0d0
! Initialize for drydep diagnostic
IF ( ND44 > 0 ) ND44_TMP(I,J,L) = 0d0
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! 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, FREQ, BL_FRAC, RKT, CNEW, AREA_CM2, FLUX )
!$OMP+SCHEDULE( DYNAMIC )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
! Initial BC mass [kg]
TC0 = TC(I,J,L)
! Zero drydep freq
FREQ = 0d0
! Fraction of grid box underneath 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] -- BL_FRAC 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
! Amount of BCPO left after chemistry and drydep [kg]
RKT = ( KBC + FREQ ) * DTCHEM
CNEW = TC0 * EXP( -RKT )
! Prevent underflow condition
IF ( CNEW < SMALLNUM ) CNEW = 0d0
! Amount of BCPO converted to BCPI [kg/timestep]
BCCONV(I,J,L) = ( TC0 - CNEW ) * KBC / ( KBC + FREQ )
!==============================================================
! 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
! Store new concentration back into tracer array
TC(I,J,L) = CNEW
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
! Return to calling program
END SUBROUTINE CHEM_BCPO
!------------------------------------------------------------------------------
SUBROUTINE CHEM_BCPI( TC )
!
!******************************************************************************
! Subroutine CHEM_BCPI calculates dry deposition of hydrophilic BC.
! (rjp, bmy, 4/1/04, 10/25/05)
!
! Arguments as Input:
! ============================================================================
! (1 ) TC (REAL*8) : Array of hydrophilic BC tracer
!
! NOTES:
! (1 ) Remove reference to "CMN", it's obsolete (bmy, 7/20/04)
! (2 ) Replace PBLFRAC from "drydep_mod.f" with GET_FRAC_UNDER_PBLTOP from
! "pbl_mix_mod.f" (bmy, 2/17/05)
! (3 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
!******************************************************************************
!
! References to F90 modules
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 : IDTBCPI
USE TIME_MOD, ONLY : GET_TS_CHEM
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! ND44
! Arguments
REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR)
! Local variables
INTEGER :: I, J, L
REAL*8 :: DTCHEM, FLUX, BL_FRAC, AREA_CM2
REAL*8 :: TC0, CNEW, CCV, FREQ
REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR)
!=================================================================
! CHEM_BCPI begins here!
!=================================================================
! Return if BCPI isn't defined
IF ( IDTBCPI == 0 .or. DRYBCPI == 0 ) RETURN
! Chemistry timestep [s]
DTCHEM = GET_TS_CHEM() * 60d0
! 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, CCV, FREQ, BL_FRAC, CNEW, AREA_CM2, FLUX )
!$OMP+SCHEDULE( DYNAMIC )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
! Initial H-philic BC [kg]
TC0 = TC(I,J,L)
! H-philic BC that used to be H-phobic BC [kg]
CCV = BCCONV(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)
!===========================================================
! Comment out for now
!CNEW = TC0 * EXP( -FREQ * DTCHEM )
! + CCV / FREQ * ( 1.D0 - EXP( -FREQ * DTCHEM ) )
! Amount of BCPI left after drydep [kg]
CNEW = ( TC0 + CCV ) * EXP( -FREQ * DTCHEM )
!===========================================================
! 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
CNEW = TC0 + CCV
ENDIF
! Prevent underflow condition
IF ( CNEW < SMALLNUM ) CNEW = 0d0
! Save new concentration of H-philic IC in tracer array
TC(I,J,L) = CNEW
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Zero out the BCCONV 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
BCCONV(I,J,L) = 0.d0
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
!------------------------------------------------------------------------------
SUBROUTINE CHEM_OCPO( TC )
!
!******************************************************************************
! Subroutine CHEM_OCPO converts hydrophobic OC to hydrophilic OC and
! calculates the dry deposition of hydrophobic OC. (rjp, bmy, 4/1/04,10/25/05)
!
! Arguments as Input:
! ============================================================================
! (1 ) TC (REAL*8) : Array of hydrophobic OC tracer [kg]
!
! NOTES:
! (1 ) Remove reference to "CMN", it's obsolete (bmy, 7/20/04)
! (2 ) Replace PBLFRAC from "drydep_mod.f" with GET_FRAC_UNDER_PBLTOP from
! "pbl_mix_mod.f" (bmy, 2/17/05)
! (3 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
!******************************************************************************
!
! References to F90 modules
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(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, FREQ, CNEW, RKT, AREA_CM2
REAL*8, PARAMETER :: OC_LIFE = 1.15D0
!=================================================================
! CHEM_OCPO 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
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
OCCONV(I,J,L) = 0d0
! Initialize for drydep diagnostic
IF ( ND44 > 0 ) ND44_TMP(I,J,L) = 0d0
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! 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, FREQ, BL_FRAC, RKT, CNEW, AREA_CM2, FLUX )
!$OMP+SCHEDULE( DYNAMIC )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
! Initial OC [kg]
TC0 = TC(I,J,L)
! Zero drydep freq
FREQ = 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
! OC drydep frequency [1/s] -- BL_FRAC 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 left after chemistry and drydep [kg]
RKT = ( KOC + FREQ ) * DTCHEM
CNEW = TC0 * EXP( -RKT )
! Prevent underflow condition
IF ( CNEW < SMALLNUM ) CNEW = 0d0
! Amount of OCPO converted to OCPI [kg/timestep]
OCCONV(I,J,L) = ( TC0 - CNEW ) * KOC / ( KOC + FREQ )
!==============================================================
! 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
! Store modified OC concentration back in tracer array
TC(I,J,L) = CNEW
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
! Return to calling program
END SUBROUTINE CHEM_OCPO
!------------------------------------------------------------------------------
SUBROUTINE CHEM_OCPI( TC )
!
!******************************************************************************
! Subroutine CHEM_BCPI calculates dry deposition of hydrophilic OC.
! (rjp, bmy, 4/1/04, 10/25/05)
!
! Arguments as Input:
! ============================================================================
! (1 ) TC (REAL*8) : Array of hydrophilic BC tracer
!
! NOTES:
! (1 ) Remove reference to "CMN", it's obsolete (bmy, 7/20/04)
! (2 ) Replace PBLFRAC from "drydep_mod.f" with GET_FRAC_UNDER_PBLTOP from
! "pbl_mix_mod.f" (bmy, 2/17/05)
! (3 ) Bug fix: add BL_FRAC to the PRIVATE list (mak, bmy, 10/3/05)
! (4 ) Now refrerences XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
!******************************************************************************
!
! References to F90 modules
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(IIPAR,JJPAR,LLPAR)
! Local variable
INTEGER :: I, J, L
REAL*8 :: DTCHEM, FLUX, BL_FRAC
REAL*8 :: TC0, CNEW, CCV, FREQ, AREA_CM2
REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR)
!=================================================================
! CHEM_OCPI 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
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, TC0, CCV, BL_FRAC, FREQ, CNEW, AREA_CM2, FLUX )
!$OMP+SCHEDULE( DYNAMIC )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
! Initial H-philic OC [kg]
TC0 = TC(I,J,L)
! H-philic OC that used to be H-phobic OC [kg]
CCV = OCCONV(I,J,L)
! 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
! 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)
!===========================================================
! CNEW = TC0 * EXP( -FREQ * DTCHEM )
! + CCV / FREQ * ( 1.D0 - EXP( -FREQ * DTCHEM ) )
! Amount of BCPI left after drydep [kg]
CNEW = ( TC0 + CCV ) * EXP( -FREQ * DTCHEM )
!===========================================================
! 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
CNEW = TC0 + CCV
ENDIF
! Prevent underflow condition
IF ( CNEW < SMALLNUM ) CNEW = 0d0
! Store modified concentration back in tracer array [kg]
TC(I,J,L) = CNEW
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Zero OCCONV 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
OCCONV(I,J,L) = 0d0
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
!-------------------------------------------------------------------------------
SUBROUTINE SOAG_LIGGIO_DIFF
!
!******************************************************************************
! Subroutine SOAG_LIGGIO_DIFF produces SOA on aqueous aerosol surfaces
! from GLYX following the uptake model used for N2O5, and the gamma
! from Liggio et al. [2005]. (tmf, 5/30/06)
!
! Procedure:
! ============================================================================
! (1 )
!
! NOTES:
! (1 ) SOAG (SOA product of GLYX is produced at existing hydrophilic aerosol
! surface.
!******************************************************************************
!
! References to F90 modules
USE COMODE_MOD, ONLY : WTAREA, WERADIUS
USE COMODE_MOD, ONLY : AIRDENS, JLOP
USE DAO_MOD, ONLY : AIRVOL, T, RH
USE ERROR_MOD, ONLY : DEBUG_MSG
USE DIAG_MOD, ONLY : AD07_SOAGM
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_MONTH
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTGLYX, IDTSOAG
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_TROP
# include "CMN_SIZE" ! Size parameters
# include "CMN_O3" ! XNUMOL
# include "CMN_DIAG" ! ND44, ND07, LD07
# include "comode.h" ! AD, WTAIR, other SMVGEAR variables
! Local variables
INTEGER :: I, J, L, JLOOP, N
REAL*8 :: XTEMP ! Temperature [K]
REAL*8 :: XSQTEMP ! SQRT of Temperature
REAL*8 :: XAD ! Air density [molec/cm3]
REAL*8 :: XRADIUS ! particle radius [cm]
REAL*8 :: XDFKG ! Gas phase diffusion coeff [cm2/s]
REAL*8 :: XARSL1K ! 1st order k
REAL*8 :: XRH ! Relative humidity [%]
REAL*8 :: XAIRM3 ! Air volume in grid box [m3]
REAL*8 :: XGASM ! Gas mass at grid box before uptake [kg]
REAL*8 :: XGASC ! Gas concentration at grid box before uptake [molec/cm3]
REAL*8 :: XWAREA ! Wet aerosol surface area at grid box [cm^2 wet sfc area of aerosol cm^-3 air]
REAL*8 :: XUPTK0 ! Potential uptake of gas by aerosol in grid box by aerosol type [molec/cm3]
REAL*8 :: XUPTK1 ! Potential uptake of gas by aerosol in grid box by aerosol type [kg]
REAL*8 :: XUPTKSUM ! Potential uptake of gas by aerosol in grid box [kg]
REAL*8 :: XUPTK ! Actual uptake of gas by aerosol in grid box [kg]
! XUPTK <= STT( I, J, L, IDTGLYX )
REAL*8 :: XGAMMA ! Uptake coefficient
! Local variables not changing
REAL*8 :: DTCHEM ! Chemistry time step [s]
REAL*8 :: XMW ! Molecular weight of gas [g/mole]
REAL*8 :: XSQMW ! Square root of molecular weight [g/mole]
REAL*8 :: CRITRH ! Critical RH [%], above which
! heteorogeneous chem takes place
REAL*8 :: XNAVO ! Avogadro number
!=================================================================
! SOAG_LIGGIO_DIFF begins here!
!=================================================================
! Get chemistry time step
DTCHEM = GET_TS_CHEM() * 60d0
! Molecular weight of GLYX [g/mole]
XMW = 58.d0
XSQMW = SQRT( XMW )
! Critical RH, above which heteorogeneous chem takes place
CRITRH = 35.0d0 ! [%]
! Avogadro number
XNAVO = 6.022d23
! Uptake coefficient from Liggio et al. [2005b]
XGAMMA = 2.9d-3
!=================================================================
! Loop over grid boxes
!=================================================================
DO L = 1, LLTROP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Get 1-D index
JLOOP = JLOP( I, J, L )
! Get RH
XRH = RH( I, J, L ) ![%]
! initialize for safety
XUPTK0 = 0d0
XUPTK1 = 0d0
XUPTKSUM = 0d0
XUPTK = 0d0
! Get T
XTEMP = T( I, J, L )
XSQTEMP = SQRT( XTEMP )
! Get air density [molec/cm3]
XAD = AIRDENS( JLOOP )
! Get air volumne [m3]
XAIRM3 = AIRVOL( I, J, L )
! Get gas mass at grid box [kg]
XGASM = STT( I, J, L, IDTGLYX )
! Get gas concentration at grid box [molec/cm3]
XGASC = XGASM / (XMW*1.d-3) * XNAVO / (XAIRM3*1.d6)
!---------------------------------------
! Gas phase diffusion coeff [cm2/s]
!---------------------------------------
XDFKG = 9.45D17 / XAD * XSQTEMP *
& SQRT( 3.472D-2 + (1.D0/XMW) )
!========================================================
! Calculate heteorogeneous uptake only if the grid box
! relative humidity XRH is >= critical relative humidity CRITRH
!========================================================
IF ( XRH >= CRITRH ) THEN
! Loop over sulfate and other aerosols
DO N = 1, NDUST + NAER
!---------------------------------------
! Total available wet aerosol area
! archived in 'aerosol_mod.f.glyx'
! XWAREA [ cm^2 wet sfc area of aerosol cm^-3 air ]
!---------------------------------------
XWAREA = WTAREA( JLOOP, N)
IF ( XWAREA > 0D0 ) THEN
! Get particle radius [cm]
XRADIUS = WERADIUS( JLOOP, N )
!---------------------------------------
! First order rate constant
!---------------------------------------
XARSL1K = XWAREA /
& (XRADIUS/XDFKG + 2.749064D-4*XSQMW/XGAMMA/XSQTEMP)
!---------------------------------------
! Calculate potential uptake: Liggio et al. (2005b) Eq (3)
!
! d( organic carbon conc ) / dt =
! XARSL1K * XGASC
!---------------------------------------
XUPTK0 = XARSL1K * XGASC * DTCHEM
XUPTK1 = XUPTK0 / XNAVO*(XMW*1.d-3)*(XAIRM3*1.d6)
XUPTKSUM = XUPTKSUM + XUPTK1
ENDIF
ENDDO
! However, the mass of gas being absorbed by aerosol
! cannot exceed the original amount of gas XGASM
XUPTK = MIN( XUPTKSUM, XGASM )
! Update GLYX in the STT array
STT( I, J, L, IDTGLYX ) = STT( I, J, L, IDTGLYX ) -
& XUPTK
! Update SOAG in the STT array
STT( I, J, L, IDTSOAG ) = STT( I, J, L, IDTSOAG ) +
& XUPTK
ENDIF
!==============================================================
! ND07 diagnostic: SOAG from GLYX [kg/timestep] on aerosol
!==============================================================
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_SOAGM(I,J,L,1) = AD07_SOAGM(I,J,L,1) + XUPTK
ENDIF
ENDDO
ENDDO
ENDDO
!=================================================================
! Calculate dry-deposition
!=================================================================
CALL SOA_DEPO( STT(:,:,:,IDTSOAG), DRYSOAG, IDTSOAG )
! Return to calling program
END SUBROUTINE SOAG_LIGGIO_DIFF
!------------------------------------------------------------------------------
SUBROUTINE SOAM_LIGGIO_DIFF
!
!******************************************************************************
! Subroutine SOAG_LIGGIO_DIFF produces SOA on aqueous aerosol surfaces
! from GLYX following the uptake model used for N2O5, and the gamma
! from Liggio et al. [2005]. (tmf, 5/30/06)
!
! Procedure:
! ============================================================================
! (1 )
!
! NOTES:
! (1 ) SOAM (SOA product of MGLY) is produced at existing hydrophilic aerosol
! surface.
!******************************************************************************
!
! References to F90 modules
USE COMODE_MOD, ONLY : WTAREA, WERADIUS
USE COMODE_MOD, ONLY : AIRDENS, JLOP
USE DAO_MOD, ONLY : AIRVOL, T, RH
USE ERROR_MOD, ONLY : DEBUG_MSG
USE DIAG_MOD, ONLY : AD07_SOAGM
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_MONTH
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTMGLY, IDTSOAM
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_TROP
# include "CMN_SIZE" ! Size parameters
# include "CMN_O3" ! XNUMOL
# include "CMN_DIAG" ! ND44, ND07, LD07
# include "comode.h" ! AD, WTAIR, other SMVGEAR variables
! Local variables
INTEGER :: I, J, L, JLOOP, N
REAL*8 :: XTEMP ! Temperature [K]
REAL*8 :: XSQTEMP ! SQRT of Temperature
REAL*8 :: XAD ! Air density [molec/cm3]
REAL*8 :: XRADIUS ! particle radius [cm]
REAL*8 :: XDFKG ! Gas phase diffusion coeff [cm2/s]
REAL*8 :: XARSL1K ! 1st order k
REAL*8 :: XRH ! Relative humidity [%]
REAL*8 :: XAIRM3 ! Air volume in grid box [m3]
REAL*8 :: XGASM ! Gas mass at grid box before uptake [kg]
REAL*8 :: XGASC ! Gas concentration at grid box before uptake [molec/cm3]
REAL*8 :: XWAREA ! Wet aerosol surface area at grid box [cm^2 wet sfc area of aerosol cm^-3 air]
REAL*8 :: XUPTK0 ! Potential uptake of gas by aerosol in grid box by aerosol type [molec/cm3]
REAL*8 :: XUPTK1 ! Potential uptake of gas by aerosol in grid box by aerosol type [kg]
REAL*8 :: XUPTKSUM ! Potential uptake of gas by aerosol in grid box [kg]
REAL*8 :: XUPTK ! Actual uptake of gas by aerosol in grid box [kg]
! XUPTK <= STT( I, J, L, IDTGLYX )
REAL*8 :: XGAMMA ! Uptake coefficient
! Local variables not changing
REAL*8 :: DTCHEM ! Chemistry time step [s]
REAL*8 :: XMW ! Molecular weight of gas [g/mole]
REAL*8 :: XSQMW ! Square root of molecular weight [g/mole]
REAL*8 :: CRITRH ! Critical RH [%], above which
! heteorogeneous chem takes place
REAL*8 :: XNAVO ! Avogadro number
!=================================================================
! SOAG_LIGGIO_DIFF begins here!
!=================================================================
! Get chemistry time step
DTCHEM = GET_TS_CHEM() * 60d0
! Molecular weight of MGLY [g/mole]
XMW = 72.d0
XSQMW = SQRT( XMW )
! Critical RH, above which heteorogeneous chem takes place
CRITRH = 35.0d0 ! [%]
! Avogadro number
XNAVO = 6.022d23
! Uptake coefficient from Liggio et al. [2005b]
XGAMMA = 2.9d-3
! Create RH field -- relative humidity (in dao_mod.f)
! CALL MAKE_RH
!=================================================================
! Loop over grid boxes
!=================================================================
DO L = 1, LLTROP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Get 1-D index
JLOOP = JLOP( I, J, L )
! Get RH
XRH = RH( I, J, L ) ![%]
! initialize for safety
XUPTK0 = 0d0
XUPTK1 = 0d0
XUPTKSUM = 0d0
XUPTK = 0d0
! Get T
XTEMP = T( I, J, L )
XSQTEMP = SQRT( XTEMP )
! Get air density [molec/cm3]
XAD = AIRDENS( JLOOP )
! Get air volumne [m3]
XAIRM3 = AIRVOL( I, J, L )
! Get gas mass at grid box [kg]
XGASM = STT( I, J, L, IDTMGLY )
! Get gas concentration at grid box [molec/cm3]
XGASC = XGASM / (XMW*1.d-3) * XNAVO / (XAIRM3*1.d6)
!---------------------------------------
! Gas phase diffusion coeff [cm2/s]
!---------------------------------------
XDFKG = 9.45D17 / XAD * XSQTEMP *
& SQRT( 3.472D-2 + (1.D0/XMW) )
!========================================================
! Calculate heteorogeneous uptake only if the grid box
! relative humidity XRH is >= critical relative humidity CRITRH
!========================================================
IF ( XRH >= CRITRH ) THEN
! Loop over sulfate and other aerosols
DO N = 1, NDUST + NAER
!---------------------------------------
! Total available wet aerosol area
! archived in 'aerosol_mod.f.glyx'
! XWAREA [ cm^2 wet sfc area of aerosol cm^-3 air ]
!---------------------------------------
XWAREA = WTAREA( JLOOP, N)
IF ( XWAREA > 0D0 ) THEN
! Get particle radius [cm]
XRADIUS = WERADIUS( JLOOP, N )
!---------------------------------------
! First order rate constant
!---------------------------------------
XARSL1K = XWAREA /
& (XRADIUS/XDFKG + 2.749064D-4*XSQMW/XGAMMA/XSQTEMP)
!---------------------------------------
! Calculate potential uptake: Liggio et al. (2005b) Eq (3)
!
! d( organic carbon conc ) / dt =
! XARSL1K * XGASC
!---------------------------------------
XUPTK0 = XARSL1K * XGASC * DTCHEM
XUPTK1 = XUPTK0 / XNAVO*(XMW*1.d-3)*(XAIRM3*1.d6)
XUPTKSUM = XUPTKSUM + XUPTK1
ENDIF
ENDDO
! However, the mass of gas being absorbed by aerosol
! cannot exceed the original amount of gas XGASM
XUPTK = MIN( XUPTKSUM, XGASM )
! Update MGLY in the STT array
STT( I, J, L, IDTMGLY ) = STT( I, J, L, IDTMGLY ) -
& XUPTK
! Update SOAM in the STT array
STT( I, J, L, IDTSOAM ) = STT( I, J, L, IDTSOAM ) +
& XUPTK
ENDIF
!==============================================================
! ND07 diagnostic: SOAM from MGLY [kg/timestep] on aerosol
!==============================================================
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_SOAGM(I,J,L,2) = AD07_SOAGM(I,J,L,2) + XUPTK
ENDIF
ENDDO
ENDDO
ENDDO
!=================================================================
! Calculate dry-deposition
!=================================================================
CALL SOA_DEPO( STT(:,:,:,IDTSOAM), DRYSOAM, IDTSOAM )
! Return to calling program
END SUBROUTINE SOAM_LIGGIO_DIFF
!------------------------------------------------------------------------------
SUBROUTINE SOA_CHEMISTRY
!
!******************************************************************************
! Subroutine SOA_CHEMISTRY performs SOA formation. This code is from the
! Caltech group (Hong Liao, Serena Chung, et al) and was modified for
! GEOS-CHEM. (rjp, bmy, 7/8/04, 8/3/06)
!
! Procedure:
! ============================================================================
! (1 ) Read in NO3, O3, OH in CHEM_SOA
! (2 ) Scales these fields using OHNO3TIME in sulfate_mod.f (see GET_OH)
! (3 ) Calculate reaction rates (Serena's OCHEMPARAETER)
! (4 ) CALCULATE DELHC
! (5 ) get T0M gas products
! (6 ) equilibrium calculation
!
! There are total of 42 tracers considered in this routine:
!
! 4 classes of primary carbonaceous aerosols:
! BCPI = Hydrophilic black carbon
! OCPI = Hydrophilic organic carbon
! BCPO = Hydrophobic black carbon
! OCPO = Hydrophobic organic carbon
!
! 6 reactive biogenic hydrocarbon groups (NVOC):
! ALPH = a-pinene, b-pinene, sabinene, carene, terpenoid ketones
! LIMO = limonene
! TERP = a-terpinene, r-terpinene, terpinolene
! ALCO = myrcene, terpenoid alcohols, ocimene
! SESQ = sesquiterpenes
! ISOP = Isoprene
!
! NOTE: TERP and SESQ are not tracers because of their high reactivity
!
! 32 organic oxidation products by O3+OH and NO3:
! 6 ( 3 gases + 3 aerosols ) from each of first four NVOC = 24
! 4 ( 2 gases + 2 aerosols ) from sesquiterpenes oxidation = 4
! 4 ( 2 gases + 2 aerosols ) from isoprene oxidation = 4
!
! NOTE: We aggregate these into 6 tracers according to HC classes
! SOG1 = lump of gas products of first three (ALPH+LIMO+TERP) HC oxidation.
! SOG2 = gas product of ALCO oxidation
! SOG3 = gas product of SESQ oxidation
! SOG4 = gas product of ISOP oxidation
! SOA1 = lump of aerosol products of first 3 (ALPH+LIMO+TERP) HC oxidation.
! SOA2 = aerosol product of ALCO oxidation
! SOA3 = aerosol product of SESQ oxidation
! SOA4 = aerosol product of ISOP oxidation
!
! NOTES:
! (1 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
! (2 ) Now modified for SOG4, SOA4 -- products of oxidation by isoprene.
! (dkh, bmy, 6/1/06)
! (3 ) Now consider SOG condensation onto SO4, NH4, NIT aerosols (if SO4,
! NH4, NIT are defined as tracers). (rjp, bmy, 8/3/06)
!******************************************************************************
!
! References to F90 modules
USE ERROR_MOD, ONLY : DEBUG_MSG
USE DAO_MOD, ONLY : T, AD, AIRVOL, SUNCOS
USE DIAG_MOD, ONLY : AD07_HC
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTALCO, IDTALPH, IDTLIMO, IDTOCPI
USE TRACERID_MOD, ONLY : IDTOCPO, IDTSOA1, IDTSOA2, IDTSOA3
USE TRACERID_MOD, ONLY : IDTSOA4, IDTSOG1, IDTSOG2, IDTSOG3
USE TRACERID_MOD, ONLY : IDTSOG4, IDTSO4, IDTNH4, IDTNIT
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_MONTH
USE TIME_MOD, ONLY : ITS_TIME_FOR_BPCH
USE LOGICAL_MOD, ONLY : LDICARB
# include "CMN_SIZE" ! Size parameters
# include "CMN_O3" ! XNUMOL
# include "CMN_DIAG" ! ND44
! Local variables
LOGICAL, SAVE :: FIRST = .TRUE.
INTEGER :: I, J, L, N
INTEGER :: JHC, IPR
REAL*8 :: RTEMP, VOL, FAC, MPOC
REAL*8 :: MNEW, MSOA_OLD, MPRODUCT, CAIR
REAL*8 :: LOWER, UPPER, TOL, VALUE
REAL*8 :: KO3(MHC), KOH(MHC), KNO3(MHC)
REAL*8 :: ALPHA(NPROD,MHC), KOM(NPROD,MHC)
REAL*8 :: GM0(NPROD,MHC), AM0(NPROD,MHC)
REAL*8 :: ORG_AER(NPROD,MHC), ORG_GAS(NPROD,MHC)
!=================================================================
! SOA_CHEMISTRY begins here!
!=================================================================
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, JHC, IPR, GM0, AM0 )
!$OMP+PRIVATE( VOL, FAC, RTEMP, KO3, KOH, KNO3, CAIR )
!$OMP+PRIVATE( MPRODUCT, MSOA_OLD, VALUE, UPPER, LOWER, MNEW, TOL )
!$OMP+PRIVATE( ORG_AER, ORG_GAS, ALPHA, KOM, MPOC )
DO L = 1, LLTROP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Volume of grid box [m3]
VOL = AIRVOL(I,J,L)
! conversion factor from kg to ug/m3
FAC = 1.D9 / VOL
! air conc. in kg/m3
CAIR = AD(I,J,L) / VOL
! Temperature [K]
RTEMP = T(I,J,L)
! Get SOA yield parameters
CALL SOA_PARA( I, J, L, RTEMP, KO3, KOH, KNO3, ALPHA, KOM )
! Partition mass of gas & aerosol tracers
! according to 5 VOC classes & 3 oxidants
CALL SOA_PARTITION( I, J, L, GM0, AM0 )
! Compute oxidation of hydrocarbons by O3, OH, NO3
CALL CHEM_NVOC( I, J, L, KO3, KOH, KNO3, ALPHA, GM0 )
!==============================================================
! Equilibrium calculation between GAS (SOG) and Aerosol (SOA)
!==============================================================
! Total VOC oxidation products (gas and aerosol) [kg]
MPRODUCT = 0.D0
! Initialize aerosol-only total [kg]
MSOA_OLD = 0.D0
! Compute total VOC and aerosol-only total
DO JHC = 1, MHC
DO IPR = 1, NPROD
MPRODUCT = MPRODUCT + GM0(IPR,JHC) + AM0(IPR,JHC)
MSOA_OLD = MSOA_OLD + AM0(IPR,JHC)
ENDDO
ENDDO
! No need to proceed because there is no
! products that need to be re-equilibrated.
IF ( ( MPRODUCT / AD(I,J,L) ) <= 29.D-18 ) CYCLE
! Individual SOA's; units: [ug/m3]
DO JHC = 1, MHC
DO IPR = 1, NPROD
ORG_GAS(IPR,JHC) = GM0(IPR,JHC) * FAC
ORG_AER(IPR,JHC) = AM0(IPR,JHC) * FAC
ENDDO
ENDDO
IF ( IDTSO4 > 0 .and. IDTNH4 > 0 .and. IDTNIT > 0 ) THEN
!-----------------------------------------------------------
! Condensation of SOG onto seed aerosols (rjp, bmy, 8/3/06)
!
! If SO4, NH4, and NIT are defined tracers in this run
! (i.e. as in full-chemistry simulations), then:
!
! (1) Compute the condensation of SOG on seed aerosols
! including preexisting OC and inorganic aerosols
!
! (2) Use higher ratio (2.1) of molecular weight of
! organic mass per carbon mass accounting for non-carbon
! components attached to OC [Turpin and Lim, 2001]
!
! NOTE...The remaining question is:
!
! Do we have to include other types of aerosols such
! as dust, sea salt, and aerosol water which should be
! available in ISORROPIA?
!
! I think that aerosol water is valuable information for
! this and also AOD computation so at least we need to
! archive it if including it as a tracer is too expensive.
! (Rokjin Park, 8/3/06)
!-----------------------------------------------------------
!-----------------------------------------------------------
! The standard code reversibly-partitions SOA mass onto all
! aqueous aerosols.
! However, if the dicarbonyl SOA formation pathway is included,
! this would lead to an overestimate of SOA mass compare to
! observations during ICARTT. So LDICARB was introduced to
! change to partitioning only onto pre-existing organic aerosols
! when adding the dicarbonyl SOA formation pathway. (tmf, 3/06/09)
!-----------------------------------------------------------
IF ( .not. LDICARB ) THEN
! First compute SOG condensation onto OC aerosol
MPOC = ( STT(I,J,L,IDTOCPI) + STT(I,J,L,IDTOCPO) ) * FAC
MPOC = MPOC * 2.1d0
ENDIF
! Then compute SOG condensation onto SO4, NH4, NIT aerosols
MPOC = MPOC + ( STT(I,J,L,IDTSO4) +
& STT(I,J,L,IDTNH4) +
& STT(I,J,L,IDTNIT) ) * FAC
ELSE
!-----------------------------------------------------------
! If SO4, NIT, and NH3 are all undefined for this run,
! then we will omit SOG condensation onto these aerosols
! (at least for the time being).
!
! We carry carbon mass only in STT array and here multiply
! by the ratio (2.1) of molecular weight of organic mass
! per carbon mass. This ratio accounts for non-carbon
! components attached to OC [Turpin and Lim, 2001].
!
! %%% NOTE: Ideally we should read in offline monthly %%%
! %%% mean concentrations of SO4, NH4, NIT, and then use %%%
! %%% these to compute SOG condensation. Implement this %%%
! %%% later. %%%
! %%% %%%
! %%% For the time being, GEOS-Chem users are STRONGLY %%%
! %%% encouraged to include sulfate aerosol and 2dary %%%
! %%% organic aerosol tracers in offline carbon aerosol %%%
! %%% simulations. Without these extra aerosol tracers, %%%
! %%% the carbon aerosol simulation alone may under- %%%
! %%% estimate SOA formation. %%%
!
! (rjp, bmy, 8/3/06)
!-----------------------------------------------------------
! Compute SOG condensation onto OC aerosol
MPOC = ( STT(I,J,L,IDTOCPI) + STT(I,J,L,IDTOCPO) ) * FAC
MPOC = MPOC * 2.1d0
ENDIF
!==============================================================
! Solve for MNEW by solving for SOA=0
!==============================================================
IF ( ( MPOC / ( CAIR*1.D9 ) ) <= 2.1D-18 ) THEN
VALUE = 0.D0
UPPER = 0.D0
DO JHC = 1, MHC
DO IPR = 1, NPROD
VALUE = VALUE + KOM(IPR,JHC) *
& (ORG_GAS(IPR,JHC) + ORG_AER(IPR,JHC))
UPPER = UPPER + ORG_GAS(IPR,JHC) + ORG_AER(IPR,JHC)
ENDDO
ENDDO
IF ( VALUE <= 1.D0 ) THEN
MNEW = 0.D0
ELSE
LOWER = 1.D-18 * ( CAIR * 1.D9 )
TOL = 1.D-18
MNEW = ZEROIN(LOWER,UPPER,TOL,MPOC,ORG_AER,ORG_GAS,KOM)
ENDIF
ELSE
UPPER = MPOC
DO JHC = 1, MHC
DO IPR = 1, NPROD
UPPER = UPPER + ORG_GAS(IPR,JHC) + ORG_AER(IPR,JHC)
ENDDO
ENDDO
LOWER = MPOC
TOL = 1.D-9*MPOC
MNEW = ZEROIN(LOWER,UPPER,TOL,MPOC,ORG_AER,ORG_GAS,KOM)
ENDIF
!==============================================================
! Equilibrium partitioning into new gas and aerosol
! concentrations for individual contributions of SOA
!==============================================================
IF ( MNEW > 0.D0 ) THEN
DO JHC = 1, MHC
DO IPR = 1, NPROD
ORG_AER(IPR,JHC) = KOM(IPR,JHC)*MNEW /
& (1.D0 + KOM(IPR,JHC) * MNEW ) *
& (ORG_AER(IPR,JHC) + ORG_GAS(IPR,JHC))
IF ( KOM(IPR,JHC).NE.0D0 ) THEN
ORG_GAS(IPR,JHC) = ORG_AER(IPR,JHC) * 1.D8 /
& ( KOM(IPR,JHC) * MNEW * 1.D8 )
ELSE
ORG_GAS(IPR,JHC) = 0.D0
ENDIF
ENDDO
ENDDO
! STORE PRODUCT INTO T0M
DO JHC = 1, MHC
DO IPR = 1, NPROD
GM0(IPR,JHC) = ORG_GAS(IPR,JHC) / FAC
AM0(IPR,JHC) = ORG_AER(IPR,JHC) / FAC
ENDDO
ENDDO
!==============================================================
! Mnew=0.D0, all SOA evaporates to the gas-phase
!==============================================================
ELSE
DO JHC = 1, MHC
DO IPR = 1, NPROD
GM0(IPR,JHC) = GM0(IPR,JHC) + AM0(IPR,JHC)
AM0(IPR,JHC) = 1.D-18 * AD(I,J,L)
ENDDO
ENDDO
ENDIF
! Lump SOA
CALL SOA_LUMP( I, J, L, GM0, AM0 )
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Calculate dry-deposition
!=================================================================
CALL SOA_DEPO( STT(:,:,:,IDTALPH), DRYALPH, IDTALPH )
CALL SOA_DEPO( STT(:,:,:,IDTLIMO), DRYLIMO, IDTLIMO )
CALL SOA_DEPO( STT(:,:,:,IDTALCO), DRYALCO, IDTALCO )
CALL SOA_DEPO( STT(:,:,:,IDTSOG1), DRYSOG1, IDTSOG1 )
CALL SOA_DEPO( STT(:,:,:,IDTSOG2), DRYSOG2, IDTSOG2 )
CALL SOA_DEPO( STT(:,:,:,IDTSOG3), DRYSOG3, IDTSOG3 )
CALL SOA_DEPO( STT(:,:,:,IDTSOG4), DRYSOG4, IDTSOG4 )
CALL SOA_DEPO( STT(:,:,:,IDTSOA1), DRYSOA1, IDTSOA1 )
CALL SOA_DEPO( STT(:,:,:,IDTSOA2), DRYSOA2, IDTSOA2 )
CALL SOA_DEPO( STT(:,:,:,IDTSOA3), DRYSOA3, IDTSOA3 )
CALL SOA_DEPO( STT(:,:,:,IDTSOA4), DRYSOA4, IDTSOA4 )
! Return to calling program
END SUBROUTINE SOA_CHEMISTRY
!------------------------------------------------------------------------------
FUNCTION SOA_EQUIL( MASS, MPOC, AEROSOL, GAS, KOM )
& RESULT( SOA_MASS )
!
!******************************************************************************
! Subroutine SOA_EQUIL solves SOAeqn=0 to determine Mnew (= mass)
! See Eqn (27) on page 70 of notes. Originally written by Serena Chung at
! Caltech, and modified for inclusion into GEOS-CHEM. (rjp, bmy, 7/8/04)
!
! This version does NOT assume that the gas and aerosol phases are in
! equilibrium before chemistry; therefore, gas phase concentrations are
! needed explicitly. The gas and aerosol phases are assumed to be in
! equilibrium after chemistry.
!
! Note: Unlike FUNCTION SOA, this function assumes no reactions. It only
! considers the partitioning of existing products of VOC oxidation.
!
! HC_JHC + OXID_IOXID - >
! alpha(1,IOXID,JHC) [SOAprod_gas(1,IOXID,JHC)+SOAprod(1,IOXID,JHC)]+
! alpha(2,IOXID,JHC) [SOAprod_gas(2,IOXID,JHC)+SOAprod(2,IOXID,JHC)]
!
! SOAprod_gas(IPR,IOXID,JHC) <--> SOAprod(IPR,IOXID,JHC)
! (aerosol phase)
!
! w/ equilibrium partitioning:
!
! SOAprod(IPR,IOXID,JHC)
! SOAprod_gas(IPR,IOXID,JHC) = ------------------------
! Kom(IPR,IOXID,JHC)
!
! Arguments as Input:
! ============================================================================
! (1 ) MASS (REAL*8) : Pre-existing aerosol mass [ug/m3]
! (2 ) MPOC (REAL*8) : POA Mass [ug/m3]
! (3 ) AEROSOL (REAL*8) : Aerosol concentration [ug/m3]
! (4 ) GAS (REAL*8) : Gas-phase concentration [ug/m3]
! (5 ) KOM (REAL*8) : Equilibrium gas-aerosol partition coeff. [m3/ug]
!
! NOTES:
!******************************************************************************
!
! Arguments
REAL*8, INTENT(IN) :: MASS, MPOC
REAL*8, INTENT(IN) :: AEROSOL(NPROD,MHC)
REAL*8, INTENT(IN) :: GAS(NPROD,MHC)
REAL*8, INTENT(IN) :: KOM(NPROD,MHC)
! Local variables
INTEGER :: JHC, IPR
REAL*8 :: VALUE, SOA_MASS
!=================================================================
! SOA_EQUIL begins here!
!=================================================================
! Equation (39) on page 139 of notes:
VALUE = 0.D0
!
DO JHC = 1, MHC
DO IPR = 1, NPROD
VALUE = VALUE + KOM(IPR,JHC) /
& ( 1.D0 + KOM(IPR,JHC) * MASS ) *
& ( GAS(IPR,JHC) + AEROSOL(IPR,JHC) )
ENDDO
ENDDO
! Compute SOA mass
SOA_MASS = VALUE + ( 1.D5 * MPOC ) / ( 1.D5 * MASS ) - 1.0D0
! Return to calling program
END FUNCTION SOA_EQUIL
!------------------------------------------------------------------------------
FUNCTION ZEROIN(AX,BX,TOL,MPOC,AEROSOL,GAS,KOM) RESULT( MNEW )
!
!******************************************************************************
! NOTE: This function may be problematic -- it uses GOTO's, which are not
! good for parallelization. (bmy, 7/8/04)
!
! shc I got this code from http://www.netlib.org
!
! a zero of the function f(x) is computed in the interval ax,bx .
!
! input..
!
! ax left endpoint of initial interval
! bx right endpoint of initial interval
! f function subprogram which evaluates f(x) for any x in
! the interval ax,bx
! tol desired length of the interval of uncertainty of the
! final result ( .ge. 0.0d0)
!
!
! output..
!
! zeroin abcissa approximating a zero of f in the interval ax,bx
!
!
! it is assumed that f(ax) and f(bx) have opposite signs
! without a check. zeroin returns a zero x in the given interval
! ax,bx to within a tolerance 4*macheps*abs(x) + tol, where macheps
! is the relative machine precision.
! this function subprogram is a slightly modified translation of
! the algol 60 procedure zero given in richard brent, algorithms for
! minimization without derivatives, prentice - hall, inc. (1973).
!
! NOTES:
! (1 ) Change dabs to ABS and dsign to SIGN, in order to avoid conflicts
! with intrinsic function names on the PGI compiler. (bmy, 12/2/04)
!******************************************************************************
!
real*8, intent(in) :: ax,bx,tol
REAL*8, INTENT(IN) :: Mpoc
REAL*8, INTENT(IN) :: Aerosol(NPROD,MHC), Gas(NPROD,MHC)
REAL*8, INTENT(IN) :: Kom(NPROD,MHC)
!local variables
real*8 :: MNEW
real*8 :: a,b,c,d,e,eps,fa,fb,fc,tol1,xm,p,q,r,s
c
c compute eps, the relative machine precision
c
eps = 1.0d0
10 eps = eps/2.0d0
tol1 = 1.0d0 + eps
if (tol1 .gt. 1.0d0) go to 10
c
c initialization
c
a = ax
b = bx
fa = SOA_equil( A, MPOC, Aerosol, GAS, Kom )
fb = SOA_equil( B, MPOC, Aerosol, GAS, Kom )
c
c begin step
c
20 c = a
fc = fa
d = b - a
e = d
30 if (ABS(fc) .ge. ABS(fb)) go to 40
a = b
b = c
c = a
fa = fb
fb = fc
fc = fa
c
c convergence test
c
40 tol1 = 2.0d0*eps*ABS(b) + 0.5d0*tol
xm = 0.5D0*(c - b)
if (ABS(xm) .le. tol1) go to 90
if (fb .eq. 0.0d0) go to 90
c
c is bisection necessary
c
if (ABS(e) .lt. tol1) go to 70
if (ABS(fa) .le. ABS(fb)) go to 70
c
c is quadratic interpolation possible
c
if (a .ne. c) go to 50
c
c linear interpolation
c
s = fb/fa
p = 2.0d0*xm*s
q = 1.0d0 - s
go to 60
c
c inverse quadratic interpolation
c
50 q = fa/fc
r = fb/fc
s = fb/fa
p = s*(2.0d0*xm*q*(q - r) - (b - a)*(r - 1.0d0))
q = (q - 1.0d0)*(r - 1.0d0)*(s - 1.0d0)
c
c adjust signs
c
60 if (p .gt. 0.0d0) q = -q
p = ABS(p)
c
c is interpolation acceptable
c
if ((2.0d0*p) .ge. (3.0d0*xm*q - ABS(tol1*q))) go to 70
if (p .ge. ABS(0.5d0*e*q)) go to 70
e = d
d = p/q
go to 80
c
c bisection
c
70 d = xm
e = d
c
c complete step
c
80 a = b
fa = fb
if (ABS(d) .gt. tol1) b = b + d
if (ABS(d) .le. tol1) b = b + SIGN(tol1, xm)
fb = SOA_equil( B, MPOC, Aerosol, GAS, Kom )
if ((fb*(fc/ABS(fc))) .gt. 0.0d0) go to 20
go to 30
c
c done
c
90 MNEW = b
! Return to calling program
END FUNCTION ZEROIN
!------------------------------------------------------------------------------
FUNCTION RTBIS( X1, X2, XACC,
& MPOC, AEROSOL, GAS, KOM ) RESULT( ROOT )
!
!******************************************************************************
! Function RTBIS finds the root of the function SOA_EQUIL via the bisection
! method. Original algorithm from "Numerical Recipes" by Press et al,
! Cambridge UP, 1986. Modified for inclusion into GEOS-CHEM. (bmy, 7/8/04)
!
! Arguments as Input:
! ============================================================================
! (1 ) X1 (REAL*8) : Endpoint #1
! (2 ) X2 (REAL*8) : Endpoint #2
! (3 ) XACC (REAL*8) : Desired accuracy of solution
! (4 ) MPOC (REAL*8) : POA Mass [ug/m3]
! (5 ) AEROSOL (REAL*8) : Aerosol concentration [ug/m3]
! (6 ) GAS (REAL*8) : Gas-phase concentration [ug/m3]
! (7 ) KOM (REAL*8) : Equilibrium gas-aerosol partition coeff. [m3/ug]
!
! NOTES:
!******************************************************************************
!
! References to F90 modules
USE ERROR_MOD, ONLY : ERROR_STOP
! Arguments
REAL*8, INTENT(IN) :: X1, X2, XACC, MPOC
REAL*8, INTENT(IN) :: AEROSOL(NPROD,MHC)
REAL*8, INTENT(IN) :: GAS(NPROD,MHC)
REAL*8, INTENT(IN) :: KOM(NPROD,MHC)
! Local variables
INTEGER, PARAMETER :: JMAX = 100
INTEGER :: J
REAL*8 :: ROOT, DX, F, FMID, XMID
!=================================================================
! RTBIS begins here!
!=================================================================
! Compute value of function SOA_EQUIL at endpoints
FMID = SOA_EQUIL( X2, MPOC, AEROSOL, GAS, KOM )
F = SOA_EQUIL( X1, MPOC, AEROSOL, GAS, KOM )
! Test if we are bracketing a root
IF ( F * FMID >= 0d0 ) THEN
CALL ERROR_STOP( 'Root must be bracketed!',
& 'RTBIS ("carbon_mod.f")' )
ENDIF
! Set initial root and interval
IF ( F < 0d0 ) THEN
ROOT = X1
DX = X2 - X1
ELSE
ROOT = X2
DX = X1 - X2
ENDIF
! Loop until max iteration count
DO J = 1, JMAX
! Halve the existing interval
DX = DX * 0.5D0
! Compute midpoint of new interval
XMID = ROOT + DX
! Compute value of function SOA_EQUIL at new midpoint
FMID = SOA_EQUIL( XMID, MPOC, AEROSOL, GAS, KOM )
! We have found the root!
IF ( FMID <= 0D0 ) ROOT = XMID
! We have reached the tolerance, so return
IF ( ABS( DX ) < XACC .OR. FMID == 0.D0 ) RETURN
ENDDO
! Stop with error condition
CALL ERROR_STOP( 'Too many bisections!',
& 'RTBIS ("carbon_mod.f")' )
! Return to calling program
END FUNCTION RTBIS
!------------------------------------------------------------------------------
SUBROUTINE SOA_PARA( II, JJ, LL, TEMP,
& KO3, KOH, KNO3, RALPHA, KOM )
!
!******************************************************************************
! Subroutine SOA_PARA gves mass-based stoichiometric coefficients for semi-
! volatile products from the oxidation of hydrocarbons. It calculates
! secondary organic aerosol yield parameters. Temperature effects are
! included. Original code from the CALTECH group and modified for inclusion
! to GEOS-CHEM. (rjp, bmy, 7/8/04, 6/30/08)
!
! Arguments as Input:
! ============================================================================
! (1 ) II (INTEGER) : GEOS-Chem longitude index
! (2 ) JJ (INTEGER) : GEOS-Chem latitude index
! (3 ) LL (INTEGER) : GEOS-Chem altitude index
! (4 ) TEMP (REAL*8 ) : Temperature [k]
!
! Arguments as Output:
! ============================================================================
! (5 ) KO3 (REAL*8 ) : Rxn rate for HC oxidation by O3 [cm3/molec/s]
! (6 ) KOH (REAL*8 ) : Rxn rate for HC oxidation by OH [cm3/molec/s]
! (7 ) KNO3 (REAL*8 ) : Rxn rate for HC oxidation by NO3 [cm3/molec/s]
! (8 ) RALPHA (REAL*8 ) : Mass-based stoichiometric coefficients [unitless]
! (9 ) KOM (REAL*8 ) : Equilibrium gas-aerosol partition coeff [m3/ug]
!
! References:
! ============================================================================
! PHOTO-OXIDATION RATE CONSTANTS OF ORGANICS come from:
! (1 ) Atkinson, el al., Int. J. Chem.Kinet., 27: 941-955 (1995)
! (2 ) Shu and Atkinson, JGR 100: 7275-7281 (1995)
! (3 ) Atkinson, J. Phys. Chem. Ref. Data 26: 215-290 (1997)
! (4 ) Some are reproduced in Table 1 of Griffin, et al., JGR 104: 3555-3567
! (5 ) Chung and Seinfeld (2002)
!
! ACTIVATION ENERGIES come from:
! (6 ) Atkinson, R. (1994) Gas-Phase Tropospheric Chemistry of Organic
! Compounds. J. Phys. Chem. Ref. Data, Monograph No.2, 1-216.
! (7 ) They are also reproduced in Tables B.9 and B.10 of Seinfeld and
! Pandis (1988).
!
! PARAMETERS FOR ISOPRENE:
! (8 ) Kroll et al., GRL, 109, L18808 (2005)
! (9 ) Kroll et al., Environ Sci Tech, in press (2006)
! (10) Henze and Seinfeld, GRL, submitted (2006)
!
! NOTES:
! (1 ) Now use temporary variables TMP1, TMP2, TMP3 to pre-store the values
! of exponential terms outside of DO-loops (bmy, 7/8/04)
! (2 ) Add parameters for isoprene. Now include grid cell location in
! subroutine arguments. Define a reference temperature at 295.
! Now use ITS_IN_THE_TROP to determine if we are in a tropospheric
! grid box. Now pass II, JJ, LL via the argument list.
! (dkh, bmy, 5/22/06)
! (3 ) Corrected confusing documentation. (clh, bmy, 6/30/08)
!******************************************************************************
!
! References to F90 modules
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_TROP
! Arguments
INTEGER, INTENT(IN) :: II, JJ, LL
REAL*8, INTENT(IN) :: TEMP
REAL*8, INTENT(OUT) :: KO3(MHC), KOH(MHC), KNO3(MHC)
REAL*8, INTENT(OUT) :: RALPHA(NPROD,MHC), KOM(NPROD,MHC)
! Local variables
INTEGER :: IPR, JHC, J
REAL*8 :: TMP1, TMP2, TMP3, OVER
! Activation Energy/R [K] for O3, OH, NO3 (see Refs #6-7)
REAL*8, PARAMETER :: ACT_O3 = 732.0d0
REAL*8, PARAMETER :: ACT_OH = -400.0d0
REAL*8, PARAMETER :: ACT_NO3 = -490.0d0
! Heat of vaporization (from CRC Handbook of Chemistry & Physics)
REAL*8, PARAMETER :: HEAT_VAPOR = 5.d3
! Reciprocal reference temperatures at 298K and 310K
REAL*8, PARAMETER :: REF295 = 1d0 / 295d0
REAL*8, PARAMETER :: REF298 = 1d0 / 298d0
REAL*8, PARAMETER :: REF310 = 1d0 / 310d0
!=================================================================
! SOA_PARA begins here!
!=================================================================
! Photo-oxidation rates of O3 [cm3/molec/s] (See Refs #1-4)
KO3(1) = 56.15d-18
KO3(2) = 200.d-18
KO3(3) = 7707.d-18
KO3(4) = 422.5d-18
KO3(5) = ( 11600.D0 + 11700.D0 ) / 2.D0 * 1.D-18
! Photo-oxidation rates of OH [cm3/molec/s] (See Refs #1-4)
KOH(1) = 84.4d-12
KOH(2) = 171.d-12
KOH(3) = 255.d-12
KOH(4) = 199.d-12
KOH(5) = ( 197.d0 + 293.d0 ) / 2.d0 * 1.d-12
! Photo-oxidation rate of NO3 [cm3/molec/s] (See Refs #1-4)
KNO3(1) = 6.95d-12
KNO3(2) = 12.2d-12
KNO3(3) = 88.7d-12
KNO3(4) = 14.7d-12
KNO3(5) = ( 19.d0 + 35.d0 ) / 2.d0 * 1.d-12
!=================================================================
! Temperature Adjustments of KO3, KOH, KNO3
!=================================================================
! Reciprocal temperature [1/K]
OVER = 1.0d0 / TEMP
! Compute the exponentials once outside the DO loop
TMP1 = EXP( ACT_O3 * ( REF298 - OVER ) )
TMP2 = EXP( ACT_OH * ( REF298 - OVER ) )
TMP3 = EXP( ACT_NO3 * ( REF298 - OVER ) )
! Multiply photo-oxidation rates by exponential of temperature
DO JHC = 1, MHC
KO3(JHC) = KO3(JHC) * TMP1
KOH(JHC) = KOH(JHC) * TMP2
KNO3(JHC) = KNO3(JHC) * TMP3
ENDDO
! If we are in the troposphere, then calculate ISOP oxidation rates
! If we are in the stratosphere, set ISOP oxidation rates to zero
! (dkh, bmy, 5/22/06)
IF ( ITS_IN_THE_TROP( II, JJ, LL ) ) THEN
KO3(6) = 1.05d-14 * EXP(-2000.d0 / TEMP )
KOH(6) = 2.70d-11 * EXP( 390.d0 / TEMP )
KNO3(6) = 3.03d-12 * EXP(-446.d0 / TEMP )
ELSE
KO3(6) = 0d0
KOH(6) = 0d0
KNO3(6) = 0d0
ENDIF
!=================================================================
! SOA YIELD PARAMETERS
!
! Aerosol yield parameters for photooxidation of biogenic organics
! The data (except for C7-C10 n-carbonyls, aromatics, and higher
! ketones are from:
!
! (7) Tables 1 and 2 of Griffin, et al., Geophys. Res. Lett.
! 26: (17)2721-2724 (1999)
!
! These parameters neglect contributions of the photooxidation
! by NO3.
!
! For the aromatics, the data are from
! (8) Odum, et al., Science 276: 96-99 (1997).
!
! Isoprene (dkh, bmy, 5/22/06)
! Unlike the other species, we consider oxidation by purely OH.
! CHEM_NVOC has been adjusted accordingly. There's probably
! significant SOA formed from NO3 oxidation, but we don't know
! enough to include that yet. Data for the high NOX and low NOX
! parameters are given in Kroll 05 and Kroll 06, respectively.
! The paramters for low NOX are given in Table 1 of Henze 06.
!=================================================================
! Average of ALPHA-PINENE, BETA-PINENE, SABINENE, D3-CARENE
RALPHA(1,1) = 0.067d0
RALPHA(2,1) = 0.35425d0
! LIMONENE
RALPHA(1,2) = 0.239d0
RALPHA(2,2) = 0.363d0
! Average of TERPINENES and TERPINOLENE
RALPHA(1,3) = 0.0685d0
RALPHA(2,3) = 0.2005d0
! Average of MYRCENE, LINALOOL, TERPINENE-4-OL, OCIMENE
RALPHA(1,4) = 0.06675d0
RALPHA(2,4) = 0.135d0
! Average of BETA-CARYOPHYLLENE and and ALPHA-HUMULENE
RALPHA(1,5) = 1.0d0
RALPHA(2,5) = 0.0d0
! Using BETA-PINENE for all species for NO3 oxidation
! Data from Table 4 of Griffin, et al., JGR 104 (D3): 3555-3567 (1999)
RALPHA(3,:) = 1.d0
! Here we define some alphas for isoprene (dkh, bmy, 5/22/06)
! high NOX [Kroll et al, 2005]
!RALPHA(1,6) = 0.264d0
!RALPHA(2,6) = 0.0173d0
!RALPHA(3,6) = 0d0
! low NOX [Kroll et al, 2006; Henze and Seinfeld, 2006]
RALPHA(1,6) = 0.232d0
RALPHA(2,6) = 0.0288d0
RALPHA(3,6) = 0d0
!=================================================================
! Equilibrium gas-particle partition coefficients of
! semi-volatile compounds [ug-1 m**3]
!=================================================================
! Average of ALPHA-PINENE, BETA-PINENE, SABINENE, D3-CARENE
KOM(1,1) = 0.1835d0
KOM(2,1) = 0.004275d0
! LIMONENE
KOM(1,2) = 0.055d0
KOM(2,2) = 0.0053d0
! Average of TERPINENES and TERPINOLENE
KOM(1,3) = 0.133d0
KOM(2,3) = 0.0035d0
! Average of MYRCENE, LINALOOL, TERPINENE-4-OL, OCIMENE
KOM(1,4) = 0.22375d0
KOM(2,4) = 0.0082d0
! Average of BETA-CARYOPHYLLENE and and ALPHA-HUMULENE
KOM(1,5) = ( 0.04160d0 + 0.0501d0 ) / 2.d0
KOM(2,5) = 0.0d0
! NOT APPLICABLE -- using BETA-PINENE for all species
! Data from Table 4 of Griffin, et al., JGR 104 (D3): 3555-3567 (1999)
KOM(3,:) = 0.0163d0
! Again, for isoprene we only consider two products,
! both from OH oxidation. (dkh, bmy, 5/22/06)
! High NOX
!KOM(1,6) = 0.00115d0
!KOM(2,6) = 1.52d0
!KOM(3,6) = 0d0
! Low NOX
KOM(1,6) = 0.00862d0
KOM(2,6) = 1.62d0
KOM(3,6) = 0d0
!=================================================================
! Temperature Adjustments of KOM
!=================================================================
! Reciprocal temperature [1/K]
OVER = 1.0D0 / TEMP
! Divide TEMP by 310K outside the DO loop
TMP1 = ( TEMP / 310.D0 )
! Compute the heat-of-vaporization exponential term outside the DO loop
TMP2 = EXP( HEAT_VAPOR * ( OVER - REF310 ) )
! Multiply KOM by the temperature and heat-of-vaporization terms
DO JHC = 1, 5
DO IPR = 1, 3
KOM(IPR,JHC) = KOM(IPR,JHC) * TMP1 * TMP2
ENDDO
ENDDO
!--------------------------------------------------------
! For isoprene products, reference temperature is 295 K.
! (dkh, bmy, 5/22/06)
!--------------------------------------------------------
! Divide TEMP by 295K outside the DO loop
TMP1 = ( TEMP / 295.D0 )
! Compute the heat-of-vaporization exponential term outside the DO loop
TMP2 = EXP( HEAT_VAPOR * ( OVER - REF295 ) )
! Multiply KOM by the temperature and heat-of-vaporization terms
JHC = 6
DO IPR = 1, 3
KOM(IPR,JHC) = KOM(IPR,JHC) * TMP1 * TMP2
ENDDO
! Return to calling program
END SUBROUTINE SOA_PARA
!------------------------------------------------------------------------------
SUBROUTINE CHEM_NVOC( I, J, L, KO3, KOH, KNO3, ALPHA, GM0 )
!
!******************************************************************************
! Subroutine CHEM_NVOC computes the oxidation of Hydrocarbon by O3, OH, and
! NO3. This comes from the Caltech group (Hong Liao, Serena Chung, et al)
! and was incorporated into GEOS-CHEM. (rjp, bmy, 7/6/04, 6/1/06)
!
! Arguments as Input:
! ============================================================================
! (1 ) I (INTEGER) : GEOS-Chem longitude index
! (2 ) J (INTEGER) : GEOS-Chem latitude index
! (3 ) L (INTEGER) : GEOS-Chem altitude index
! (4 ) KO3 (REAL*8 ) : Rxn rate for HC oxidation by O3 [cm3/molec/s]
! (5 ) KOH (REAL*8 ) : Rxn rate for HC oxidation by OH [cm3/molec/s]
! (6 ) KNO3 (REAL*8 ) : Rxn rate for HC oxidation by NO3 [cm3/molec/s]
! (7 ) ALPHA (REAL*8 ) : Mass-based stoichiometric coefficients [unitless]
!
! Arguments as Output:
! ============================================================================
! (8 ) GM0 (REAL*8 ) : Gas mass for each HC and its oxidation product [kg]
!
! NOTES:
! (1 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
! (2 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (3 ) Updated for SOA from isoprene. Now calls GET_DOH. (dkh, bmy, 6/1/06)
!******************************************************************************
!
! References to F90 kmodules
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTALCO, IDTALPH, IDTLIMO
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_MONTH
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: I, J, L
REAL*8, INTENT(IN) :: KO3(MHC), KOH(MHC), KNO3(MHC)
REAL*8, INTENT(IN) :: ALPHA(NPROD,MHC)
REAL*8, INTENT(INOUT) :: GM0(NPROD,MHC)
! Local variables
INTEGER :: JHC, IPR
REAL*8 :: DELHC(NPROD), CHANGE(MHC), NMVOC(MHC)
REAL*8 :: OHMC, TTNO3, TTO3, DTCHEM, RK
REAL*8 :: OVER, DO3, DOH, DNO3
!=================================================================
! CHEM_NVOC begins here!
!=================================================================
! Chemistry timestep [s]
DTCHEM = GET_TS_CHEM() * 60d0
! Get offline OH, NO3, O3 concentrations [molec/cm3]
OHMC = GET_OH( I, J, L )
TTNO3 = GET_NO3( I, J, L )
TTO3 = GET_O3( I, J, L )
! 6 classes NVOC concentrations followed by 4 primary species
NMVOC(1) = STT(I,J,L,IDTALPH)
NMVOC(2) = STT(I,J,L,IDTLIMO)
NMVOC(3) = ORVC_TERP(I,J,L)
NMVOC(4) = STT(I,J,L,IDTALCO)
NMVOC(5) = ORVC_SESQ(I,J,L)
! Initialize DELHC so that the values from the previous
! time step are not carried over.
DELHC(:) = 0.D0
!=================================================================
! Change in NVOC concentration due to photooxidation [kg]
!=================================================================
DO JHC = 1, MHC
IF ( JHC <= 5 ) THEN
!-------------------------------
! Individual gas-phase products
!-------------------------------
RK = KO3(JHC)*TTO3 + KOH(JHC)*OHMC
& + KNO3(JHC)*TTNO3
CHANGE(JHC) = NMVOC(JHC) * ( 1.D0 - DEXP( -RK * DTCHEM ) )
! In case that the biogenic hydrocarbon is the limiting reactant
IF ( CHANGE(JHC) >= NMVOC(JHC) ) CHANGE(JHC) = NMVOC(JHC)
! NMVOC concentration after oxidation reactions
NMVOC(JHC) = NMVOC(JHC) - CHANGE(JHC)
IF( CHANGE(JHC) > 1.D-16 ) THEN
OVER = 1.D0 / RK
DO3 = CHANGE(JHC) * KO3(JHC) * TTO3 * OVER ![kg]
DOH = CHANGE(JHC) * KOH(JHC) * OHMC * OVER ![kg]
DNO3 = CHANGE(JHC) * KNO3(JHC) * TTNO3 * OVER ![kg]
ELSE
DO3 = 0.D0
DOH = 0.D0
DNO3 = 0.D0
ENDIF
! VOC change by photooxidation of O3 and OH [kg]
DELHC(1) = DO3 + DOH
DELHC(2) = DO3 + DOH
! VOC change by photooxidation of NO3 [kg]
DELHC(3) = DNO3
! Lump OH and O3 oxidation for HC 1-5
DO IPR = 1, NPROD
GM0(IPR,JHC) = GM0(IPR,JHC) + ALPHA(IPR,JHC) * DELHC(IPR)
ENDDO
ELSE
!-------------------------------
! SOA from ISOPRENE
!-------------------------------
! Get ISOP lost to rxn with OH [kg]
DOH = GET_DOH( I, J, L )
! Consider only OH oxidation for isoprene. Also convert
! from mass of carbon to mass of isoprene. (dkh, bmy, 5/22/06)
DO IPR = 1, 3
GM0(IPR,JHC) = GM0(IPR,JHC) + ALPHA(IPR,JHC) * DOH
& * 68d0 / 60d0
ENDDO
ENDIF
ENDDO
!=================================================================
! Store Hydrocarbon remaining after oxidation rxn back into STT
!=================================================================
STT(I,J,L,IDTALPH) = MAX( NMVOC(1), 1.D-32 )
STT(I,J,L,IDTLIMO) = MAX( NMVOC(2), 1.D-32 )
ORVC_TERP(I,J,L) = MAX( NMVOC(3), 1.D-32 )
STT(I,J,L,IDTALCO) = MAX( NMVOC(4), 1.D-32 )
ORVC_SESQ(I,J,L) = MAX( NMVOC(5), 1.D-32 )
! Return to calling program
END SUBROUTINE CHEM_NVOC
!------------------------------------------------------------------------------
SUBROUTINE SOA_PARTITION( I, J, L, GM0, AM0 )
!
!******************************************************************************
! Subroutine SOA_PARTITION partitions the mass of gas and aerosol
! tracers according to five Hydrocarbon species and three oxidants.
! (rjp, bmy, 7/7/04, 5/22/06)
!
! NOTE: GPROD and APROD are mass ratios of individual oxidation
! products of gas/aerosol to the sum of all.
!
! Arguments as Input:
! ============================================================================
! (1 ) I (INTEGER) : GEOS-CHEM longitude index
! (2 ) J (INTEGER) : GEOS-CHEM latitude index
! (3 ) L (INTEGER) : GEOS-CHEM altitude index
!
! Arguments as Output:
! ============================================================================
! (4 ) GM0 (REAL*8 ) : Gas mass for each HC and its oxidation product [kg]
! (5 ) AM0 (REAL*8 ) : Aerosol mass for each HC and its oxidation product [kg]
!
! NOTES:
! (1 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
! (2 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (3 ) Updated for SOG4, SOA4 (bmy, 5/22/06)
!******************************************************************************
!
! Refrences to F90 modules
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTSOA1, IDTSOA2, IDTSOA3, IDTSOA4
USE TRACERID_MOD, ONLY : IDTSOG1, IDTSOG2, IDTSOG3, IDTSOG4
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: I, J, L
REAL*8, INTENT(OUT) :: GM0(NPROD,MHC), AM0(NPROD,MHC)
! Local variables
INTEGER :: JHC, IPR
!=================================================================
! SOA_PARTITION begins here!
!=================================================================
! Initialize
DO JHC = 1, 3
DO IPR = 1, NPROD
GM0(IPR,JHC) = 0D0
AM0(IPR,JHC) = 0D0
ENDDO
ENDDO
! Partition the lump of first three HC (ALPH + LIMO + TERP)
! oxidation products. These are grouped together because they
! have the same molecular weight.
DO JHC = 1, 3
DO IPR = 1, NPROD
GM0(IPR,JHC) = STT(I,J,L,IDTSOG1) * GPROD(I,J,L,IPR,JHC)
AM0(IPR,JHC) = STT(I,J,L,IDTSOA1) * APROD(I,J,L,IPR,JHC)
ENDDO
ENDDO
! Alcohol
JHC = 4
DO IPR = 1, NPROD
GM0(IPR,JHC) = STT(I,J,L,IDTSOG2) * GPROD(I,J,L,IPR,JHC)
AM0(IPR,JHC) = STT(I,J,L,IDTSOA2) * APROD(I,J,L,IPR,JHC)
ENDDO
! Sesqterpene
JHC = 5
DO IPR = 1, NPROD
GM0(IPR,JHC) = STT(I,J,L,IDTSOG3) * GPROD(I,J,L,IPR,JHC)
AM0(IPR,JHC) = STT(I,J,L,IDTSOA3) * APROD(I,J,L,IPR,JHC)
ENDDO
! Isoprene
JHC = 6
DO IPR = 1, NPROD
GM0(IPR,JHC) = STT(I,J,L,IDTSOG4) * GPROD(I,J,L,IPR,JHC)
AM0(IPR,JHC) = STT(I,J,L,IDTSOA4) * APROD(I,J,L,IPR,JHC)
ENDDO
! Return to calling program
END SUBROUTINE SOA_PARTITION
!------------------------------------------------------------------------------
SUBROUTINE SOA_LUMP( I, J, L, GM0, AM0 )
!
!******************************************************************************
! Subroutine SOA_LUMP returns the organic gas and aerosol back to the
! STT array. (rjp, bmy, 7/7/04, 2/6/07)
!
! Arguments as Input:
! ============================================================================
! (1 ) I (INTEGER) : Longitude index
! (2 ) J (INTEGER) : Latitude index
! (3 ) L (INTEGER) : Altitude index
! (4 ) GM0 (REAL*8 ) : Gas mass for each HC and its oxidation product [kg]
! (5 ) AM0 (REAL*8 ) : Aerosol mass for each HC and its oxidation product [kg]
!
! NOTES:
! (1 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
! (2 ) Bug fix: make sure L <= LD07 before saving into AD07 array, or else
! we will get an out-of-bounds error. (bmy, 3/4/05)
! (3 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (4 ) Updated for SOG4, SOA4 (dkh, bmy, 5/22/06)
! (5 ) Typo fix: GPROD should be APROD in a couple places (tmf, bmy, 10/16/06)
! (6 ) Bug fix: For SOA4, GPROD and APROD should have default values of 0.5,
! instead of 1.0 (dkh, bmy, 2/6/07)
!******************************************************************************
!
! References to F90 modules
USE DIAG_MOD, ONLY : AD07_HC
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTSOA1, IDTSOA2, IDTSOA3, IDTSOA4
USE TRACERID_MOD, ONLY : IDTSOG1, IDTSOG2, IDTSOG3, IDTSOG4
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! ND44, ND07, LD07
! Arguments
INTEGER, INTENT(IN) :: I, J, L
REAL*8, INTENT(IN) :: GM0(NPROD,MHC), AM0(NPROD,MHC)
! Local variables
INTEGER :: JHC, IPR
REAL*8 :: GASMASS, AERMASS
!=================================================================
! SOA_LUMP begins here!
!=================================================================
! Initialize
GASMASS = 0D0
AERMASS = 0D0
! Compute total gas & aerosol mass
DO JHC = 1, 3
DO IPR = 1, NPROD
GASMASS = GASMASS + GM0(IPR,JHC)
AERMASS = AERMASS + AM0(IPR,JHC)
ENDDO
ENDDO
!----------------------------
! SOA1 net Production (kg)
!----------------------------
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_HC(I,J,L,1) = AD07_HC(I,J,L,1)
& + ( AERMASS - STT(I,J,L,IDTSOA1) )
ENDIF
STT(I,J,L,IDTSOG1) = MAX( GASMASS, 1.D-32 )
STT(I,J,L,IDTSOA1) = MAX( AERMASS, 1.D-32 )
IF ( STT(I,J,L,IDTSOG1) > 1.0E-6 ) THEN
DO JHC = 1, 3
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = GM0(IPR,JHC) / STT(I,J,L,IDTSOG1)
ENDDO
ENDDO
ELSE
DO JHC = 1, 3
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC)= 0.111111111d0
ENDDO
ENDDO
ENDIF
IF ( STT(I,J,L,IDTSOA1) > 1.0E-6 ) THEN
DO JHC = 1, 3
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = AM0(IPR,JHC) / STT(I,J,L,IDTSOA1)
ENDDO
ENDDO
ELSE
DO JHC = 1, 3
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = 0.111111111d0
ENDDO
ENDDO
ENDIF
!=================================================================
! Lump of products of fourth Hydrocarbon class (ALCOHOL)
!=================================================================
JHC = 4
GASMASS = 0D0
AERMASS = 0D0
DO IPR = 1, NPROD
GASMASS = GASMASS + GM0(IPR,JHC)
AERMASS = AERMASS + AM0(IPR,JHC)
ENDDO
!---------------------------
! SOA2 net Production (kg)
!---------------------------
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_HC(I,J,L,2) = AD07_HC(I,J,L,2)
& + ( AERMASS - STT(I,J,L,IDTSOA2) )
ENDIF
STT(I,J,L,IDTSOG2) = MAX(GASMASS, 1.D-32)
STT(I,J,L,IDTSOA2) = MAX(AERMASS, 1.D-32)
IF ( STT(I,J,L,IDTSOG2) > 1.0E-6 ) THEN
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = GM0(IPR,JHC) / STT(I,J,L,IDTSOG2)
ENDDO
ELSE
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = 0.333333333d0
ENDDO
ENDIF
IF ( STT(I,J,L,IDTSOA2) > 1.0E-6 ) THEN
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = AM0(IPR,JHC) / STT(I,J,L,IDTSOA2)
ENDDO
ELSE
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = 0.333333333d0
ENDDO
ENDIF
!=================================================================
! Lump of products of fifth Hydrocarbon class (SESQTERPINE)
!=================================================================
JHC = 5
GASMASS = 0D0
AERMASS = 0D0
DO IPR = 1, NPROD
GASMASS = GASMASS + GM0(IPR,JHC)
AERMASS = AERMASS + AM0(IPR,JHC)
ENDDO
!---------------------------
! SOA3 net Production (kg)
!---------------------------
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_HC(I,J,L,3) = AD07_HC(I,J,L,3)
& + ( AERMASS - STT(I,J,L,IDTSOA3) )
ENDIF
STT(I,J,L,IDTSOG3) = MAX(GASMASS, 1.D-32)
STT(I,J,L,IDTSOA3) = MAX(AERMASS, 1.D-32)
IF ( STT(I,J,L,IDTSOG3) > 1.0E-6 ) THEN
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = GM0(IPR,JHC) / STT(I,J,L,IDTSOG3)
ENDDO
ELSE
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = 0.5D0
ENDDO
ENDIF
IF ( STT(I,J,L,IDTSOA3) > 1.0E-6 ) THEN
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = AM0(IPR,JHC) / STT(I,J,L,IDTSOA3)
ENDDO
ELSE
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = 0.5D0
ENDDO
ENDIF
! make sure there is no second oxidation product
! for SESQTERPENE by OH + O3
GPROD(I,J,L,2,JHC) = 0.D0
APROD(I,J,L,2,JHC) = 0.D0
!=================================================================
! Lump of products of sixth Hydrocarbon class (ISOP)
! (dkh, bmy, 5/22/06)
!=================================================================
JHC = 6
GASMASS = 0D0
AERMASS = 0D0
DO IPR = 1, NPROD
GASMASS = GASMASS + GM0(IPR,JHC)
AERMASS = AERMASS + AM0(IPR,JHC)
ENDDO
!---------------------------
! SOA4 net Production (kg)
!---------------------------
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_HC(I,J,L,4) = AD07_HC(I,J,L,4)
& + ( AERMASS - STT(I,J,L,IDTSOA4) )
ENDIF
STT(I,J,L,IDTSOG4) = MAX( GASMASS, 1.D-32 )
STT(I,J,L,IDTSOA4) = MAX( AERMASS, 1.D-32 )
IF ( STT(I,J,L,IDTSOG4) > 1.0E-6 ) THEN
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = GM0(IPR,JHC) / STT(I,J,L,IDTSOG4)
ENDDO
ELSE
DO IPR = 1, NPROD
GPROD(I,J,L,IPR,JHC) = 0.5d0 ! only one product
ENDDO
ENDIF
IF ( STT(I,J,L,IDTSOA4) > 1.0E-6 ) THEN
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = AM0(IPR,JHC) / STT(I,J,L,IDTSOA4)
ENDDO
ELSE
DO IPR = 1, NPROD
APROD(I,J,L,IPR,JHC) = 0.5d0
ENDDO
ENDIF
! Return to calling program
END SUBROUTINE SOA_LUMP
!------------------------------------------------------------------------------
SUBROUTINE SOA_DEPO( TC, DEPID, TRID )
!
!******************************************************************************
! Subroutine SOA_DEPO computes dry-deposition of a particular SOA species.
! (rjp, bmy, 7/8/04, 10/25/05)
!
! Arguments as Input:
! ============================================================================
! (1 ) TC (REAL*8 ) : Array of SOA tracer
! (2 ) DEPID (INTEGER) : Dry deposition ID # (from DEPVEL)
! (3 ) TRID (INTEGER) : GEOS-CHEM tracer number
!
! NOTES:
! (1 ) Remove reference to CMN, it's obsolete (bmy, 7/20/04)
! (2 ) Replace PBLFRAC from "drydep_mod.f" with GET_FRAC_UNDER_PBLTOP from
! "pbl_mix_mod.f" (bmy, 2/17/05)
! (3 ) Bug fix: Add BL_FRAC to the PRIVATE list (mak, bmy, 10/3/05)
! (4 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
!******************************************************************************
!
! References to F90 modules
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 TIME_MOD, ONLY : GET_TS_CHEM
USE TRACER_MOD, ONLY : XNUMOL
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! ND44
! Arguments
REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR)
INTEGER, INTENT(IN) :: DEPID, TRID
! Local variable
INTEGER :: I, J, L
REAL*8 :: DTCHEM, FLUX, BL_FRAC
REAL*8 :: TC0, CNEW, FREQ, AREA_CM2
REAL*8 :: ND44_TMP(IIPAR,JJPAR,LLPAR)
!=================================================================
! SOA_DEPO begins here!
!=================================================================
! Return if tracer ID or tracer ID is undefined
IF ( TRID == 0 .OR. DEPID == 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
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, TC0, BL_FRAC, FREQ, CNEW, AREA_CM2, FLUX )
!$OMP+SCHEDULE( DYNAMIC )
DO L = 1, LLPAR
DO J = 1, JJPAR
DO I = 1, IIPAR
! Initial SOA [kg]
TC0 = TC(I,J,L)
! 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
! Drydep frequency [1/s]
FREQ = DEPSAV(I,J,DEPID) * BL_FRAC
! Amount of SOA[G] left after drydep [kg]
CNEW = TC0 * EXP( -FREQ * DTCHEM )
!===========================================================
! 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 - CNEW )
FLUX = FLUX * XNUMOL(TRID) / ( 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
CNEW = TC0
ENDIF
! Prevent underflow condition
IF ( CNEW < SMALLNUM ) CNEW = 0d0
! Store modified concentration back in tracer array [kg]
TC(I,J,L) = CNEW
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,DEPID,1) = AD44(I,J,DEPID,1) + ND44_TMP(I,J,L)
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
! Return to calling program
END SUBROUTINE SOA_DEPO
!------------------------------------------------------------------------------
SUBROUTINE EMISSCARBON
!
!******************************************************************************
! Subroutine EMISSCARBON is the interface between the GEOS-CHEM model
! and the CARBONACEOUS AEROSOL emissions (rjp, bmy, 1/24/02, 9/25/06)
!
! NOTES:
! (1 ) Now references LSOA from "CMN_SETUP". Also now call OHNO3TIME since
! biogenic emissions also have a diurnal variation. (rjp, bmy, 7/15/04)
! (2 ) Now references LSOA and LPRT from "logical_mod.f". Now references
! STT from "tracer_mod.f" (bmy, 7/20/04)
! (3 ) Bug fix: removed "," from FORMAT 111. Also added extra DEBUG_MSG
! output after calling emissions routines. (bmy, 11/19/04)
! (4 ) Now always call ANTHRO_CARB_TBOND and ANTHRO_CARB_COOKE. This will
! read the T. Bond et al [2004] emissions but overwrite the North
! America region with monthly-mean emissions from Cooke et al [1999]
! with imposed seasonality from R. Park [2003]. (bmy, 12/1/04)
! (5 ) Now remove THISMONTH from the arg list to BIOMASS_CARB_GEOS
! (bmy, 9/25/06)
! (6 ) Now check that GFED2 has been updated if we do not use the annual
! Bond Biomass emission (phs, yc, 12/18/08)
! (7 ) adj_group: Now add scaling factors for adjoint (dkh, 11/10/09)
! (8 ) Now reads monthly (eml, phs, 5/18/09)
!******************************************************************************
!
! References to F90 modules
USE DIAG_MOD, ONLY : AD07
USE DAO_MOD, ONLY : PBL
USE ERROR_MOD, ONLY : DEBUG_MSG
USE LOGICAL_MOD, ONLY : LSOA, LPRT, LCOOKE, LRCP
USE TIME_MOD, ONLY : GET_MONTH, ITS_A_NEW_MONTH
USE TIME_MOD, ONLY : GET_TS_EMIS
USE TRACER_MOD, ONLY : STT
USE GFED2_BIOMASS_MOD, ONLY : GFED2_IS_NEW
USE GFED3_BIOMASS_MOD, ONLY : GFED3_IS_NEW
USE TRACERID_MOD, ONLY : IDTBCPO, IDTOCPO
USE HTAP_MOD, ONLY : GET_HTAP
USE GRID_MOD, ONLY : GET_AREA_CM2
! adj_group: add for emissions scale factors
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF
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 : IS_CARB_EMS_ADJ
USE ADJ_ARRAYS_MOD, ONLY : MMSCL
USE ERROR_MOD, ONLY : ERROR_STOP
USE LOGICAL_ADJ_MOD, ONLY : LADJ_EMS
USE LOGICAL_MOD, ONLY : LHTAP, LBIOFUEL
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! ND07
! Local variables
LOGICAL, SAVE :: FIRST = .TRUE.
LOGICAL :: MOLEC_CM2_S
INTEGER :: I, J, MONTH, N, THISMONTH
REAL*8 :: BCSRC(IIPAR,JJPAR,2)
REAL*8 :: OCSRC(IIPAR,JJPAR,2)
REAL*8 :: BC(IIPAR,JJPAR), OC(IIPAR,JJPAR)
REAL*8 :: STEPS_PER_MON, AREA_CM2
REAL*8 :: FAC
! Hydrophilic fraction of BLACK CARBON (aka ELEMENTAL CARBON)
REAL*8, PARAMETER :: FHB = 0.2d0
! Hydrophilic fraction of ORGANIC CARBON
REAL*8, PARAMETER :: FHO = 0.5d0
!=================================================================
! EMISSCARBON begins here!
!
! Read carbonaceous aerosols from disk and compute hydrophilic
! and hydrophobic fractions. NOTE, CARBON AEROSOLS HAVE TO BE
! ORDERED AS Hydrophilic(BC[1], OC[2]) Hydrophobic(BC[3], OC[4]).
!=================================================================
!--------------------------
! Read time-invariant data
!--------------------------
IF ( FIRST ) THEN
! Echo info
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
WRITE( 6, 100 )
! Echo info about ANTHRO emissionls
WRITE( 6, 110 )
IF ( LCOOKE ) WRITE( 6, 111 )
WRITE( 6, 112 )
WRITE( 6, 113 )
! Monthly or annual BIOMASS emissions?
IF ( USE_BOND_BIOBURN ) THEN
WRITE( 6, 120 )
ELSE
WRITE( 6, 130 )
ENDIF
IF ( LHTAP ) WRITE( 6, 140 )
! Write spacer
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
! FORMAT strings
100 FORMAT( 'C A R B O N A E R O S O L E M I S S I O N S' )
110 FORMAT( 'w/ ANTHROPOGENIC emissions from Bond et al [2007]' )
111 FORMAT( 'w/ North American emissions from Cooke et al [1999]')
112 FORMAT( 'w/ North American emissions having imposed' )
113 FORMAT( ' seasonality following Park et al [2003]' )
120 FORMAT( 'w/ BIOMASS emissions from Bond et al [2004]' )
130 FORMAT( 'w/ BIOMASS emissions from GEOS-CHEM inventory' )
140 FORMAT( 'w/ Emissions from HTAP V2 inventory' )
! Initialize arrays
CALL INIT_CARBON
!----------------------
! prior to 5/18/09 - now reads monthly data below (phs)
! ! Read annual mean anthro emissions from T. Bond [2004]
! CALL ANTHRO_CARB_TBOND
! IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a A_CRB_TBOND' )
!---------------------
! Read annual mean biomass emissions if necessary
IF ( USE_BOND_BIOBURN ) THEN
CALL BIOMASS_CARB_TBOND
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a B_CRB_TBOND' )
ENDIF
! Reset flag
FIRST = .FALSE.
ENDIF
! Compute time scaling arrays which are used both for
! biogenic emission and offline OH (rjp, bmy, 7/15/04)
IF ( LSOA ) THEN
CALL OHNO3TIME
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: after OHNO3TIME' )
ENDIF
!------------------------------
! Read monthly-mean ANTHRO data
!------------------------------
IF ( ITS_A_NEW_MONTH() ) THEN
! Current month
MONTH = GET_MONTH()
! Read in monthly emissions from T Bond [2007], with imposed
! seasonality over North America by R. Park [2003]
IF ( .not. LRCP ) THEN
CALL ANTHRO_CARB_TBOND( MONTH )
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a A_CRB_TBOND' )
ENDIF
! Read in RCP emissions.
! Seasonality included for ships, but none included or imposed
! for land-based anthropogenic emissions
IF ( LRCP ) THEN
CALL ANTHRO_CARB_RCP( MONTH )
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a A_CRB_RCP' )
ENDIF
IF ( LCOOKE ) THEN
! Overwrite the T. Bond [2004] emissions over North America
! with monthly mean anthro emissions from Cooke et al [1999]
! having imposed seasonality by R. Park [2003]
CALL ANTHRO_CARB_COOKE( MONTH )
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a A_CRB_COOKE' )
ENDIF
!-----------------------------------
! Prior to 12/18/08
! ! Read monthly mean biomass emissions
! IF ( .not. USE_BOND_BIOBURN ) THEN
! CALL BIOMASS_CARB_GEOS
! IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a B_CRB_COOKE' )
! ENDIF
!-----------------------------------
IF ( LHTAP ) THEN
THISMONTH = GET_MONTH()
! STEPS_PER_MON = ( ( 1440 * NDAYS ( THISMONTH ) )
! & / GET_TS_EMIS() )
FAC = GET_TS_EMIS() * 60d0 * 1d-4
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, AREA_CM2 )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Surface area [cm2]
AREA_CM2 = GET_AREA_CM2( J )
! Get HTAP BC [kg/m2/s]
BC(I,J) = GET_HTAP( I, J, IDTBCPO ) * FAC * AREA_CM2
! Hydrophilic BLACK CARBON from anthropogenics [kg C/timestep]
ANTH_BLKC(I,J,1) = FHB * BC(I,J)
! Hydrophobic BLACK CARBON from anthropogenics [kg C/timestep]
ANTH_BLKC(I,J,2) = ( 1.d0 - FHB ) * BC(I,J)
! Get HTAP OC [kg/m2/s]
OC(I,J) = GET_HTAP( I, J, IDTOCPO ) * FAC * AREA_CM2
! Hydrophilic ORGANIC CARBON from anthropogenics [kg C/timestep]
ANTH_ORGC(I,J,1) = FHO * OC(I,J)
! Hydrophobic ORGANIC CARBON from anthropogenics [kgC/timestep]
ANTH_ORGC(I,J,2) = ( 1.d0 - FHO ) * OC(I,J)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
ENDIF
!-----------------------------------
! Read monthly/8-day/3-hr mean biomass emissions
!-----------------------------------
IF ( .not. USE_BOND_BIOBURN ) THEN
IF ( GFED2_IS_NEW() .or. GFED3_IS_NEW() .or.
& ITS_A_NEW_MONTH() ) THEN
CALL BIOMASS_CARB_GEOS
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: a BB_CRB_GEOS' )
ENDIF
ENDIF
!--------------------------
! Compute biogenic OC
!--------------------------
CALL BIOGENIC_OC
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSCARB: after BIOGENIC_OC' )
!=================================================================
! Sum up BC and OC sources.
! N=1 is HYDROPHILIC; N=2 is HYDROPHOBIC.
!
! COMMENT: Maybe someday we'll want to play with the different
! emission height for different source type. For example the
! carbon from biomass burning could be emitted to the higher
! altitude due to the thermal bouyancy and shallow convection.
! The current setting to use EMITHIGH seems rather inefficient
! but robust for sensitivity studies for emission height
! variation on carbon concentrations, so please keep using the
! current setup until we decide otherwise. (rjp, 4/2/02)
!=================================================================
! Set biofuel emissions to zero if they are turned off
IF ( .not. LBIOFUEL ) THEN
BIOF_BLKC = 0d0
BIOF_ORGC = 0d0
ENDIF
! adj_group: make a version that applies scaling factors
! and use this if the emissions adjoint ID #'s are active
IF ( LADJ_EMS .and. IS_CARB_EMS_ADJ ) THEN
IF ( MMSCL /= 1 ) CALL ERROR_STOP('MMSCL /= 1','carbon_mod.f')
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
! 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)
! Total HYDROPHOBIC BC source [kg]
BCSRC(I,J,2)= ANTH_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_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)
IF ( LSOA ) THEN
CALL ERROR_STOP('LSOA not supported for adj',
& 'carbon_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
! 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)
ENDIF
! 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)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ELSE
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Total HYDROPHILIC BC source [kg]
BCSRC(I,J,1) = ANTH_BLKC(I,J,1) +
& BIOF_BLKC(I,J,1) +
& BIOB_BLKC(I,J,1)
! Total HYDROPHOBIC BC source [kg]
BCSRC(I,J,2) = ANTH_BLKC(I,J,2) +
& BIOF_BLKC(I,J,2) +
& BIOB_BLKC(I,J,2)
IF ( LSOA ) THEN
! 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
! Total HYDROPHILIC OC source [kg]
! (Use archived TERP_ORGC for if LSOA=F)
OCSRC(I,J,1) = ANTH_ORGC(I,J,1) +
& BIOF_ORGC(I,J,1) +
& BIOB_ORGC(I,J,1) +
& TERP_ORGC(I,J)
ENDIF
! Total HYDROPHOBIC OC source [kg]
OCSRC(I,J,2) = ANTH_ORGC(I,J,2) +
& BIOF_ORGC(I,J,2) +
& BIOB_ORGC(I,J,2)
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF ! EMS_ADJ
! Sum up all carbon tracers throughout the boundary layer
CALL EMITHIGH( BCSRC, OCSRC )
IF ( LPRT ) CALL DEBUG_MSG( '### EMISCARB: after EMITHIGH' )
!=================================================================
! ND07 diagnostic: Carbon aerosol emissions [kg/timestep]
!=================================================================
! adj_group: include scaling factors if they are activated
IF ( ND07 > 0 .and. IS_CARB_EMS_ADJ ) THEN
IF ( MMSCL /= 1 ) CALL ERROR_STOP('MMSCL /= 1','carbon_mod.f')
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Anthropogenic BC source
AD07(I,J,1) = AD07(I,J,1)
& + ANTH_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_an)
& + ANTH_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_an)
! Biogenic BC source
AD07(I,J,2) = AD07(I,J,2) +
& + BIOB_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_bb)
& + BIOB_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_bb)
! Biofuel BC source
AD07(I,J,3) = AD07(I,J,3) +
& + BIOF_BLKC(I,J,1) * EMS_SF(I,J,1,IDADJ_EBCPI_bf)
& + BIOF_BLKC(I,J,2) * EMS_SF(I,J,1,IDADJ_EBCPO_bf)
! Anthropogenic OC source
AD07(I,J,4) = AD07(I,J,4) +
& + ANTH_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_an)
& + ANTH_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_an)
! Biomass OC source
AD07(I,J,5) = AD07(I,J,5) +
& + BIOB_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_bb)
& + BIOB_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_bb)
! Biofuel OC source
AD07(I,J,6) = AD07(I,J,6) +
& + BIOF_ORGC(I,J,1) * EMS_SF(I,J,1,IDADJ_EOCPI_bf)
& + BIOF_ORGC(I,J,2) * EMS_SF(I,J,1,IDADJ_EOCPO_bf)
! Terpene source
AD07(I,J,7) = AD07(I,J,7) + TERP_ORGC(I,J)
IF ( LSOA ) THEN
CALL ERROR_STOP('LSOA not supported for adj',
& 'carbon_mod.f')
! ! ALPHA-PINENE
! AD07(I,J,8) = AD07(I,J,8) + BIOG_ALPH(I,J)
!
! ! LIMONENE
! AD07(I,J,9) = AD07(I,J,9) + BIOG_LIMO(I,J)
!
! ! TERPENE
! AD07(I,J,10) = AD07(I,J,10) + BIOG_TERP(I,J)
!
! ! ALCOHOL
! AD07(I,J,11) = AD07(I,J,11) + BIOG_ALCO(I,J)
!
! ! SESQTERPENE
! AD07(I,J,12) = AD07(I,J,12) + BIOG_SESQ(I,J)
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### EMISCARB: after ND07' )
ELSEIF ( ND07 > 0 ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Anthropogenic BC source
AD07(I,J,1) = AD07(I,J,1) +
& ( ANTH_BLKC(I,J,1) + ANTH_BLKC(I,J,2) )
! Biogenic BC source
AD07(I,J,2) = AD07(I,J,2) +
& ( BIOB_BLKC(I,J,1) + BIOB_BLKC(I,J,2) )
! Biofuel BC source
AD07(I,J,3) = AD07(I,J,3) +
& ( BIOF_BLKC(I,J,1) + BIOF_BLKC(I,J,2) )
! Anthropogenic OC source
AD07(I,J,4) = AD07(I,J,4) +
& ( ANTH_ORGC(I,J,1) + ANTH_ORGC(I,J,2) )
! Biomass OC source
AD07(I,J,5) = AD07(I,J,5) +
& ( BIOB_ORGC(I,J,1) + BIOB_ORGC(I,J,2) )
! Biofuel OC source
AD07(I,J,6) = AD07(I,J,6) +
& ( BIOF_ORGC(I,J,1) + BIOF_ORGC(I,J,2) )
! Terpene source
AD07(I,J,7) = AD07(I,J,7) + TERP_ORGC(I,J)
IF ( LSOA ) THEN
! ALPHA-PINENE
AD07(I,J,8) = AD07(I,J,8) + BIOG_ALPH(I,J)
! LIMONENE
AD07(I,J,9) = AD07(I,J,9) + BIOG_LIMO(I,J)
! TERPENE
AD07(I,J,10) = AD07(I,J,10) + BIOG_TERP(I,J)
! ALCOHOL
AD07(I,J,11) = AD07(I,J,11) + BIOG_ALCO(I,J)
! SESQTERPENE
AD07(I,J,12) = AD07(I,J,12) + BIOG_SESQ(I,J)
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
!### Debug
IF ( LPRT ) CALL DEBUG_MSG( '### EMISCARB: after ND07' )
ENDIF
! Return to calling program
END SUBROUTINE EMISSCARBON
!------------------------------------------------------------------------------
SUBROUTINE BIOGENIC_OC
!
!******************************************************************************
! Subroutine BIOGENIC_OC emits secondary organic carbon aerosols.
! Also modified for SOA tracers. (rjp, bmy, 4/1/04, 1/24/08)
!
! Terpene emissions as a source of OC: TERP.GEIA90.a1.2x2.5.*
! Assuming 10% yield of OC(hydrophilic) from terpene emission.
!
! NOTES:
! (1 ) Now separate computation for FULLCHEM and OFFLINE runs (bmy, 7/8/04)
! (2 ) Now references DATA_DIR from "directory_mod.f". Now references LSOA
! from "logical_mod.f". (bmy, 7/20/04)
! (3 ) Now reads data from "carbon_200411" subdir of DATA_DIR (bmy, 11/15/04)
! (4 ) Now can use MEGAN biogenic emissions (tmf, bmy, 10/20/05)
! (5 ) For GCAP, need to use GET_NAME_EXT_2D in NVOC file name (bmy, 4/11/06)
! (6 ) Bug fix: add MEGAN emissions to TERP_ORGC when SOA emissions are
! turned on (dkh, bmy, 1/24/08)
! (7 ) Change LMEGAN switch to LMEGANMONO switch (ccc, 3/2/09)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE DAO_MOD, ONLY : SUNCOS
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE LOGICAL_MOD, ONLY : LMEGANMONO, LSOA
USE MEGAN_MOD, ONLY : GET_EMMONOT_MEGAN
USE TIME_MOD, ONLY : GET_MONTH, GET_TS_CHEM
USE TIME_MOD, ONLY : GET_TS_EMIS, ITS_A_NEW_MONTH
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
! Local variables
LOGICAL, SAVE :: FIRST = .TRUE.
INTEGER :: I, J, IJLOOP, THISMONTH
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: CONVERT(NVEGTYPE)
REAL*8 :: GMONOT(NVEGTYPE)
REAL*8 :: FD2D(IIPAR,JJPAR)
REAL*8 :: TMMP, EMMO, VALUE
REAL*8 :: XTAU, STEPS_PER_MON
REAL*8, PARAMETER :: FC1 = 136.2364D0 / 120.11D0
REAL*8, PARAMETER :: FC2 = 154.2516D0 / 120.11D0
REAL*8, PARAMETER :: FC3 = 204.3546D0 / 180.165D0
REAL*8, PARAMETER :: FC4 = 152.D0 / 120.11D0
CHARACTER(LEN=255) :: FILENAME
! Fraction of yield of OC (hydrophilic) from terpene emission
REAL*8, PARAMETER :: FBIOG = 1.0d-1
! External functions
REAL*8, EXTERNAL :: XLTMMP
REAL*8, EXTERNAL :: EMMONOT
!=================================================================
! BIOGENIC_OC begins here!
!=================================================================
! Get ISOPRENE baseline emissions (first-time only)
IF ( FIRST ) THEN
CALL RDISOPT( CONVERT )
CALL RDMONOT( GMONOT )
CALL SETBASE( CONVERT, GMONOT )
! Resety first-time flag
FIRST = .FALSE.
ENDIF
!=================================================================
! If secondary organic aerosols are turned off ...
! Compute biogenic organic carbon as 0.1 * MONOTERPENES
!=================================================================
IF ( .not. LSOA ) THEN
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, IJLOOP, TMMP, EMMO )
DO J = 1, JJPAR
DO I = 1, IIPAR
! 1-D loop index
IJLOOP = ( (J-1) * IIPAR ) + I
! Surface temperature [K]
TMMP = XLTMMP(I,J,IJLOOP)
! Get monoterpenes from MEGAN or GEIA [kg C/box]
IF ( LMEGANMONO ) THEN
EMMO = GET_EMMONOT_MEGAN( I, J, TMMP, 1d0 )
ELSE
EMMO = EMMONOT( IJLOOP, TMMP, 1d0 )
ENDIF
! Fraction of EMMO that converts into OC [kg/box/timestep]
TERP_ORGC(I,J) = EMMO * FBIOG
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! If secondary organic aerosols are turned on ...
! Then use CALTECH algorithm
!=================================================================
ELSE
! Current month
THISMONTH = GET_MONTH()
! Number of emission timesteps per month
STEPS_PER_MON = ( ( 1440 * NDAYS(THISMONTH) ) / GET_TS_EMIS() )
!-----------------------------------------
! Read data from disk if it's a new month
!-----------------------------------------
IF ( ITS_A_NEW_MONTH() ) THEN
! Get TAU0 value to index the punch file
XTAU = GET_TAU0( THISMONTH, 1, 1990 )
! Filename for carbon aerosol from fossil fuel use
FILENAME = TRIM( DATA_DIR ) //
& 'carbon_200411/NVOC.' // GET_NAME_EXT_2D() //
& '.' // GET_RES_EXT()
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - BIOGENIC_OC: Reading ', a )
! Read NVOC emission in kg/month
CALL READ_BPCH2( FILENAME, 'NVOCSRCE', 35,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), GEIA_ORVC )
! from kgC/month to kgC/timestep
GEIA_ORVC(:,:) = GEIA_ORVC(:,:) / STEPS_PER_MON
ENDIF
!------------------------------
! Get TERP_ORGC and DIUR_ORVC
!------------------------------
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, IJLOOP, TMMP, EMMO )
DO J = 1, JJPAR
DO I = 1, IIPAR
! 1-D loop index
IJLOOP = ( (J-1) * IIPAR ) + I
! Surface temperature [K]
TMMP = XLTMMP(I,J,IJLOOP)
! Monoterpene emission [kg C/box/timestep]
IF ( LMEGANMONO ) THEN
TERP_ORGC(I,J) = GET_EMMONOT_MEGAN( I, J, TMMP, 1d0 )
ELSE
TERP_ORGC(I,J) = EMMONOT( IJLOOP, TMMP, 1d0 )
ENDIF
!---------------------------------------------------
! Impose a diurnal variation on NVOC during the day
!---------------------------------------------------
IF ( SUNCOS(IJLOOP) > 0d0 .and. TCOSZ(I,J) > 0d0 ) THEN
DIUR_ORVC(I,J) = GEIA_ORVC(I,J)*
& ( SUNCOS(IJLOOP) / TCOSZ(I,J) ) *
& ( 1440d0 / GET_TS_CHEM() )
! Make sure ORVC is not negative
DIUR_ORVC(I,J) = MAX( DIUR_ORVC(I,J), 0d0 )
ELSE
! At night, ORVC goes to zero
DIUR_ORVC(I,J) = 0d0
ENDIF
!===========================================================
! For SOA (Hong Liao, 02/13/04)
!
! The input emission data files have units of
! [kg C/box/timestep]
!
! The variable scale is used to convert to the relevant
! units as follows:
! (1) Convert from kg C/step to kg compound/step
! (2) Multiply by the fraction of monoterpenes that
! contributes to the particular species of interest.
!
! The fraction of monoterpenes is from Table 4 of Griffin
! et al., Geophys. Res. Lett. 26 (17): 2721-2724 (1999)
!===========================================================
! ALPHA-PINENE (0.35)
! BETA-PINENE lumped with ALPHA-PINENE (0.23)
! SABINENE lumped with ALPHA-PINENE (0.05)
! D3-CARENE lumped with ALPHA-PINENE (0.04)
BIOG_ALPH(I,J) = TERP_ORGC(I,J) * FC1 * 0.67D0
! TERPENOID KETONE is lumped with SABINENE
! Then SABINENE is lumped with ALPHA-PINENE
BIOG_ALPH(I,J) = BIOG_ALPH(I,J)
& + ( DIUR_ORVC(I,J) * FC4 * 0.04D0 ) !using campher
! LIMONENE
BIOG_LIMO(I,J) = TERP_ORGC(I,J) * FC1 * 0.23D0
! TERPINENE is lumped with TERPINOLENE
BIOG_TERP(I,J) = TERP_ORGC(I,J) * FC1 * 0.03D0
! MYRCENE is lumped with TERPENOID ALCOHOL (0.05)
! OCIMENE lumped with TERPENOID ALCOHOL (0.02)
BIOG_ALCO(I,J) = TERP_ORGC(I,J) * FC1 * 0.07D0
! Other reactive volatile organic carbon emissions
BIOG_ALCO(I,J) = BIOG_ALCO(I,J)
& + ( DIUR_ORVC(I,J) * FC2 * 0.09D0 ) !using LINALOOL
! We do not transport SESQ (C15H24)
! because its chemical lifetime is short (reactive)
BIOG_SESQ(I,J) = DIUR_ORVC(I,J) * FC3 * 0.05D0
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
! Return to calling program
END SUBROUTINE BIOGENIC_OC
!------------------------------------------------------------------------------
! v8-02-01, now use v8-02-02 version
!
! SUBROUTINE ANTHRO_CARB_TBOND
!!
!!******************************************************************************
!! Subroutine ANTHRO_CARB_TBOND computes annual mean anthropogenic and
!! biofuel emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC
!! CARBON. It also separates these into HYDROPHILIC and HYDROPHOBIC
!! fractions. (rjp, bmy, 4/2/04, 5/30/06)
!!
!! Emissions data comes from the Bond et al [2004] inventory and has units
!! of [kg C/yr]. This will be converted to [kg C/timestep] below.
!!
!! We also assume that 20% of BC and 50% of OC from anthropogenic
!! emissions are hydrophilic (soluble) and the rest are hydrophobic.
!!
!! NOTES:
!! (1 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
!! (2 ) Now read data from "carbon_200411" subdir of DATA_DIR (bmy, 11/15/04)
!! (3 ) Now can read data for both GEOS and GCAP grids (bmy, 8/16/05)
!! (4 ) Now compute future emissions of BC,OC if necessary. (swu, bmy, 5/30/06)
!!******************************************************************************
!!
! ! References to F90 modules
! USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
! USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
! USE DIRECTORY_MOD, ONLY : DATA_DIR
! USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCbf
! USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCff
! USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCbf
! USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCff
! USE LOGICAL_MOD, ONLY : LFUTURE
! USE TIME_MOD, ONLY : GET_TS_EMIS
! USE TRANSFER_MOD, ONLY : TRANSFER_2D
!
!# include "CMN_SIZE" ! Size parameters
!
! ! Local variables
! INTEGER :: I, J
! REAL*4 :: ARRAY(IGLOB,JGLOB,1)
! REAL*8 :: XTAU, STEPS_PER_YR, FUT_SCL
! REAL*8 :: FD2D(IIPAR,JJPAR)
! CHARACTER(LEN=255) :: FILENAME
!
! ! Hydrophilic fraction of BLACK CARBON (aka ELEMENTAL CARBON)
! REAL*8, PARAMETER :: FHB = 0.2d0
!
! ! Hydrophilic fraction of ORGANIC CARBON
! REAL*8, PARAMETER :: FHO = 0.5d0
!
! !=================================================================
! ! ANTHRO_CARB_TBOND begins here!
! !=================================================================
!
! ! Number of emission timesteps per year
! STEPS_PER_YR = ( ( 1440 * 365 ) / GET_TS_EMIS() )
!
! ! Get TAU0 value to index the punch file
! XTAU = GET_TAU0( 1, 1, 2001 )
!
! !=================================================================
! ! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from
! ! anthropogenic sources as tracer #34 in [kg C/year].
! ! Then convert to [kg C/timestep] and store in ANTH_BLKC.
! !=================================================================
!
! ! Filename for carbon aerosol from fossil fuel use
! FILENAME = TRIM( DATA_DIR ) //
! & 'carbon_200411/BCOC_TBond_fossil.' //
! & GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
!
! ! Echo info
! WRITE( 6, 100 ) TRIM( FILENAME )
! 100 FORMAT( ' - ANTHRO_CARB_TBOND: Reading ', a )
!
! ! Read BLCK emission
! CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 34,
! & XTAU, IGLOB, JGLOB,
! & 1, ARRAY, QUIET=.TRUE. )
!
! ! Cast to REAL*8 and resize
! CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, FUT_SCL )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! ! Hydrophilic BLACK CARBON from anthropogenics [kg C/timestep]
! ANTH_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_YR
!
! ! Hydrophobic BLACK CARBON from anthropogenics [kg C/timestep]
! ANTH_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_YR
!
! ! Compute future emissions of BLACK CARBON (if necessary)
! IF ( LFUTURE ) THEN
! FUT_SCL = GET_FUTURE_SCALE_BCff( I, J )
! ANTH_BLKC(I,J,1) = ANTH_BLKC(I,J,1) * FUT_SCL
! ANTH_BLKC(I,J,2) = ANTH_BLKC(I,J,2) * FUT_SCL
! ENDIF
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! !=================================================================
! ! Read ORGANIC CARBON from anthropogenic sources as tracer #35
! ! in [kg C/year]. Then Convert to [kg C/timestep] and store in
! ! ANTH_ORGC.
! !=================================================================
! CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 35,
! & XTAU, IGLOB, JGLOB,
! & 1, ARRAY, QUIET=.TRUE. )
!
! ! Cast to REAL*8 and resize
! CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, FUT_SCL )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! ! Hydrophilic ORGANIC CARBON from anthropogenics [kg C/timestep]
! ANTH_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_YR
!
! ! Hydrophobic ORGANIC CARBON from anthropogenics [kgC/timestep]
! ANTH_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_YR
!
! ! Compute future emissions of ORGANIC CARBON (if necessary)
! IF ( LFUTURE ) THEN
! FUT_SCL = GET_FUTURE_SCALE_OCff( I, J )
! ANTH_ORGC(I,J,1) = ANTH_ORGC(I,J,1) * FUT_SCL
! ANTH_ORGC(I,J,2) = ANTH_ORGC(I,J,2) * FUT_SCL
! ENDIF
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! !=================================================================
! ! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from biofuel
! ! combustion as tracer #34 in [kg C/year]. Then convert to
! ! [kg C/timestep] and store in BIOF_BLKC.
! !=================================================================
!
! ! Filename
! FILENAME = TRIM( DATA_DIR ) //
! & 'carbon_200411/BCOC_TBond_biofuel.' //
! & GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
!
!
! ! Echo info
! WRITE( 6, 100 ) TRIM( FILENAME )
!
! ! Read data
! CALL READ_BPCH2( FILENAME, 'BIOFSRCE', 34,
! & XTAU, IGLOB, JGLOB,
! & 1, ARRAY, QUIET=.TRUE. )
!
! ! Cast to REAL*8 and resize
! CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J, FUT_SCL )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! ! Hydrophilic BLACK CARBON from biofuels [kg C /timestep]
! BIOF_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_YR
!
! ! Hydrophobic BLACK CARBON from biofuels [kg C/timestep]
! BIOF_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_YR
!
! ! Compute future emissions of BLACK CARBON (if necessary)
! IF ( LFUTURE ) THEN
! FUT_SCL = GET_FUTURE_SCALE_BCbf( I, J )
! BIOF_BLKC(I,J,1) = BIOF_BLKC(I,J,1) * FUT_SCL
! BIOF_BLKC(I,J,2) = BIOF_BLKC(I,J,2) * FUT_SCL
! ENDIF
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! !=================================================================
! ! Read ORGANIC CARBON from biofuel combustion as tracer #35 in
! ! [kg C/year]. Convert to [kg C/timestep] and store in BIOF_BLKC.
! !=================================================================
!
! CALL READ_BPCH2( FILENAME, 'BIOFSRCE', 35,
! & XTAU, IGLOB, JGLOB,
! & 1, ARRAY, QUIET=.TRUE. )
!
! ! Cast to REAL*8 and resize
! CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!
!!$OMP PARALLEL DO
!!$OMP+DEFAULT( SHARED )
!!$OMP+PRIVATE( I, J )
! DO J = 1, JJPAR
! DO I = 1, IIPAR
!
! ! Hydrophilic ORGANIC CARBON from biofuels [kg C/timestep]
! BIOF_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_YR
!
! ! Hydrophobic ORGANIC CARBON from biofuels [kg C/timestep]
! BIOF_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_YR
!
! ! Compute future emissions of BLACK CARBON (if necessary)
! IF ( LFUTURE ) THEN
! FUT_SCL = GET_FUTURE_SCALE_OCbf( I, J )
! BIOF_ORGC(I,J,1) = BIOF_ORGC(I,J,1) * FUT_SCL
! BIOF_ORGC(I,J,2) = BIOF_ORGC(I,J,2) * FUT_SCL
! ENDIF
! ENDDO
! ENDDO
!!$OMP END PARALLEL DO
!
! ! Return to calling program
! END SUBROUTINE ANTHRO_CARB_TBOND
!
!!------------------------------------------------------------------------------
SUBROUTINE ANTHRO_CARB_TBOND( THISMONTH )
!
!******************************************************************************
! Subroutine ANTHRO_CARB_TBOND reads monthly mean anthropogenic and biofuel
! emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC CARBON.
! It also separates these into HYDROPHILIC and HYDROPHOBIC fractions.
! (eml 4/17/09, rjp, bmy, 4/2/04, 5/30/06)
!
! Emissions data comes from Bond et al [GBC, 2007] inventory and has units
! of [kg C/yr], which is converted to [kg C/timestep] below. Seasonality is
! applied over the US as in Park [2003].
!
!-----------------------------------
! Prior to 12/18/08
! ! OLD:
! ! Subroutine ANTHRO_CARB_TBOND computes annual mean anthropogenic and
! ! biofuel emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC
! ! CARBON. It also separates these into HYDROPHILIC and HYDROPHOBIC
! ! fractions. (rjp, bmy, 4/2/04, 5/30/06)
! !
! ! Emissions data comes from the Bond et al [2004] inventory and has units
! ! of [kg C/yr]. This will be converted to [kg C/timestep] below.
! !
!----------------------------------
! We also assume that 20% of BC and 50% of OC from anthropogenic
! emissions are hydrophilic (soluble) and the rest are hydrophobic.
!
! NOTES:
! (1 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
! (2 ) Now read data from "carbon_200411" subdir of DATA_DIR (bmy, 11/15/04)
! (3 ) Now can read data for both GEOS and GCAP grids (bmy, 8/16/05)
! (4 ) Now compute future emissions of BC,OC if necessary. (swu, bmy, 5/30/06)
! (5 ) Now reads in monthly data from Bond et al [2007] (eml, 4/17/09)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCbf
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCff
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCbf
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCff
USE LOGICAL_MOD, ONLY : LFUTURE
USE TIME_MOD, ONLY : GET_TS_EMIS
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: THISMONTH
! Local variables
INTEGER :: I, J
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: XTAU, STEPS_PER_YR, FUT_SCL
REAL*8 :: STEPS_PER_MON
REAL*8 :: FD2D(IIPAR,JJPAR)
CHARACTER(LEN=255) :: FILENAME
! Hydrophilic fraction of BLACK CARBON (aka ELEMENTAL CARBON)
REAL*8, PARAMETER :: FHB = 0.2d0
! Hydrophilic fraction of ORGANIC CARBON
REAL*8, PARAMETER :: FHO = 0.5d0
!=================================================================
! ANTHRO_CARB_TBOND begins here!
!=================================================================
!-----------------------------------
! Prior to 12/18/08
! ! Number of emission timesteps per year
! STEPS_PER_YR = ( ( 1440 * 365 ) / GET_TS_EMIS() )
!
! ! Get TAU0 value to index the punch file
! XTAU = GET_TAU0( 1, 1, 2001 )
!----------------------------------
! Number of emission timesteps per month
STEPS_PER_MON = ( ( 1440 * NDAYS ( THISMONTH ) ) / GET_TS_EMIS() )
! Get TAU0 value to index the punch file
XTAU = GET_TAU0( THISMONTH, 1, 2000 )
!=================================================================
! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from
! anthropogenic sources as tracer #34 in [kg C/month].
! Then convert to [kg C/timestep] and store in ANTH_BLKC.
!=================================================================
! Filename for carbon aerosol from fossil fuel use
FILENAME = TRIM( DATA_DIR ) //
! & 'carbon_200905/BCOC_TBond_fossil.2000.' //
& 'carbon_200909/BCOC_TBond_fossil.2000.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - ANTHRO_CARB_TBOND: Reading ', a )
! Read BLCK emission
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 34,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, FUT_SCL )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Hydrophilic BLACK CARBON from anthropogenics [kg C/timestep]
!-----------------------------------
! Prior to 12/18/08
! ANTH_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_YR
ANTH_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic BLACK CARBON from anthropogenics [kg C/timestep]
!-----------------------------------
! Prior to 12/18/08
! ANTH_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_YR
ANTH_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_BCff( I, J )
ANTH_BLKC(I,J,1) = ANTH_BLKC(I,J,1) * FUT_SCL
ANTH_BLKC(I,J,2) = ANTH_BLKC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Read ORGANIC CARBON from anthropogenic sources as tracer #35
! in [kg C/month]. Then Convert to [kg C/timestep] and store in
! ANTH_ORGC.
!=================================================================
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 35,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, FUT_SCL )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Hydrophilic ORGANIC CARBON from anthropogenics [kg C/timestep]
!-----------------------------------
! Prior to 12/18/08
! ANTH_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_YR
ANTH_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic ORGANIC CARBON from anthropogenics [kgC/timestep]
!-----------------------------------
! Prior to 12/18/08
! ANTH_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_YR
ANTH_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of ORGANIC CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_OCff( I, J )
ANTH_ORGC(I,J,1) = ANTH_ORGC(I,J,1) * FUT_SCL
ANTH_ORGC(I,J,2) = ANTH_ORGC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from biofuel
! combustion as tracer #34 in [kg C/year]. Then convert to
! [kg C/timestep] and store in BIOF_BLKC.
!=================================================================
! Filename
FILENAME = TRIM( DATA_DIR ) //
! & 'carbon_200905/BCOC_TBond_biofuel.2000.' //
& 'carbon_200909/BCOC_TBond_biofuel.2000.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
! Read data
CALL READ_BPCH2( FILENAME, 'BIOFSRCE', 34,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, FUT_SCL )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Hydrophilic BLACK CARBON from biofuels [kg C /timestep]
!-----------------------------------
! Prior to 12/18/08
! BIOF_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_YR
BIOF_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic BLACK CARBON from biofuels [kg C/timestep]
!-----------------------------------
! Prior to 12/18/08
! BIOF_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_YR
BIOF_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_BCbf( I, J )
BIOF_BLKC(I,J,1) = BIOF_BLKC(I,J,1) * FUT_SCL
BIOF_BLKC(I,J,2) = BIOF_BLKC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Read ORGANIC CARBON from biofuel combustion as tracer #35 in
! [kg C/year]. Convert to [kg C/timestep] and store in BIOF_BLKC.
!=================================================================
CALL READ_BPCH2( FILENAME, 'BIOFSRCE', 35,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Hydrophilic ORGANIC CARBON from biofuels [kg C/timestep]
!-----------------------------------
! Prior to 12/18/08
! BIOF_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_YR
BIOF_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic ORGANIC CARBON from biofuels [kg C/timestep]
!-----------------------------------
! Prior to 12/18/08
! BIOF_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_YR
BIOF_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_OCbf( I, J )
BIOF_ORGC(I,J,1) = BIOF_ORGC(I,J,1) * FUT_SCL
BIOF_ORGC(I,J,2) = BIOF_ORGC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Return to calling program
END SUBROUTINE ANTHRO_CARB_TBOND
!------------------------------------------------------------------------------
SUBROUTINE ANTHRO_CARB_COOKE( THISMONTH )
!
!******************************************************************************
! Subroutine ANTHRO_CARB_COOKE computes monthly mean anthropogenic and
! biofuel emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC
! CARBON. It also separates these into HYDROPHILIC and HYDROPHOBIC
! fractions. (rjp, bmy, 4/2/04, 5/30/06)
!
! Emissions data comes from the Cooke et al. [1999] inventory and
! seasonality imposed by Park et al. [2003]. The data has units of
! [kg C/month]. This will be converted to [kg C/timestep] below.
!
! We also assume that 20% of BC and 50% of OC from anthropogenic
! emissions are hydrophilic (soluble) and the rest are hydrophobic.
!
! NOTES:
! (1 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
! (2 ) Now read data from "carbon_200411" subdir of DATA_DIR. Now only apply
! Cooke/RJP emissions over the North American region (i.e. the region
! bounded by indices I1_NA, J1_NA, I2_NA, J2_NA). (rjp, bmy, 12/1/04)
! (3 ) Now can read data from both GEOS and GCAP grids (bmy, 8/16/05)
! (4 ) Now compute future emissions of BC,OC if necessary. (swu, bmy, 5/30/06)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCbf
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCff
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCbf
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCff
USE LOGICAL_MOD, ONLY : LFUTURE
USE TIME_MOD, ONLY : GET_TS_EMIS
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: THISMONTH
! Local variables
INTEGER :: I, J
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: XTAU, STEPS_PER_MON, FUT_SCL
REAL*8 :: FD2D(IIPAR,JJPAR)
CHARACTER(LEN=255) :: FILENAME
! Hydrophilic fraction of BLACK CARBON aerosol
REAL*8, PARAMETER :: FHB = 0.2d0
! Hydrophilic fraction of ORGANIC CARBON aerosol
REAL*8, PARAMETER :: FHO = 0.5d0
!=================================================================
! ANTHRO_CARB_COOKE begins here!
!=================================================================
! Return if we are running on a nested grid (e.g. China) which
! does not cover the North America region (rjp, bmy, 12/1/04)
IF ( I1_NA + J1_NA + I2_NA + J2_NA == 0 ) RETURN
! Number of emission timesteps per month
STEPS_PER_MON = ( ( 1440 * NDAYS( THISMONTH ) ) / GET_TS_EMIS() )
! Get TAU0 value to index the punch file
XTAU = GET_TAU0( THISMONTH, 1, 1998 )
!=================================================================
! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from
! anthropogenic sources as tracer #34 in [kg C/month].
! Then convert to [kg C/timestep] and store in ANTH_BLKC.
!
! The ANTH_BLKC array is initialized with the Bond et al [2004]
! emissions in READ_ANTHRO_TBOND on the very first timestep.
! Overwrite the contents of ANTH_BLKC over North America below.
!=================================================================
! Filename
FILENAME = TRIM( DATA_DIR ) //
& 'carbon_200411/BCOC_anthsrce.' // GET_NAME_EXT_2D() //
& '.' // GET_RES_EXT()
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - ANTHRO_CARB_COOKE: Reading ', a )
! Read data
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 34,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
DO J = J1_NA, J2_NA
DO I = I1_NA, I2_NA
! Hydrophilic BLACK CARBON from anthropogenics [kg C/timestep]
ANTH_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic BLACK CARBON from anthropogenics [kg C/timestep]
ANTH_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_BCff( I, J )
ANTH_BLKC(I,J,1) = ANTH_BLKC(I,J,1) * FUT_SCL
ANTH_BLKC(I,J,2) = ANTH_BLKC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!=================================================================
! Read ORGANIC CARBON from anthropogenic sources as tracer #35
! in [kg C/month]. Then Convert to [kg C/timestep] and store in
! ANTH_ORGC.
!
! The ANTH_ORGC array is initialized with the Bond et al [2004]
! emissions in READ_ANTHRO_TBOND on the very first timestep.
! Overwrite the contents of ANTH_ORGC over North America below.
!=================================================================
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 35,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
DO J = J1_NA, J2_NA
DO I = I1_NA, I2_NA
! Hydrophilic ORGANIC CARBON from anthropogenics [kg C/timestep]
ANTH_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic ORGANIC CARBON from anthropogenics [kg C/timestep]
ANTH_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of ORGANIC CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_OCff( I, J )
ANTH_ORGC(I,J,1) = ANTH_ORGC(I,J,1) * FUT_SCL
ANTH_ORGC(I,J,2) = ANTH_ORGC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!=================================================================
! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from biofuel
! combustion over Canada and the US as tracer #34 in [kg C/year].
! Then convert to [kg C/timestep] and store in BIOF_BLKC.
!
! Seasonality has been imposed using the heating degree approach
! for year 1998 [Park et al., 2003].
!
! The BIOF_BLKC array is initialized with the Bond et al [2004]
! emissions in READ_ANTHRO_TBOND on the very first timestep.
! Overwrite the contents of BIOF_BLKC over North America below.
!=================================================================
! Filename
FILENAME = TRIM( DATA_DIR ) //
& 'carbon_200411/BCOC_biofuel.' // GET_NAME_EXT_2D() //
& '.' // GET_RES_EXT()
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
! Read data
CALL READ_BPCH2( FILENAME, 'BIOFSRCE', 34,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
DO J = J1_NA, J2_NA
DO I = I1_NA, I2_NA
! Hydrophilic BLACK CARBON from biofuels [kg C/timestep]
BIOF_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic BLACK CARBON from biofuels [kg C/timestep]
BIOF_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_BCbf( I, J )
BIOF_BLKC(I,J,1) = BIOF_BLKC(I,J,1) * FUT_SCL
BIOF_BLKC(I,J,2) = BIOF_BLKC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!=================================================================
! Read ORGANIC CARBON emission from biofuel combustion over
! Canada and the US as tracer #35 in [kg C/year]. Then convert
! to [kg C/timestep] and store in BIOF_ORGC.
!
! Seasonality has been imposed using the heating degree approach
! for year 1998 [Park et al., 2003].
!
! The BIOF_ORGC array is initialized with the Bond et al [2004]
! emissions in READ_ANTHRO_TBOND on the very first timestep.
! Overwrite the contents of BIOF_ORGC over North America below.
!=================================================================
CALL READ_BPCH2( FILENAME, 'BIOFSRCE', 35,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
DO J = J1_NA, J2_NA
DO I = I1_NA, I2_NA
! Hydrophilic ORGANIC CARBON from biofuels [kg C/timestep]
BIOF_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_MON
! Hydrophobic ORGANIC CARBON from biofuels [kg C/timestep]
BIOF_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_MON
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_OCbf( I, J )
BIOF_ORGC(I,J,1) = BIOF_ORGC(I,J,1) * FUT_SCL
BIOF_ORGC(I,J,2) = BIOF_ORGC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
! Return to calling program
END SUBROUTINE ANTHRO_CARB_COOKE
!------------------------------------------------------------------------------
SUBROUTINE ANTHRO_CARB_RCP( THISMONTH )
!
!******************************************************************************
! Subroutine ANTHRO_CARB_RCP reads monthly mean anthropogenic and biofuel
! emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC CARBON.
! (cdh, 1/2/2013)
!
! It also separates these into HYDROPHILIC and HYDROPHOBIC fractions using
! the same fractions as the Bond et al. (2007) global inventory.
!
! We also assume that 20% of BC and 50% of OC from anthropogenic
! emissions are hydrophilic (soluble) and the rest are hydrophobic.
!
! NOTES:
!******************************************************************************
!
! References to F90 modules
USE TIME_MOD, ONLY : GET_TS_EMIS
USE GRID_MOD, ONLY : GET_AREA_CM2
USE TRACERID_MOD, ONLY : IDTBCPO, IDTOCPO
USE TRACER_MOD, ONLY : XNUMOL
USE RCP_MOD, ONLY : GET_RCP_EMISSION
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: THISMONTH
! Local variables
INTEGER :: I, J
REAL*8 :: AREA_CM2, BC, OC
! Hydrophilic fraction of BLACK CARBON (aka ELEMENTAL CARBON)
REAL*8, PARAMETER :: FHB = 0.2d0
! Hydrophilic fraction of ORGANIC CARBON
REAL*8, PARAMETER :: FHO = 0.5d0
!=================================================================
! ANTHRO_CARB_RCP begins here!
!=================================================================
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, BC, OC, AREA_CM2 )
DO J = 1, JJPAR
! Grid box area [cm2]
AREA_CM2 = GET_AREA_CM2( J )
DO I = 1, IIPAR
!-----------------------------------------------------------
! Anthropogenic Black Carbon from fossil fuel and biofuel
!-----------------------------------------------------------
! RCP emissions, atoms C/cm2/s
BC = GET_RCP_EMISSION( I, J, IDTBCPO,
& LAND=.TRUE., SHIP=.TRUE. )
! Convert atoms C/cm2/s -> kg/timestep
BC = BC * AREA_CM2 / XNUMOL(IDTBCPO) * GET_TS_EMIS() * 60D0
! Hydrophilic BLACK CARBON from anthropogenics [kg C/timestep]
ANTH_BLKC(I,J,1) = FHB * BC
! Hydrophobic BLACK CARBON from anthropogenics [kg C/timestep]
ANTH_BLKC(I,J,2) = ( 1.d0 - FHB ) * BC
!-----------------------------------------------------------
! Anthropogenic Organic Carbon from fossil fuel and biofuel
!-----------------------------------------------------------
! RCP emissions, atoms C/cm2/s
OC = GET_RCP_EMISSION( I, J, IDTOCPO,
& LAND=.TRUE., SHIP=.TRUE. )
! Convert atoms C/cm2/s -> kg/timestep
OC = OC * AREA_CM2 / XNUMOL(IDTOCPO) * GET_TS_EMIS() * 60D0
! Hydrophilic ORGANIC CARBON from anthropogenics [kg C/timestep]
ANTH_ORGC(I,J,1) = FHO * OC
! Hydrophobic ORGANIC CARBON from anthropogenics [kgC/timestep]
ANTH_ORGC(I,J,2) = ( 1.d0 - FHO ) * OC
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Return to calling program
END SUBROUTINE ANTHRO_CARB_RCP
!------------------------------------------------------------------------------
SUBROUTINE BIOMASS_CARB_TBOND
!
!******************************************************************************
! Subroutine BIOMASS_CARB_TBOND computes annual mean biomass burning
! emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC CARBON.
! It also separates these into HYDROPHILIC and HYDROPHOBIC fractions.
! (rjp, bmy, 4/2/04, 5/30/06)
!
! Emissions data comes from the Bond et al [2004] inventory and has units
! of [kg C/yr]. This will be converted to [kg C/timestep] below.
!
! We also assume that 20% of BC and 50% of OC from anthropogenic
! emissions are hydrophilic (soluble) and the rest are hydrophobic.
!
! NOTES:
! (1 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
! (2 ) Now read data from "carbon_200411" subdir of DATA_DIR (bmy, 11/15/04)
! (3 ) Now can read from both GEOS and GCAP grids (bmy, 8/16/05)
! (4 ) Now compute future emissions of BC,OC if necessary (swu, bmy, 5/30/06)
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCbb
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCbb
USE LOGICAL_MOD, ONLY : LFUTURE
USE TIME_MOD, ONLY : GET_TS_EMIS
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
! Local variables
INTEGER :: I, J
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: XTAU, STEPS_PER_YR, FUT_SCL
REAL*8 :: FD2D(IIPAR,JJPAR)
CHARACTER(LEN=255) :: FILENAME
! Hydrophilic fraction of carbonaceous aerosols
REAL*8, PARAMETER :: FHB = 0.2d0
REAL*8, PARAMETER :: FHO = 0.5d0
!=================================================================
! BIOMASS_CARB_TBOND begins here!
!=================================================================
! Number of emission timesteps per year
STEPS_PER_YR = ( ( 1440 * 365 ) / GET_TS_EMIS() )
! Filename containing biomass emissions
FILENAME = TRIM( DATA_DIR ) //
& 'carbon_200411/BCOC_TBond_biomass.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
! Get TAU0 value to index the punch file
XTAU = GET_TAU0( 1, 1, 2001 )
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - BIOMASS_CARB_TBOND: Reading ', a )
!=================================================================
! Read BLACK CARBON (aka ELEMENTAL CARBON) emission from
! biomass burning as tracer #34 in [kg C/year]. Then
! convert to [kg C/timestep] and store in BIOB_BLKC.
!=================================================================
CALL READ_BPCH2( FILENAME, 'BIOBSRCE', 34,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, FUT_SCL )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Hydrophilic BLACK CARBON from biomass [kg C/timestep]
BIOB_BLKC(I,J,1) = FHB * FD2D(I,J) / STEPS_PER_YR
! Hydrophobic BLACK CARBON from biomass [kg C/timestep]
BIOB_BLKC(I,J,2) = ( 1.d0 - FHB ) * FD2D(I,J) / STEPS_PER_YR
! Compute future emissions of BLACK CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_BCbb( I, J )
BIOB_BLKC(I,J,1) = BIOB_BLKC(I,J,1) * FUT_SCL
BIOB_BLKC(I,J,2) = BIOB_BLKC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
!=================================================================
! Read ORGANIC CARBON from biomass burning as tracer #35 in
! [kg C/year]. Then convert to [kg C/timestep] and store in
! BIOF_BLKC.
!=================================================================
CALL READ_BPCH2( FILENAME, 'BIOBSRCE', 35,
& XTAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), FD2D )
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, FUT_SCL )
DO J = 1, JJPAR
DO I = 1, IIPAR
! Hydrophilic ORGANIC CARBON from biomass [kg C/timestep]
BIOB_ORGC(I,J,1) = FHO * FD2D(I,J) / STEPS_PER_YR
! Hydrophobic ORGANIC CARBON from biomass [kg C/timestep]
BIOB_ORGC(I,J,2) = ( 1.d0 - FHO ) * FD2D(I,J) / STEPS_PER_YR
! Compute future emissions of ORGANIC CARBON (if necessary)
IF ( LFUTURE ) THEN
FUT_SCL = GET_FUTURE_SCALE_OCbb( I, J )
BIOB_ORGC(I,J,1) = BIOB_ORGC(I,J,1) * FUT_SCL
BIOB_ORGC(I,J,2) = BIOB_ORGC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Return to calling program
END SUBROUTINE BIOMASS_CARB_TBOND
!------------------------------------------------------------------------------
SUBROUTINE BIOMASS_CARB_GEOS
!
!******************************************************************************
! Subroutine BIOMASS_CARB_GEOS computes monthly mean biomass burning
! emissions of BLACK CARBON (aka ELEMENTAL CARBON) and ORGANIC CARBON.
! It also separates these into HYDROPHILIC and HYDROPHOBIC fractions.
! (rjp, bmy, 4/2/04, 2/19/09)
!
! Emissions are contained in the BIOMASS array of "biomass_mod.f", and will
! contain biomass emissions from either the Duncan et al [2001] inventory or
! the GFED2 inventory, depending on the option selected at runtime startup.
! BIOMASS has units of [atoms C/cm3/s]. Units will be converted to
! [kg C/timestep] below.
!
! We also assume that 20% of BC and 50% of OC from anthropogenic
! emissions are hydrophilic (soluble) and the rest are hydrophobic.
!
! NOTES:
! (1 ) Now references DATA_DIR from "directory_mod.f". Also removed CMN,
! it's obsolete. (bmy, 7/20/04)
! (2 ) Now read data from "carbon_200411" subdir of DATA_DIR (bmy, 11/15/04)
! (3 ) Now read BCPO, OCPO biomass burning data directly from files instead
! of computing from emission factors. (rjp, bmy, 1/11/05)
! (4 ) Now can read data for both GEOS and GCAP grids (bmy, 8/16/05)
! (5 ) Now compute future emissions of BC,OC if necessary (swu, bmy, 5/30/06)
! (6 ) Now get biomass emissions from the BIOMASS array of "biomass_mod.f",
! which will contain either GFED2 or default emissions. Also move
! file-reading code to gc_biomass_mod.f. (bmy, 9/25/06)
! (7 ) Prevent seg fault error when LBIOMASS=F (bmy, 11/3/06)
! (8 ) Now apply future emissions if necessary (hotp, swu, bmy, 2/19/09)
!******************************************************************************
!
! References to F90 modules
USE BIOMASS_MOD, ONLY : BIOMASS, IDBBC, IDBOC
USE GRID_MOD, ONLY : GET_AREA_CM2
USE LOGICAL_MOD, ONLY : LBIOMASS, LFUTURE
USE TIME_MOD, ONLY : GET_TS_EMIS
USE TRACER_MOD, ONLY : XNUMOL
USE TRACERID_MOD, ONLY : IDTBCPO, IDTOCPO
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCbb
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCbb
# include "CMN_SIZE" ! Size parameters
!-------------------
! Local variables
!-------------------
! Hydrophilic fraction of BLACK CARBON
REAL*8, PARAMETER :: FHB = 0.2d0
! Hydrophilic fraction of ORGANIC CARBON
REAL*8, PARAMETER :: FHO = 0.5d0
INTEGER :: I, J
REAL*8 :: A_CM2, BIOBC, BIOOC
REAL*8 :: CONV_BC, CONV_OC, DTSRCE, FUT_SCL
CHARACTER(LEN=255) :: BC_FILE, OC_FILE
!=================================================================
! BIOMASS_CARB_GEOS begins here!
!=================================================================
! Emission timestep [s]
DTSRCE = 60d0 * GET_TS_EMIS()
! Conversion factor for [s * kg/molec]
CONV_BC = DTSRCE / XNUMOL(IDTBCPO)
CONV_OC = DTSRCE / XNUMOL(IDTOCPO)
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, BIOBC, BIOOC, A_CM2, FUT_SCL )
! Loop over latitudes
DO J = 1, JJPAR
! Grid box area [cm2]
A_CM2 = GET_AREA_CM2( J )
! Loop over longitudes
DO I = 1, IIPAR
! Convert [molec/cm2/s] --> [kg C/timestep]
IF ( LBIOMASS ) THEN
BIOBC = BIOMASS(I,J,IDBBC) * A_CM2 * CONV_BC
BIOOC = BIOMASS(I,J,IDBOC) * A_CM2 * CONV_OC
ELSE
BIOBC = 0d0
BIOOC = 0d0
ENDIF
! Hydrophilic BLACK CARBON from biomass [kg C/timestep]
BIOB_BLKC(I,J,1) = FHB * BIOBC
! Hydrophobic BLACK CARBON from biomass [kg C/timestep]
BIOB_BLKC(I,J,2) = ( 1.D0 - FHB ) * BIOBC
! Hydrophilic ORGANIC CARBON from biomass [kg C/timestep]
BIOB_ORGC(I,J,1) = FHO * BIOOC
! Hydrophobic ORGANIC CARBON from biomass [kg C/timestep]
BIOB_ORGC(I,J,2) = ( 1.D0 - FHO ) * BIOOC
! Apply future emissions for GCAP (if necessary)
IF ( LFUTURE ) THEN
! Compute future emissions of ORGANIC CARBON
FUT_SCL = GET_FUTURE_SCALE_OCbb( I, J )
BIOB_ORGC(I,J,1) = BIOB_ORGC(I,J,1) * FUT_SCL
BIOB_ORGC(I,J,2) = BIOB_ORGC(I,J,2) * FUT_SCL
! Compute future emissions of BLACK CARBON
FUT_SCL = GET_FUTURE_SCALE_BCbb( I, J )
BIOB_BLKC(I,J,1) = BIOB_BLKC(I,J,1) * FUT_SCL
BIOB_BLKC(I,J,2) = BIOB_BLKC(I,J,2) * FUT_SCL
ENDIF
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Return to calling program
END SUBROUTINE BIOMASS_CARB_GEOS
!------------------------------------------------------------------------------
SUBROUTINE EMITHIGH( BCSRC, OCSRC )
!
!******************************************************************************
! Subroutine EMITHIGH 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 ) Now also mix ALPH, LIMO, ALCO tracers (rjp, bmy, 7/8/04)
! (2 ) Now reference STT from "tracer_mod.f" (bmy, 7/20/04)
! (3 ) Remove references to "dao_mod.f", "pressure_mod.f", and "error_mod.f".
! Rewrote for computational expediency using routines from
! "pbl_mix_mod.f". (bmy, 2/17/05)
!******************************************************************************
!
! References to F90 modules
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(IN) :: BCSRC(IIPAR,JJPAR,2)
REAL*8, INTENT(IN) :: OCSRC(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 begins here!
!=================================================================
! Define logical flags for expediency
IS_BCPI = ( IDTBCPI > 0 )
IS_OCPI = ( IDTOCPI > 0 )
IS_BCPO = ( IDTBCPO > 0 )
IS_OCPO = ( IDTOCPO > 0 )
IS_ALPH = ( IDTALPH > 0 )
IS_LIMO = ( IDTLIMO > 0 )
IS_ALCO = ( IDTALCO > 0 )
! Maximum extent of PBL [model levels]
PBL_MAX = GET_PBL_MAX_L()
!=================================================================
! Partition emissions throughout the boundary layer
!=================================================================
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, F_OF_PBL )
DO L = 1, PBL_MAX
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
IF ( IS_BCPI ) THEN
STT(I,J,L,IDTBCPI) = STT(I,J,L,IDTBCPI) +
& ( F_OF_PBL * BCSRC(I,J,1) )
ENDIF
! Hydrophilic ORGANIC CARBON
IF ( IS_OCPI ) THEN
STT(I,J,L,IDTOCPI) = STT(I,J,L,IDTOCPI) +
& ( F_OF_PBL * OCSRC(I,J,1) )
ENDIF
! Hydrophobic BLACK CARBON
IF ( IS_BCPO ) THEN
STT(I,J,L,IDTBCPO) = STT(I,J,L,IDTBCPO) +
& ( F_OF_PBL * BCSRC(I,J,2) )
ENDIF
! Hydrophobic ORGANIC CARBON
IF ( IS_OCPO ) THEN
STT(I,J,L,IDTOCPO) = STT(I,J,L,IDTOCPO) +
& ( F_OF_PBL * OCSRC(I,J,2) )
ENDIF
! 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
ENDDO
!$OMP END PARALLEL DO
! Return to calling program
END SUBROUTINE EMITHIGH
!------------------------------------------------------------------------------
SUBROUTINE OHNO3TIME
!
!******************************************************************************
! Subroutine OHNO3TIME computes the sum of cosine of the solar zenith
! angle over a 24 hour day, as well as the total length of daylight.
! This is needed to scale the offline OH and NO3 concentrations.
! (rjp, bmy, 12/16/02, 1/18/05)
!
! NOTES:
! (1 ) Copy code from COSSZA directly for now, so that we don't get NaN
! values. Figure this out later (rjp, bmy, 1/10/03)
! (2 ) Now replace XMID(I) with routine GET_XMID from "grid_mod.f".
! Now replace RLAT(J) with routine GET_YMID_R from "grid_mod.f".
! Removed NTIME, NHMSb from the arg list. Now use GET_NHMSb,
! GET_ELAPSED_SEC, GET_TS_CHEM, GET_DAY_OF_YEAR, GET_GMT from
! "time_mod.f". (bmy, 3/27/03)
! (3 ) Now store the peak SUNCOS value for each surface grid box (I,J) in
! the COSZM array. (rjp, bmy, 3/30/04)
! (4 ) Also added parallel loop over grid boxes (bmy, 1/18/05)
!******************************************************************************
!
! References to F90 modules
USE GRID_MOD, ONLY : GET_XMID, GET_YMID_R
USE TIME_MOD, ONLY : GET_NHMSb, GET_ELAPSED_SEC
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_DAY_OF_YEAR, GET_GMT
# include "CMN_SIZE" ! Size parameters
# include "CMN_GCTM"
! Local variables
LOGICAL, SAVE :: FIRST = .TRUE.
INTEGER :: I, IJLOOP, J, L, N, NT, NDYSTEP
REAL*8 :: A0, A1, A2, A3, B1, B2, B3
REAL*8 :: LHR0, R, AHR, DEC, TIMLOC, YMID_R
REAL*8 :: SUNTMP(MAXIJ)
!=================================================================
! OHNO3TIME begins here!
!=================================================================
! Solar declination angle (low precision formula, good enough for us):
A0 = 0.006918
A1 = 0.399912
A2 = 0.006758
A3 = 0.002697
B1 = 0.070257
B2 = 0.000907
B3 = 0.000148
R = 2.* PI * float( GET_DAY_OF_YEAR() - 1 ) / 365.
DEC = A0 - A1*cos( R) + B1*sin( R)
& - A2*cos(2*R) + B2*sin(2*R)
& - A3*cos(3*R) + B3*sin(3*R)
LHR0 = int(float( GET_NHMSb() )/10000.)
! Only do the following at the start of a new day
IF ( FIRST .or. GET_GMT() < 1e-5 ) THEN
! Zero arrays
TCOSZ(:,:) = 0d0
! NDYSTEP is # of chemistry time steps in this day
NDYSTEP = ( 24 - INT( GET_GMT() ) ) * 60 / GET_TS_CHEM()
! NT is the elapsed time [s] since the beginning of the run
NT = GET_ELAPSED_SEC()
! Loop forward through NDYSTEP "fake" timesteps for this day
DO N = 1, NDYSTEP
! Zero SUNTMP array
SUNTMP(:) = 0d0
! Loop over surface grid boxes
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, YMID_R, IJLOOP, TIMLOC, AHR )
DO J = 1, JJPAR
! Grid box latitude center [radians]
YMID_R = GET_YMID_R( J )
DO I = 1, IIPAR
! Increment IJLOOP
IJLOOP = ( (J-1) * IIPAR ) + I
TIMLOC = real(LHR0) + real(NT)/3600.0 + GET_XMID(I)/15.0
DO WHILE (TIMLOC .lt. 0)
TIMLOC = TIMLOC + 24.0
ENDDO
DO WHILE (TIMLOC .gt. 24.0)
TIMLOC = TIMLOC - 24.0
ENDDO
AHR = abs(TIMLOC - 12.) * 15.0 * PI_180
!===========================================================
! The cosine of the solar zenith angle (SZA) is given by:
!
! cos(SZA) = sin(LAT)*sin(DEC) + cos(LAT)*cos(DEC)*cos(AHR)
!
! where LAT = the latitude angle,
! DEC = the solar declination angle,
! AHR = the hour angle, all in radians.
!
! If SUNCOS < 0, then the sun is below the horizon, and
! therefore does not contribute to any solar heating.
!===========================================================
! Compute Cos(SZA)
SUNTMP(IJLOOP) = sin(YMID_R) * sin(DEC) +
& cos(YMID_R) * cos(DEC) * cos(AHR)
! TCOSZ is the sum of SUNTMP at location (I,J)
! Do not include negative values of SUNTMP
TCOSZ(I,J) = TCOSZ(I,J) + MAX( SUNTMP(IJLOOP), 0d0 )
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Increment elapsed time [sec]
NT = NT + ( GET_TS_CHEM() * 60 )
ENDDO
! Reset first-time flag
FIRST = .FALSE.
ENDIF
! Return to calling program
END SUBROUTINE OHNO3TIME
!------------------------------------------------------------------------------
FUNCTION GET_OH( I, J, L ) RESULT( OH_MOLEC_CM3 )
!
!******************************************************************************
! Function GET_OH returns OH from SMVGEAR's CSPEC array (for coupled runs)
! or monthly mean OH (for offline runs). Imposes a diurnal variation on
! OH for offline simulations. (bmy, 7/9/04)
!
! Arguments as Input:
! ============================================================================
! (1-3) I, J, L (INTEGER) : Grid box indices for lon, lat, vertical level
!
! NOTES:
! (1 ) We assume SETTRACE has been called to define IDOH (bmy, 11/1/02)
! (2 ) Now use function GET_TS_CHEM from "time_mod.f" (bmy, 3/27/03)
! (3 ) Now reference inquiry functions from "tracer_mod.f" (bmy, 7/20/04)
!******************************************************************************
!
! References to F90 modules
USE COMODE_MOD, ONLY : CSPEC, JLOP
USE DAO_MOD, ONLY : SUNCOS
USE ERROR_MOD, ONLY : ERROR_STOP
USE GLOBAL_OH_MOD, ONLY : OH
USE TIME_MOD, ONLY : GET_TS_CHEM
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM, ITS_AN_AEROSOL_SIM
USE TRACERID_MOD, ONLY : IDOH
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: I, J, L
! Local variables
INTEGER :: JLOOP
REAL*8 :: OH_MOLEC_CM3
!=================================================================
! GET_OH begins here!
!=================================================================
IF ( ITS_A_FULLCHEM_SIM() ) THEN
!---------------------
! Coupled simulation
!---------------------
! JLOOP = SMVGEAR 1-D grid box index
JLOOP = JLOP(I,J,L)
! Take OH from the SMVGEAR array CSPEC
! OH is defined only in the troposphere
IF ( JLOOP > 0 ) THEN
OH_MOLEC_CM3 = CSPEC(JLOOP,IDOH)
ELSE
OH_MOLEC_CM3 = 0d0
ENDIF
ELSE IF ( ITS_AN_AEROSOL_SIM() ) THEN
!---------------------
! Offline simulation
!---------------------
! 1-D grid box index for SUNCOS
JLOOP = ( (J-1) * IIPAR ) + I
! Test for sunlight...
IF ( SUNCOS(JLOOP) > 0d0 .and. TCOSZ(I,J) > 0d0 ) THEN
! Impose a diurnal variation on OH during the day
OH_MOLEC_CM3 = OH(I,J,L) *
& ( SUNCOS(JLOOP) / TCOSZ(I,J) ) *
& ( 1440d0 / GET_TS_CHEM() )
! Make sure OH is not negative
OH_MOLEC_CM3 = MAX( OH_MOLEC_CM3, 0d0 )
ELSE
! At night, OH goes to zero
OH_MOLEC_CM3 = 0d0
ENDIF
ELSE
!---------------------
! Invalid sim type!
!---------------------
CALL ERROR_STOP( 'Invalid Simulation Type!',
& 'GET_OH ("carbon_mod.f")' )
ENDIF
! Return to calling program
END FUNCTION GET_OH
!------------------------------------------------------------------------------
FUNCTION GET_NO3( I, J, L ) RESULT( NO3_MOLEC_CM3 )
!
!******************************************************************************
! Function GET_NO3 returns NO3 from SMVGEAR's CSPEC array (for coupled runs)
! or monthly mean OH (for offline runs). For offline runs, the concentration
! of NO3 is set to zero during the day. (rjp, bmy, 12/16/02, 7/20/04)
!
! Arguments as Input:
! ============================================================================
! (1-3) I, J, L (INTEGER) : Grid box indices for lon, lat, vertical level
!
! NOTES:
! (1 ) Now references ERROR_STOP from "error_mod.f". We also assume that
! SETTRACE has been called to define IDNO3. Now also set NO3 to
! zero during the day. (rjp, bmy, 12/16/02)
! (2 ) Now reference inquiry functions from "tracer_mod.f" (bmy, 7/20/04)
!******************************************************************************
!
! References to F90 modules
USE COMODE_MOD, ONLY : CSPEC, JLOP
USE DAO_MOD, ONLY : AD, SUNCOS
USE ERROR_MOD, ONLY : ERROR_STOP
USE GLOBAL_NO3_MOD, ONLY : NO3
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM, ITS_AN_AEROSOL_SIM
USE TRACERID_MOD, ONLY : IDNO3
# include "CMN_SIZE" ! Size parameters
# include "CMN" ! NSRCX
! Arguments
INTEGER, INTENT(IN) :: I, J, L
! Local variables
INTEGER :: JLOOP
REAL*8 :: NO3_MOLEC_CM3
REAL*8, PARAMETER :: XNUMOL_NO3 = 6.022d23 / 62d-3
! External functions
REAL*8, EXTERNAL :: BOXVL
!=================================================================
! GET_NO3 begins here!
!=================================================================
IF ( ITS_A_FULLCHEM_SIM() ) THEN
!----------------------
! Fullchem simulation
!----------------------
! 1-D SMVGEAR grid box index
JLOOP = JLOP(I,J,L)
! Take NO3 from the SMVGEAR array CSPEC
! NO3 is defined only in the troposphere
IF ( JLOOP > 0 ) THEN
NO3_MOLEC_CM3 = CSPEC(JLOOP,IDNO3)
ELSE
NO3_MOLEC_CM3 = 0d0
ENDIF
ELSE IF ( ITS_AN_AEROSOL_SIM() ) THEN
!==============================================================
! Offline simulation: Read monthly mean GEOS-CHEM NO3 fields
! in [v/v]. Convert these to [molec/cm3] as follows:
!
! vol NO3 moles NO3 kg air kg NO3/mole NO3
! ------- = --------- * -------- * ---------------- = kg NO3
! vol air moles air 1 kg air/mole air
!
! And then we convert [kg NO3] to [molec NO3/cm3] by:
!
! kg NO3 molec NO3 mole NO3 1 molec NO3
! ------ * --------- * -------- * ----- = ---------
! 1 mole NO3 kg NO3 cm3 cm3
! ^ ^
! |____________________|
! this is XNUMOL_NO3
!
! If at nighttime, use the monthly mean NO3 concentration from
! the NO3 array of "global_no3_mod.f". If during the daytime,
! set the NO3 concentration to zero. We don't have to relax to
! the monthly mean concentration every 3 hours (as for HNO3)
! since NO3 has a very short lifetime. (rjp, bmy, 12/16/02)
!==============================================================
! 1-D grid box index for SUNCOS
JLOOP = ( (J-1) * IIPAR ) + I
! Test if daylight
IF ( SUNCOS(JLOOP) > 0d0 ) THEN
! NO3 goes to zero during the day
NO3_MOLEC_CM3 = 0d0
ELSE
! At night: Get NO3 [v/v] and convert it to [kg]
NO3_MOLEC_CM3 = NO3(I,J,L) * AD(I,J,L) * ( 62d0/28.97d0 )
! Convert NO3 from [kg] to [molec/cm3]
NO3_MOLEC_CM3 = NO3_MOLEC_CM3 * XNUMOL_NO3 / BOXVL(I,J,L)
ENDIF
! Make sure NO3 is not negative
NO3_MOLEC_CM3 = MAX( NO3_MOLEC_CM3, 0d0 )
ELSE
!----------------------
! Invalid sim type!
!----------------------
CALL ERROR_STOP( 'Invalid Simulation Type!',
& 'GET_NO3 ("carbon_mod.f")' )
ENDIF
! Return to calling program
END FUNCTION GET_NO3
!------------------------------------------------------------------------------
FUNCTION GET_O3( I, J, L ) RESULT( O3_MOLEC_CM3 )
!
!******************************************************************************
! Function GET_O3 returns monthly mean O3 for offline sulfate aerosol
! simulations. (bmy, 12/16/02, 7/20/04)
!
! Arguments as Input:
! ============================================================================
! (1-3) I, J, L (INTEGER) : Grid box indices for lon, lat, vertical level
!
! NOTES:
! (1 ) We assume SETTRACE has been called to define IDO3. (bmy, 12/16/02)
! (2 ) Now reference inquiry functions from "tracer_mod.f" (bmy, 7/20/04)
! (3 ) Now reference XNUMOLAIR from "tracer_mod.f" (bmy, 10/20/05)
!******************************************************************************
!
! References to F90 modules
USE COMODE_MOD, ONLY : CSPEC, JLOP, VOLUME
USE DAO_MOD, ONLY : SUNCOS, AD
USE ERROR_MOD, ONLY : ERROR_STOP
USE GLOBAL_O3_MOD, ONLY : O3
USE TIME_MOD, ONLY : GET_TS_CHEM
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM, ITS_AN_AEROSOL_SIM
USE TRACER_MOD, ONLY : XNUMOLAIR
USE TRACERID_MOD, ONLY : IDO3
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: I, J, L
! Local variables
INTEGER :: JLOOP
REAL*8 :: O3_MOLEC_CM3
REAL*8, PARAMETER :: XNUMOL_O3 = 6.022d23 / 48d-3
! External functions
REAL*8, EXTERNAL :: BOXVL
!=================================================================
! GET_O3 begins here!
!=================================================================
IF ( ITS_A_FULLCHEM_SIM() ) THEN
!--------------------
! Coupled simulation
!--------------------
! JLOOP = SMVGEAR 1-D grid box index
JLOOP = JLOP(I,J,L)
! Get O3 from CSPEC [molec/cm3]
! O3 data will only be defined below the tropopause
IF ( JLOOP > 0 ) THEN
O3_MOLEC_CM3 = CSPEC(JLOOP,IDO3)
ELSE
O3_MOLEC_CM3 = 0d0
ENDIF
ELSE IF ( ITS_AN_AEROSOL_SIM() ) THEN
!--------------------
! Offline simulation
!--------------------
! Get O3 [v/v] for this gridbox & month
! O3 data will only be defined below the tropopause
IF ( L <= LLTROP ) THEN
! Get O3 [v/v] and convert it to [kg]
O3_MOLEC_CM3 = O3(I,J,L) * AD(I,J,L) * ( 48d0/28.97d0 )
! Convert O3 from [kg] to [molec/cm3]
O3_MOLEC_CM3 = O3_MOLEC_CM3 * XNUMOL_O3 / BOXVL(I,J,L)
ELSE
O3_MOLEC_CM3 = 0d0
ENDIF
! 1-D grid box index for SUNCOS
JLOOP = ( (J-1) * IIPAR ) + I
! Test for sunlight...
IF ( SUNCOS(JLOOP) > 0d0 .and. TCOSZ(I,J) > 0d0 ) THEN
! Impose a diurnal variation on OH during the day
O3_MOLEC_CM3 = O3_MOLEC_CM3 *
& ( SUNCOS(JLOOP) / TCOSZ(I,J) ) *
& ( 1440d0 / GET_TS_CHEM() )
! Make sure OH is not negative
O3_MOLEC_CM3 = MAX( O3_MOLEC_CM3, 0d0 )
ELSE
O3_MOLEC_CM3 = 0d0
ENDIF
ELSE
!--------------------
! Invalid sim type!
!--------------------
CALL ERROR_STOP( 'Invalid Simulation Type!',
& 'GET_O3 ("carbon_mod.f")' )
ENDIF
! Return to calling program
END FUNCTION GET_O3
!------------------------------------------------------------------------------
FUNCTION GET_DOH( I, J, L ) RESULT( DOH )
!
!******************************************************************************
! Function GET_DOH returns the amount of isoprene [kg] that has reacted with
! OH during the last chemistry time step. (dkh, bmy, 6/01/06)
!
! Arguments as Input:
! ============================================================================
! (1-3) I, J, L (INTEGER) : Grid box indices for lon, lat, vertical level
!
!
! NOTES:
!******************************************************************************
!
! References to F90 modules
USE COMODE_MOD, ONLY : CSPEC, JLOP, VOLUME
USE ERROR_MOD, ONLY : ERROR_STOP
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM, ITS_AN_AEROSOL_SIM
USE TRACER_MOD, ONLY : XNUMOL, TRACER_COEFF
USE TRACERID_MOD, ONLY : IDTISOP
# include "CMN_SIZE" ! Size parameters
# include "comode.h" ! ILISOPOH (dkh, 05/29/06)
! Arguments
INTEGER, INTENT(IN) :: I, J, L
! Function returns
REAL*8 :: DOH
! Local variables
INTEGER :: JLOOP
!=================================================================
! GET_DOH begins here!
!=================================================================
IF ( ITS_A_FULLCHEM_SIM() ) THEN
!--------------------
! Coupled simulation
!--------------------
! Get 1-D index from current 3-D position
JLOOP = JLOP(I,J,L)
! Test if we are in the troposphere
IF ( JLOOP > 0 ) THEN
!-----------------------------------------------------------
! Get DOH from CSPEC [molec/cm3] and
! convert to [kg C isop / box]
!
! CSPEC(JLOOP,ILISOPOH) : molec isop (lost to OH) / cm3
! XNUMOL(IDTISOP) : atom C / kg C isop
! TRACER_COEFF(IDTISOP,1) : atom C / molec isop
! VOLUME : cm3 / box
!-----------------------------------------------------------
DOH = CSPEC(JLOOP,ILISOPOH) *
& VOLUME(JLOOP) *
& TRACER_COEFF(IDTISOP,1) /
& XNUMOL(IDTISOP)
ELSE
! Otherwise set DOH=0
DOH = 0d0
ENDIF
ELSE IF ( ITS_AN_AEROSOL_SIM() ) THEN
!--------------------
! Offline simulation
!--------------------
! ISOP from OH not is yet supported for
! offline aerosol simulations, set DOH=0
DOH = 0d0
ELSE
!--------------------
! Invalid sim type!
!--------------------
CALL ERROR_STOP( 'Invalid simulation type!',
& 'GET_DOH ("carbon_mod.f")' )
ENDIF
! Return to calling program
END FUNCTION GET_DOH
!------------------------------------------------------------------------------
SUBROUTINE GET_VCLDF
!
!******************************************************************************
! Subroutine GET_VCLDF computes the volume cloud fraction for SO2 chemistry.
! (rjp, bdf, bmy, 9/23/02)
!
! References:
! ============================================================================
! (1) Sundqvist et al. [1989]
!
! NOTES:
! (1 ) Copied from 'sulfate_mod.f' for cloud uptake of GLYX and MGLY (tmf, 2/26/07)
!******************************************************************************
!
! References to F90 modules
USE DAO_MOD, ONLY : RH
USE PRESSURE_MOD, ONLY : GET_PCENTER, GET_PEDGE
# include "CMN_SIZE" ! Size parameters
! Local variables
INTEGER :: I, J, L
REAL*8 :: PRES, PSFC, RH2, R0, B0
! Parameters
REAL*8, PARAMETER :: ZRT = 0.60d0, ZRS = 0.99d0
!=================================================================
! GET_VCLDF begins here!
!=================================================================
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, PSFC, PRES, RH2, R0, B0 )
DO L = 1, LLTROP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Surface pressure
PSFC = GET_PEDGE(I,J,1)
! Pressure at the center of the grid box
PRES = GET_PCENTER(I,J,L)
! RH (from "dao_mod.f") is relative humidity [%]
! Convert to fraction and store in RH2
RH2 = RH(I,J,L) * 1.0d-2
! Terms from Sundqvist ???
R0 = ZRT + ( ZRS - ZRT ) * EXP( 1d0 - ( PSFC / PRES )**2.5 )
B0 = ( RH2 - R0 ) / ( 1d0 - R0 )
! Force B0 into the range 0-1
IF ( RH2 < R0 ) B0 = 0d0
IF ( B0 > 1d0 ) B0 = 1d0
! Volume cloud fraction
VCLDF(I,J,L) = 1d0 - SQRT( 1d0 - B0 )
ENDDO
ENDDO
ENDDO
!$OMP END PARALLEL DO
! Return to calling program
END SUBROUTINE GET_VCLDF
!------------------------------------------------------------------------------
FUNCTION GET_LWC( T ) RESULT( LWC )
!
!******************************************************************************
! Function GET_LWC returns the cloud liquid water content at a GEOS-CHEM
! grid box as a function of temperature. (rjp, bmy, 10/31/02, 1/14/03)
!
! Arguments as Input:
! ============================================================================
! (1 ) T (REAL*8) : Temperature value at a GEOS-CHEM grid box [K]
!
! NOTES:
! (1 ) Copied from 'sulfate_mod.f' for cloud uptake of GLYX and MGLY (tmf, 2/26/07)
!******************************************************************************
!
! Arguments
REAL*8, INTENT(IN) :: T
! Function value
REAL*8 :: LWC
!=================================================================
! GET_LWC begins here!
!=================================================================
! Compute Liquid water content in [g/m3]
IF ( T > 293d0 ) THEN
LWC = 0.2d0
ELSE IF ( T >= 280.d0 .AND. T <= 293.d0 ) THEN
LWC = 0.32d0 - 0.0060d0 * ( T - 273.D0 )
ELSE IF ( T >= 248.d0 .AND. T < 280.d0 ) THEN
LWC = 0.23d0 + 0.0065d0 * ( T - 273.D0 )
ELSE IF ( T < 248.d0 ) THEN
LWC = 0.07d0
ENDIF
! Return to calling program
END FUNCTION GET_LWC
!------------------------------------------------------------------------------
SUBROUTINE SOAG_CLOUD
!
!******************************************************************************
! Subroutine SOAG_CLOUD produces SOAG from GLYX during a cloud event.
! Mimics the SO2 -> SO4 process from 'sulfate_mod.f'. (tmf, 2/26/07)
!
! Procedure:
! ============================================================================
! (1 )
!
! NOTES:
! (1 ) SOAG (SOA product of GLYX is produced at existing hydrophilic aerosol
! surface. (tmf, 2/26/07)
! (2 ) Assume marine and continental cloud droplet size (tmf, 2/26/07)
!******************************************************************************
!
! Reference to diagnostic arrays
USE DAO_MOD, ONLY : AD, T, AIRVOL
USE DAO_MOD, ONLY : IS_LAND ! return true if sfc grid box is land
USE DIAG_MOD, ONLY : AD07_SOAGM
USE TIME_MOD, ONLY : GET_TS_CHEM
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_STRAT
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTGLYX, IDTSOAG
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! ND44, ND07, LD07
! Local variables
INTEGER :: I, J, L
REAL*8 :: DTCHEM ! Chemistry time step [s]
REAL*8 :: XAIRM ! Air mass in grid box [kg/box]
REAL*8 :: XAIRM3 ! Air volume in grid box [m3]
REAL*8 :: XGASM ! Gas mass at grid box before uptake [kg]
REAL*8 :: XGASC ! Gas concentration at grid box before uptake [molec/cm3]
REAL*8 :: XGASMIX ! Gas mixing ratio [v/v]
REAL*8 :: XCLDR ! cloud droplet radius [cm]
REAL*8 :: XDF ! gas-phase diffusivity [cm2/s]
REAL*8 :: XMS ! Mean molecular speed [cm/s]
REAL*8 :: XKT ! phase-transfer coefficient [1/s]
REAL*8 :: XTEMP ! Temperature [K]
REAL*8 :: XDELTAC ! Potential maximum change of gas concentration due to cloud chemistry [molecules/cm3]
REAL*8 :: XUPTKMAX ! Potential maximum uptake of gas by cloud in grid box [kg]
REAL*8 :: XUPTK ! Actual uptake of gas by cloud in grid box [kg]
! XUPTK <= STT( I, J, L, IDTGLYX )
REAL*8 :: FC ! Cloud fraction by volume [unitless]
REAL*8 :: LWC ! Liquid water content [g/m3]
! Parameters
REAL*8, PARAMETER :: XCLDR_CONT = 6.d-4 ! Cloud droplet radius in continental warm clouds [cm]
REAL*8, PARAMETER :: XCLDR_MARI = 10.d-4 ! Cloud droplet radius in marine warm clouds [cm]
REAL*8, PARAMETER :: XMW = 58.d0 ! Molecular weight of glyoxal [g/mole]
REAL*8, PARAMETER :: XNAVO = 6.023d23 ! Avogadro's number
REAL*8, PARAMETER :: MINDAT = 1.d-20 ! Minimum GLYX mixing ratio to calculate cloud uptake
REAL*8, PARAMETER :: XGAMMA = 2.9d-3 ! Uptake coefficient (Assume XGAMMA = 2.9d-3 following Liggio et al., 2005)
!=================================================================
! SOAG_CLOUD
!=================================================================
! DTCHEM is the chemistry timestep in seconds
DTCHEM = GET_TS_CHEM() * 60d0
! Loop over tropospheric grid boxes
DO L = 1, LLTROP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Skip stratospheric boxes
IF ( ITS_IN_THE_STRAT( I, J, L ) ) CYCLE
! initialize for safety
XUPTKMAX = 0d0
XUPTK = 0d0
! Get temperature
XTEMP = T( I, J, L )
! Get air mass [kg/box]
XAIRM = AD( I, J, L )
! Get air volumne [m3]
XAIRM3 = AIRVOL( I, J, L )
! Get gas mass at grid box [kg]
XGASM = STT( I, J, L, IDTGLYX )
! Get gas concentration at grid box [molec/cm3]
XGASC = XGASM / (XMW*1.d-3) * XNAVO / (XAIRM3*1.d6)
! GET gas mixing ratio [v/v]
XGASMIX = XGASM / XMW / ( XAIRM / 28.97d0 )
! Volume cloud fraction (Sundqvist et al 1989) [unitless]
FC = VCLDF(I,J,L)
! Liquid water content in cloudy area of grid box [g/m3]
LWC = GET_LWC( XTEMP ) * FC
!==============================================================
! If (1) there is cloud, (2) there is GLYX present, and
! (3) the T > -15 C, then compute cloud uptake
!==============================================================
IF ( ( FC > 0.d0 ) .AND.
& ( XGASMIX > MINDAT ) .AND.
& ( XTEMP > 258.0 ) ) THEN
IF ( IS_LAND(I,J) ) THEN
XCLDR = XCLDR_CONT ! Continental cloud droplet radius [m]
ELSE
XCLDR = XCLDR_MARI ! Marine cloud droplet radius [m]
ENDIF
!---------------------------------------
! Gas phase diffusivity [cm2/s] [Lim et al., 2005 Eq. (4)]
!---------------------------------------
XDF = 1.9d0 * (XMW**(-0.667))
!---------------------------------------
! Mean molecular speed [cm/s] [Lim et al., 2005 Eq. (5)]
! XMS = SQRT( ( 8 * Boltzmann const * Temperature * N_Avogadro ) /
! ( pi * molecular weight [g/mole] ) )
! = SQRT( 2.117d8 * Temperature / molecular weight )
!---------------------------------------
XMS = SQRT( 2.117d8 * XTEMP / XMW )
!---------------------------------------
! Phase transfer coeff [1/s] [Lim et al., 2005 Eq. (3)]
! XGAMMA = ALPHA, XGAMMA = 2.9d-3 following Liggio et al., 2005
!---------------------------------------
XKT = 1.d0 / ( ( XCLDR * XCLDR / 3.d0 / XDF ) +
& ( 4.d0 * XCLDR / 3.d0 / XMS / XGAMMA ) )
!---------------------------------------
! Maximum potential change in concentration [molecules/cm3] [Lim et al., 2005 Eq. (1)]
!---------------------------------------
XDELTAC = LWC * XKT * XGASC * DTCHEM
!---------------------------------------
! Maximum potential uptake of gas mass [kg/box]
!---------------------------------------
XUPTKMAX = XDELTAC * 1.d6 / XNAVO * XMW * 1.d-3 * XAIRM3
!---------------------------------------
! However, the mass of gas being absorbed by aerosol
! cannot exceed the original amount of gas XGASM
!---------------------------------------
XUPTK = MIN( XUPTKMAX, XGASM )
! Update GLYX in the STT array
STT( I, J, L, IDTGLYX ) = STT( I, J, L, IDTGLYX ) -
& XUPTK
! Update SOAG in the STT array
STT( I, J, L, IDTSOAG ) = STT( I, J, L, IDTSOAG ) +
& XUPTK
!==============================================================
! ND07 diagnostic: SOAG from GLYX in cloud [kg/timestep]
!==============================================================
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_SOAGM(I,J,L,3) = AD07_SOAGM(I,J,L,3) + XUPTK
ENDIF
ENDIF ! End of IN CLOUD criteria
ENDDO
ENDDO
ENDDO
! Return to calling program
END SUBROUTINE SOAG_CLOUD
!------------------------------------------------------------------------------
SUBROUTINE SOAM_CLOUD
!
!******************************************************************************
! Subroutine SOAM_CLOUD produces SOAM from MGLY during a cloud event.
! Mimics the SO2 -> SO4 process from 'sulfate_mod.f'. (tmf, 2/26/07)
!
! Procedure:
! ============================================================================
! (1 )
!
! NOTES:
! (1 ) SOAM (SOA product of MGLY is produced at existing hydrophilic aerosol
! surface. (tmf, 2/26/07)
! (2 ) Assume typical marine and continental cloud droplet size (tmf, 2/26/07)
!******************************************************************************
!
! Reference to diagnostic arrays
USE DAO_MOD, ONLY : AD, T, AIRVOL
USE DAO_MOD, ONLY : IS_LAND ! return true if sfc grid box is land
USE DIAG_MOD, ONLY : AD07_SOAGM
USE TIME_MOD, ONLY : GET_TS_CHEM
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_STRAT
USE TRACER_MOD, ONLY : STT
USE TRACERID_MOD, ONLY : IDTMGLY, IDTSOAM
# include "CMN_SIZE" ! Size parameters
# include "CMN_DIAG" ! ND44, ND07, LD07
! Local variables
INTEGER :: I, J, L
REAL*8 :: DTCHEM ! Chemistry time step [s]
REAL*8 :: XAIRM ! Air mass in grid box [kg/box]
REAL*8 :: XAIRM3 ! Air volume in grid box [m3]
REAL*8 :: XGASM ! Gas mass at grid box before uptake [kg]
REAL*8 :: XGASC ! Gas concentration at grid box before uptake [molec/cm3]
REAL*8 :: XGASMIX ! Gas mixing ratio [v/v]
REAL*8 :: XCLDR ! cloud droplet radius [cm]
REAL*8 :: XDF ! gas-phase diffusivity [cm2/s]
REAL*8 :: XMS ! Mean molecular speed [cm/s]
REAL*8 :: XKT ! phase-transfer coefficient [1/s]
REAL*8 :: XTEMP ! Temperature [K]
REAL*8 :: XDELTAC ! Potential maximum change of gas concentration due to cloud chemistry [molecules/cm3]
REAL*8 :: XUPTKMAX ! Potential maximum uptake of gas by cloud in grid box [kg]
REAL*8 :: XUPTK ! Actual uptake of gas by cloud in grid box [kg]
! XUPTK <= STT( I, J, L, IDTGLYX )
REAL*8 :: FC ! Cloud fraction by volume [unitless]
REAL*8 :: LWC ! Liquid water content [g/m3]
! Parameters
REAL*8, PARAMETER :: XCLDR_CONT = 6.d-4 ! Cloud droplet radius in continental warm clouds [cm]
REAL*8, PARAMETER :: XCLDR_MARI = 10.d-4 ! Cloud droplet radius in marine warm clouds [cm]
REAL*8, PARAMETER :: XMW = 72.d0 ! Molecular weight of methylglyoxal [g/mole]
REAL*8, PARAMETER :: XNAVO = 6.023d23 ! Avogadro's number
REAL*8, PARAMETER :: MINDAT = 1.d-20 ! Minimum GLYX mixing ratio to calculate cloud uptake
REAL*8, PARAMETER :: XGAMMA = 2.9d-3 ! Uptake coefficient (Assume XGAMMA = 2.9d-3 following Liggio et al., 2005)
!=================================================================
! SOAG_CLOUD
!=================================================================
! DTCHEM is the chemistry timestep in seconds
DTCHEM = GET_TS_CHEM() * 60d0
! Loop over tropospheric grid boxes
DO L = 1, LLTROP
DO J = 1, JJPAR
DO I = 1, IIPAR
! Skip stratospheric boxes
IF ( ITS_IN_THE_STRAT( I, J, L ) ) CYCLE
! initialize for safety
XUPTKMAX = 0d0
XUPTK = 0d0
! Get temperature
XTEMP = T( I, J, L )
! Get air mass [kg/box]
XAIRM = AD( I, J, L )
! Get air volumne [m3]
XAIRM3 = AIRVOL( I, J, L )
! Get gas mass at grid box [kg]
XGASM = STT( I, J, L, IDTMGLY )
! Get gas concentration at grid box [molec/cm3]
XGASC = XGASM / (XMW*1.d-3) * XNAVO / (XAIRM3*1.d6)
! GET gas mixing ratio [v/v]
XGASMIX = XGASM / XMW / ( XAIRM / 28.97d0 )
! Volume cloud fraction (Sundqvist et al 1989) [unitless]
FC = VCLDF(I,J,L)
! Liquid water content in cloudy area of grid box [g/m3]
LWC = GET_LWC( XTEMP ) * FC
!==============================================================
! If (1) there is cloud, (2) there is MGLY present, and
! (3) the T > -15 C, then compute cloud uptake
!==============================================================
IF ( ( FC > 0.d0 ) .AND.
& ( XGASMIX > MINDAT ) .AND.
& ( XTEMP > 258.0 ) ) THEN
IF ( IS_LAND(I,J) ) THEN
XCLDR = XCLDR_CONT ! Continental cloud droplet radius [m]
ELSE
XCLDR = XCLDR_MARI ! Marine cloud droplet radius [m]
ENDIF
!---------------------------------------
! Gas phase diffusivity [cm2/s] [Lim et al., 2005 Eq. (4)]
!---------------------------------------
XDF = 1.9d0 * (XMW**(-0.667))
!---------------------------------------
! Mean molecular speed [cm/s] [Lim et al., 2005 Eq. (5)]
! XMS = SQRT( ( 8 * Boltzmann const * Temperature * N_Avogadro ) /
! ( pi * molecular weight [g/mole] ) )
! = SQRT( 2.117d8 * Temperature / molecular weight )
!---------------------------------------
XMS = SQRT( 2.117d8 * XTEMP / XMW )
!---------------------------------------
! Phase transfer coeff [1/s] [Lim et al., 2005 Eq. (3)]
! XGAMMA = ALPHA, XGAMMA = 2.9d-3 following Liggio et al., 2005
!---------------------------------------
XKT = 1.d0 / ( ( XCLDR * XCLDR / 3.d0 / XDF ) +
& ( 4.d0 * XCLDR / 3.d0 / XMS / XGAMMA ) )
!---------------------------------------
! Maximum potential change in concentration [molecules/cm3] [Lim et al., 2005 Eq. (1)]
!---------------------------------------
XDELTAC = LWC * XKT * XGASC * DTCHEM
!---------------------------------------
! Maximum potential uptake of gas mass [kg/box]
!---------------------------------------
XUPTKMAX = XDELTAC * 1.d6 / XNAVO * XMW * 1.d-3 * XAIRM3
!---------------------------------------
! However, the mass of gas being absorbed by aerosol
! cannot exceed the original amount of gas XGASM
!---------------------------------------
XUPTK = MIN( XUPTKMAX, XGASM )
! Update MGLY in the STT array
STT( I, J, L, IDTMGLY ) = STT( I, J, L, IDTMGLY ) -
& XUPTK
! Update SOAM in the STT array
STT( I, J, L, IDTSOAM ) = STT( I, J, L, IDTSOAM ) +
& XUPTK
!==============================================================
! ND07 diagnostic: SOAM from MGLY in cloud [kg/timestep]
!==============================================================
IF ( ND07 > 0 .and. L <= LD07 ) THEN
AD07_SOAGM(I,J,L,4) = AD07_SOAGM(I,J,L,4) + XUPTK
ENDIF
ENDIF ! End of IN CLOUD criteria
ENDDO
ENDDO
ENDDO
! Return to calling program
END SUBROUTINE SOAM_CLOUD
! <<<<<
!------------------------------------------------------------------------------
SUBROUTINE WRITE_GPROD_APROD( YYYYMMDD, HHMMSS, TAU )
!
!******************************************************************************
! Subroutine WRITE_GPROD_APROD writes the SOA quantities GPROD and APROD to
! disk at the start of a new diagnostic interval. (tmf, havala, bmy, 2/6/07)
!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD (INTEGER) : YYYY/MM/DD value at which to write file
! (2 ) HHMMSS (INTEGER) : hh:mm:ss value at which to write file
! (3 ) TAU (REAL*8 ) : TAU value corresponding to YYYYMMDD, HHMMSS
!
! NOTES:
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : BPCH2, GET_MODELNAME
USE BPCH2_MOD, ONLY : GET_HALFPOLAR, OPEN_BPCH2_FOR_WRITE
USE FILE_MOD, ONLY : IU_FILE
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
USE TIME_MOD, ONLY : EXPAND_DATE
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
REAL*8, INTENT(IN) :: TAU
! Local variables
INTEGER :: HALFPOLAR
INTEGER, PARAMETER :: CENTER180 = 1
INTEGER :: I0, IPR, J0, JHC, N
REAL*4 :: LONRES, LATRES
REAL*4 :: ARRAY(IIPAR,JJPAR,LLPAR)
CHARACTER(LEN=20) :: MODELNAME
CHARACTER(LEN=40) :: CATEGORY
CHARACTER(LEN=40) :: UNIT
CHARACTER(LEN=40) :: RESERVED = ''
CHARACTER(LEN=80) :: TITLE
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! WRITE_GPROD_APROD begins here
!=================================================================
! Define variables for binary punch file
FILENAME = 'restart_gprod_aprod.YYYYMMDDhh'
TITLE = 'GEOS-Chem SOA restart file: GPROD & APROD'
UNIT = 'kg/kg'
LONRES = DISIZE
LATRES = DJSIZE
MODELNAME = GET_MODELNAME()
HALFPOLAR = GET_HALFPOLAR()
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
! Replace date & time tokens in FILENAME
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Open restart file for output
CALL OPEN_BPCH2_FOR_WRITE( IU_FILE, FILENAME, TITLE )
! Loop over VOC classes and products
DO JHC = 1, MHC
DO IPR = 1, NPROD
! Tracer number
N = ( JHC - 1 ) * NPROD + IPR
!----------------------
! Write GPROD to file
!----------------------
! Initialize
CATEGORY = 'IJ-GPROD'
ARRAY = GPROD(:,:,:,IPR,JHC)
! Write to disk
CALL BPCH2( IU_FILE, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, TAU, TAU, RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, ARRAY )
!----------------------
! Write APROD to file
!----------------------
! Initialize
CATEGORY = 'IJ-APROD'
ARRAY = APROD(:,:,:,IPR,JHC)
! Write to disk
CALL BPCH2( IU_FILE, MODELNAME, LONRES, LATRES,
& HALFPOLAR, CENTER180, CATEGORY, N,
& UNIT, TAU, TAU, RESERVED,
& IIPAR, JJPAR, LLPAR, I0+1,
& J0+1, 1, ARRAY )
ENDDO
ENDDO
! Close file
CLOSE( IU_FILE )
! Return to calling program
END SUBROUTINE WRITE_GPROD_APROD
!------------------------------------------------------------------------------
SUBROUTINE READ_GPROD_APROD( YYYYMMDD, HHMMSS, TAU )
!
!******************************************************************************
! Subroutine READ_GPROD_APROD writes the SOA quantities GPROD and APROD from
! disk at the start of a new diagnostic interval. (tmf, havala, bmy, 2/6/07)
!
! Arguments as Input:
! ============================================================================
! (1 ) YYYYMMDD (INTEGER) : YYYY/MM/DD value at which to write file
! (2 ) HHMMSS (INTEGER) : hh:mm:ss value at which to write file
! (3 ) TAU (REAL*8 ) : TAU value corresponding to YYYYMMDD, HHMMSS
!
! NOTES:
!******************************************************************************
!
! References to F90 modules
USE BPCH2_MOD, ONLY : READ_BPCH2
USE FILE_MOD, ONLY : IU_FILE
USE TIME_MOD, ONLY : EXPAND_DATE
# include "CMN_SIZE" ! Size parameters
! Arguments
INTEGER, INTENT(IN) :: YYYYMMDD, HHMMSS
REAL*8, INTENT(IN) :: TAU
! Local variables
INTEGER :: IPR, JHC, N
REAL*4 :: ARRAY(IIPAR,JJPAR,LLPAR)
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_GPROD_APROD begins here!
!=================================================================
! File name
FILENAME = 'restart_gprod_aprod.YYYYMMDDhh'
! Replace date & time tokens in FILENAME
CALL EXPAND_DATE( FILENAME, YYYYMMDD, HHMMSS )
! Loop over VOC classes and products
DO JHC = 1, MHC
DO IPR = 1, NPROD
! Tracer number
N = ( JHC - 1 ) * NPROD + IPR
!-----------------------
! Read GPROD from file
!-----------------------
! Read data
CALL READ_BPCH2( FILENAME, 'IJ-GPROD', N,
& TAU, IIPAR, JJPAR,
& LLPAR, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8
GPROD(:,:,:,IPR,JHC) = ARRAY
!-----------------------
! Read APROD from file
!-----------------------
! Read data
CALL READ_BPCH2( FILENAME, 'IJ-APROD', N,
& TAU, IIPAR, JJPAR,
& LLPAR, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8
APROD(:,:,:,IPR,JHC) = ARRAY
ENDDO
ENDDO
! Return to calling program
END SUBROUTINE READ_GPROD_APROD
!------------------------------------------------------------------------------
SUBROUTINE INIT_CARBON
!
!******************************************************************************
! Subroutine INIT_CARBON initializes all module arrays.
! (rjp, bmy, 4/1/04, 11/6/08)
!
! NOTES:
! (1 ) Also added arrays for secondary organic aerosols (rjp, bmy, 7/8/04)
! (2 ) Remove reference to CMN, it's obsolete (bmy, 7/20/04)
! (3 ) Now reference LSOA from "logical_mod.f" not CMN_SETUP. Now call
! GET_BOUNDING_BOX from "grid_mod.f" to compute the indices I1_NA,
! I2_NA, J1_NA, J2_NA which define the N. America region. (bmy, 12/1/04)
! (4 ) Now call READ_GPROD_APROD to read GPROD & APROD from disk.
! (tmf, havala, bmy, 2/6/07)
! (5 ) Now set I1_NA, I2_NA, J1_NA, J2_NA appropriately for both 1 x 1 and
! 0.5 x 0.666 nested grids (yxw, dan, bmy, 11/6/08)
!******************************************************************************
!
! References to F90 modules
USE ERROR_MOD, ONLY : ALLOC_ERR, ERROR_STOP
USE GRID_MOD, ONLY : GET_BOUNDING_BOX
USE LOGICAL_MOD, ONLY : LCHEM, LSOA
USE TIME_MOD, ONLY : GET_NYMDb, GET_NHMSb, GET_TAUb
# include "CMN_SIZE" ! Size parameters
! Local variables
LOGICAL, SAVE :: IS_INIT = .FALSE.
INTEGER :: AS, INDICES(4), YYYYMMDD, HHMMSS
REAL*8 :: COORDS(4), TAU
!=================================================================
! INIT_CARBON begins here!
!=================================================================
! Return if we already allocated arrays
IF ( IS_INIT ) RETURN
ALLOCATE( ANTH_BLKC( IIPAR, JJPAR, 2 ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ANTH_BLKC' )
ANTH_BLKC = 0d0
ALLOCATE( ANTH_ORGC( IIPAR, JJPAR, 2 ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ANTH_ORGC' )
ANTH_ORGC = 0d0
ALLOCATE( BIOB_BLKC( IIPAR, JJPAR, 2 ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOB_BLKC' )
BIOB_BLKC = 0d0
ALLOCATE( BIOB_ORGC( IIPAR, JJPAR, 2 ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOB_ORGC' )
BIOB_ORGC = 0d0
ALLOCATE( BIOF_BLKC( IIPAR, JJPAR, 2 ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOF_BLKC' )
BIOF_BLKC = 0d0
ALLOCATE( BIOF_ORGC( IIPAR, JJPAR, 2 ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOF_ORGC' )
BIOF_ORGC = 0d0
ALLOCATE( TERP_ORGC( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'TERP_ORGC' )
TERP_ORGC = 0d0
ALLOCATE( BCCONV( IIPAR, JJPAR, LLPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BCCONV' )
BCCONV = 0d0
ALLOCATE( OCCONV( IIPAR, JJPAR, LLPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'OCCONV' )
OCCONV = 0d0
!=================================================================
! These only have to be allocated if we are
! reading in monthly/8-day/3-hr mean
!=================================================================
IF ( .not. USE_BOND_BIOBURN ) THEN
ALLOCATE( EF_BLKC( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EF_BLKC' )
EF_BLKC = 0d0
ALLOCATE( EF_ORGC( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EF_ORGC' )
EF_ORGC = 0d0
ENDIF
!=================================================================
! SOA arrays only have to be allocated if LSOA = T
!=================================================================
IF ( LSOA ) THEN
ALLOCATE( BIOG_ALPH( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOG_ALPH' )
BIOG_ALPH = 0d0
ALLOCATE( BIOG_LIMO( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOG_LIMO' )
BIOG_LIMO = 0d0
ALLOCATE( BIOG_ALCO( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOG_ALCO' )
BIOG_ALCO = 0d0
ALLOCATE( BIOG_TERP( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOG_TERP' )
BIOG_TERP = 0d0
ALLOCATE( BIOG_SESQ( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOG_SESQ' )
BIOG_SESQ = 0d0
ALLOCATE( DIUR_ORVC( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'DIUR_ORVC' )
DIUR_ORVC = 0d0
ALLOCATE( GEIA_ORVC( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'GEIA_ORVC' )
GEIA_ORVC = 0d0
ALLOCATE( TCOSZ( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'TCOSZ' )
TCOSZ = 0d0
ALLOCATE( ORVC_TERP( IIPAR, JJPAR, LLPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ORVC_TERP' )
ORVC_TERP = 0d0
ALLOCATE( ORVC_SESQ( IIPAR, JJPAR, LLPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'ORVC_SESQ' )
ORVC_SESQ = 0d0
ALLOCATE( VCLDF( IIPAR, JJPAR, LLTROP ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'VCLDF' )
VCLDF = 0d0
ALLOCATE( GPROD( IIPAR, JJPAR, LLPAR, NPROD, MHC ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'GPROD' )
GPROD = 0D0
ALLOCATE( APROD( IIPAR, JJPAR, LLPAR, NPROD, MHC ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'APROD' )
APROD = 0D0
!--------------------------------------------------------------
! Read GPROD and APROD from disk from the last simulation
! NOTE: do this here after GPROD, APROD are allocated!
!--------------------------------------------------------------
IF ( LCHEM ) THEN
! Get time values at start of the run
YYYYMMDD = GET_NYMDb()
HHMMSS = GET_NHMSb()
TAU = GET_TAUb()
! Read GPROD, APROD from restart file
CALL READ_GPROD_APROD( YYYYMMDD, HHMMSS, TAU )
ENDIF
ENDIF
!=================================================================
! Compute indices which define the N. America region so that we
! can overwrite T. Bond emissions w/ Cooke/RJP emissions
!=================================================================
#if defined( NESTED_NA )
! For 1x1 N. America nested grid: set indices to grid extent
I1_NA = 1
J1_NA = 1
I2_NA = IIPAR
J2_NA = JJPAR
#elif defined( NESTED_CH )
! For 1x1 China nested grid: we don't cover N. America region
! Setting these to zero will turn off Cooke/RJP emissions
I1_NA = 0
J1_NA = 0
I2_NA = 0
J2_NA = 0
#else
! Definition of the N. American bounding box
! with LL corner (10N,165W) and UR corner (90N,40W)
! Lon_LL Lat_LL Lon_UR Lat_UR
COORDS = (/ -165d0, 10d0, -40d0, 90d0 /)
! Get the indices corresponding to the lon/lat values in COORDS
CALL GET_BOUNDING_BOX( COORDS, INDICES )
! Copy values from INDEX array to scalars
I1_NA = INDICES(1)
J1_NA = INDICES(2)
I2_NA = INDICES(3)
J2_NA = INDICES(4)
#endif
! Reset IS_INIT before exiting
IS_INIT = .TRUE.
! Return to calling program
END SUBROUTINE INIT_CARBON
!------------------------------------------------------------------------------
SUBROUTINE CLEANUP_CARBON
!
!******************************************************************************
! Subroutine CLEANUP_CARBON deallocates all module arrays
! (rjp, bmy, 4/1/04, 7/8/04)
!
! NOTES:
! (1 ) Now deallocate arrays for secondary organic aerosols (rjp, bmy, 7/8/04)
!******************************************************************************
!
!=================================================================
! CLEANUP_CARBON begins here!
!=================================================================
IF ( ALLOCATED( ANTH_BLKC ) ) DEALLOCATE( ANTH_BLKC )
IF ( ALLOCATED( ANTH_ORGC ) ) DEALLOCATE( ANTH_ORGC )
IF ( ALLOCATED( BIOB_BLKC ) ) DEALLOCATE( BIOB_BLKC )
IF ( ALLOCATED( BIOB_ORGC ) ) DEALLOCATE( BIOB_ORGC )
IF ( ALLOCATED( BIOF_BLKC ) ) DEALLOCATE( BIOF_BLKC )
IF ( ALLOCATED( BIOF_ORGC ) ) DEALLOCATE( BIOF_ORGC )
IF ( ALLOCATED( TERP_ORGC ) ) DEALLOCATE( TERP_ORGC )
IF ( ALLOCATED( BCCONV ) ) DEALLOCATE( BCCONV )
IF ( ALLOCATED( OCCONV ) ) DEALLOCATE( OCCONV )
IF ( ALLOCATED( EF_BLKC ) ) DEALLOCATE( EF_BLKC )
IF ( ALLOCATED( EF_ORGC ) ) DEALLOCATE( EF_ORGC )
IF ( ALLOCATED( BIOG_ALPH ) ) DEALLOCATE( BIOG_ALPH )
IF ( ALLOCATED( BIOG_LIMO ) ) DEALLOCATE( BIOG_LIMO )
IF ( ALLOCATED( BIOG_ALCO ) ) DEALLOCATE( BIOG_ALCO )
IF ( ALLOCATED( BIOG_TERP ) ) DEALLOCATE( BIOG_TERP )
IF ( ALLOCATED( BIOG_SESQ ) ) DEALLOCATE( BIOG_SESQ )
IF ( ALLOCATED( DIUR_ORVC ) ) DEALLOCATE( DIUR_ORVC )
IF ( ALLOCATED( GEIA_ORVC ) ) DEALLOCATE( GEIA_ORVC )
IF ( ALLOCATED( TCOSZ ) ) DEALLOCATE( TCOSZ )
IF ( ALLOCATED( GPROD ) ) DEALLOCATE( GPROD )
IF ( ALLOCATED( APROD ) ) DEALLOCATE( APROD )
IF ( ALLOCATED( ORVC_TERP ) ) DEALLOCATE( ORVC_TERP )
IF ( ALLOCATED( ORVC_SESQ ) ) DEALLOCATE( ORVC_SESQ )
IF ( ALLOCATED( VCLDF ) ) DEALLOCATE( VCLDF )
! Return to calling program
END SUBROUTINE CLEANUP_CARBON
!------------------------------------------------------------------------------
! End of module
END MODULE CARBON_MOD
Reference in New Issue View Git Blame Copy Permalink