Files
GEOS-Chem-adjoint-v35-note/code/modified/co2_mod.f
2018-08-28 00:37:54 -04:00

3446 lines
127 KiB
Fortran

!$Id: co2_mod.f,v 1.5 2012/03/01 22:00:26 daven Exp $
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !MODULE: co2_mod
!
! !DESCRIPTION: Module CO2\_MOD contains variables and routines used for the
! CO2 simulation. A tagged CO2 simulation capability has now been added.
!\\
!\\
! References:
!
! \begin{itemize}
! \item Andres, R.J, G. Marland, I. Fung, and E. Matthews, \emph{A 1x1
! distribution of carbon dioxide emissions from fossil fuel
! consumption and cement manufacture}, \underline{Glob. Biogeochem.
! Cycles}, \textbf{10}, 419-429, 1996.
! \item Corbett and Koehler (2003) \emph{Updated emissions from ocean
! shipping}, \underline{J. Geophys. Res.}, \textbf{108}, D20, 4650.
! \item Corbett and Koehler (2004) \emph{Considering alternative input
! parameters in an activity-based ship fuel consumption and emissions
! model: Reply ...} \underline{J. Geophys. Res.}, D23303.
! \item Endresen et al. (2007) \emph{A historical reconstruction of ships
! fuel consumption and emissions}, \underline{J. Geophys. Res.}
! \textbf{112}, D12301.
! \item Kim et al. (2005) \emph{System for assessing Aviation's Global
! Emissions (SAGE) Version 1.5 global Aviation Emissions Inventories
! for 2000-2004}
! \item Kim et al. (2007) \emph{System for assessing Aviation's Global
! Emissions (SAGE) Part 1: Model description and inventory results}
! \item LeQuere et al. (2009) \emph{Trends in the sources and sinks of carbon
! dioxide}, \underline{Nature Geoscience}, doi:10.1038/ngeo689.
! \item Olsen and Randerson (2004), \emph{Differences between surface and
! column atmospheric CO2 and implications for carbon cycle research},
! \underline{J. Geophys. Res.}, \textbf{109}, D02301,
! \item Potter et al. (1993), \emph{Terrestrial Ecosystem Production:
! A process model based on global satellite and surface data},
! \underline{Glob. Biogeochem. Cycles}, \textbf{7}(4), 811-841.
! \item Randerson, J.T, M.V. Thompson, T.J.Conway, I.Y. Fung, and C.B. Field,
! \emph{The contribution of terrestrial sources and sinks to trends
! in the seasonal cycle of atmospheric carbon dioxide},
! \underline{Glob. Biogeochem. Cycles},\textbf{11}, 535-560, 1997.
! \item Suntharalingam et al. (2005) \emph{Infulence of reduced carbon
! emissions and oxidation on the distribution of atmospheric CO2:
! Implications for inversion analysis}, BGC, 19, GB4003.
! \item Takahashi, T, R. Feely, R. Weiss, R. Wanninkof, D. Chipman,
! S. Sutherland, and T. Takahashi (1997), \emph{Global air-sea flux
! of CO2: An estimate based on measurements of sea-air pCO2 difference},
! \underline{Proceedings of the National Academy of Sciences},
! \textbf{94}, 8292-8299.
! \item Takahashi, T, et al. (2009), \emph{Climatological mean and decadal
! change in surface ocean pCO2, and net sea-air CO2 flux over the
! global oceans}, \textbf{Deep-Sea Research II},
! doi:10.1016/jdsr2/2008.12.009.
! \item Yevich, R. and J. A. Logan, \emph{An assesment of biofuel use and
! burning of agricultural waste in the developing world},
! \underline{Glob. Biogeochem. Cycles}, \textbf{17}, 1095,
! doi:10.1029/2002GB001952, 2003.
! \item Sausen, R. and Schumann, U. "Estimates of the Climate Response to
! Aircraft CO2 and NOx Emissions Scenarios", Climate Change,
! 44: 27-58, 2000
! \item Wilkersen, J.T. et al. \emph{Analysis of emission data from global
! commercial Aviation: 2004 and 2006}, \underline{Atmos. chem. Phys.
! Disc.}, \textbf{10}, 2945-2983, 2010.
! \end{itemize}
!
! !INTERFACE:
!
MODULE CO2_MOD
!
! !USES:
!
IMPLICIT NONE
PRIVATE
!
! !PUBLIC MEMBER FUNCTIONS:
!
PUBLIC :: CLEANUP_CO2
PUBLIC :: EMISSCO2
! adj_group: make these public as well (dkh, 03/07/11)
PUBLIC :: READ_BBIO_DIURNALCYCLE
PUBLIC :: READ_BBIO_DAILYAVERAGE
PUBLIC :: READ_FOSSILCO2
PUBLIC :: READ_OCEANCO2
PUBLIC :: READ_SHIPCO2_EDGAR
PUBLIC :: READ_SHIPCO2_ICOADS
PUBLIC :: READ_AVIATION_CO2
PUBLIC :: READ_CHEMCO2
PUBLIC :: CHEM_SURF
PUBLIC :: CHEMCO2
PUBLIC :: EMFOSSCO2
PUBLIC :: EMOCCO2
PUBLIC :: EMBIOCO2
PUBLIC :: EMBIOFUELCO2
PUBLIC :: EMBIONETCO2
PUBLIC :: EMSHIPCO2
PUBLIC :: EMPLANECO2
PUBLIC :: EMIS_SUB
PUBLIC :: XNUMOL_CO2
! adj group: some of these are now public (dkh, 03/07/11)
! !PRIVATE MEMBER FUNCTIONS:
!
!PRIVATE :: READ_CHEMCO2
!PRIVATE :: READ_FOSSILCO2
!PRIVATE :: CHEM_SURF
PRIVATE :: AVIATION_DOM_CORR
!PRIVATE :: READ_OCEANCO2
PRIVATE :: READ_ANNUAL_BIOFUELCO2
!PRIVATE :: READ_SHIPCO2_EDGAR
!PRIVATE :: READ_SHIPCO2_ICOADS
!PRIVATE :: READ_AVIATION_CO2
PRIVATE :: READ_ANNUAL_BIONET_CO2
!PRIVATE :: READ_BBIO_DAILYAVERAGE
!PRIVATE :: READ_BBIO_DIURNALCYCLE
PRIVATE :: TOTAL_BIOMASS_TG
PRIVATE :: DEF_BIOSPH_CO2_REGIONS_F
PRIVATE :: DEF_OCEAN_CO2_REGIONS_F
PRIVATE :: DEF_FOSSIL_CO2_REGIONS_F
PRIVATE :: INIT_CO2
!
! !REMARKS:
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! %%% BUYER BEWARE! Tagged CO2 tracers only work for 2 x 2.5 grid! %%%
! %%% Someone will have to make this more general later on... %%%
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! .
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! (1 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (2 ) Now references biomass_mod.f (bmy, 9/27/06)
! (3 ) Tagged CO2 capability developed (dbj)
! (4 ) Implemented monthly and annual fossil fuel inventories
! (R.Nassar 2009-03-10)
! (5 ) Implemented CO2 emissions from shipping and aviation (R.Nassar 2010)
! (6 ) Implemented monthly CO2 chemical production and surface correction
! (R.Nassar 2010)
! 25 Feb 2011 - R. Nassar - Now read updated CDIAC CO2 emissions data
! 07 Sep 2011 - P. Kasibhatla - Modified to include GFED3
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER, ALLOCATABLE :: FOSSIL_REGION(:,:)
INTEGER, ALLOCATABLE :: BIOSPH_REGION(:,:)
INTEGER, ALLOCATABLE :: OCEAN_REGION(:,:)
REAL*8, ALLOCATABLE :: EMFOSSCO2(:,:)
REAL*8, ALLOCATABLE :: EMOCCO2(:,:)
REAL*8, ALLOCATABLE :: EMBIOCO2(:,:)
REAL*8, ALLOCATABLE :: EMBIOBRNCO2(:,:)
REAL*8, ALLOCATABLE :: EMBIOFUELCO2(:,:)
REAL*8, ALLOCATABLE :: EMBIONETCO2(:,:)
REAL*8, ALLOCATABLE :: EMSHIPCO2(:,:)
REAL*8, ALLOCATABLE :: EMPLANECO2(:,:,:)
REAL*8, ALLOCATABLE :: CHEMCO2(:,:,:)
REAL*8, ALLOCATABLE :: EMIS_SUB(:,:)
!
! !DEFINED PARAMETERS:
!
! FMOL_CO2 - kg CO2 / mole CO2
REAL*8, PARAMETER :: FMOL_CO2 = 44d-3
! XNUMOL_CO2 - molecules CO2 / kg CO2
REAL*8, PARAMETER :: XNUMOL_CO2 = 6.022d+23 / FMOL_CO2
CONTAINS
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: emissco2
!
! !DESCRIPTION: Subroutine EMISSCO2 is the driver routine for CO2 emissions.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE EMISSCO2
!
! !USES:
!
USE BIOMASS_MOD, ONLY : BIOMASS
USE DIAG04_MOD, ONLY : AD04, ND04
USE DIAG04_MOD, ONLY : AD04_plane, AD04_chem
USE GRID_MOD, ONLY : GET_AREA_CM2
USE TIME_MOD, ONLY : GET_DAY, GET_DAY_OF_YEAR
USE TIME_MOD, ONLY : GET_HOUR, GET_MONTH
USE TIME_MOD, ONLY : GET_YEAR, GET_TS_CHEM, GET_TS_EMIS
USE TIME_MOD, ONLY : ITS_A_NEW_DAY, ITS_A_NEW_MONTH
USE TRACER_MOD, ONLY : N_TRACERS, STT
! adj_group: IDBCO2 still in biomass_mod.f (dkh, 03/07/11)
!USE TRACERID_MOD, ONLY : IDBCO2
USE BIOMASS_MOD, ONLY : IDBCO2
USE LOGICAL_MOD, ONLY : LGENFF, LANNFF, LMONFF, LSTREETS
USE LOGICAL_MOD, ONLY : LSEASBB, LGFED2BB, L8DAYBB, LBIOFUEL
USE LOGICAL_MOD, ONLY : LGFED3BB
USE LOGICAL_MOD, ONLY : LBIODAILY, LBIODIURNAL
USE LOGICAL_MOD, ONLY : LBIONETORIG, LBIONETCLIM
USE LOGICAL_MOD, ONLY : LOCN1997, LOCN2009ANN, LOCN2009MON
USE LOGICAL_MOD, ONLY : LSHIPEDG, LSHIPICO, LPLANE
USE LOGICAL_MOD, ONLY : LBIOSPHTAG, LFOSSILTAG, LFFBKGRD
USE LOGICAL_MOD, ONLY : LSHIPTAG, LPLANETAG
USE LOGICAL_MOD, ONLY : LSHIPSCALE, LPLANESCALE
USE LOGICAL_MOD, ONLY : LCHEMCO2
! adj_group (dkh, 03/07/11)
USE LOGICAL_ADJ_MOD, ONLY : LADJ
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ECO2ff, IDADJ_ECO2ocn
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ECO2bal, IDADJ_ECO2bb
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ECO2bf, IDADJ_ECO2nte
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ECO2shp, IDADJ_ECO2pln
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_ECO2che, IDADJ_ECO2sur
USE ADJ_ARRAYS_MOD, ONLY : GET_SCALE_GROUP
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF
! dkh debug
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD
USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! The initial condition for CO2 has to be at least 50 ppm or higher or else
! the balanced biosphere fluxes will make STT negative. (pns, bmy, 8/16/05)
!
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! (1 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (2 ) We now get CO2 biomass emissions from biomass_mod.f. This allows us
! to use either GFED2 or default Duncan et al biomass emissions.
! (bmy, 9/27/06)
! (3 ) Tagged tracer capability added. This requires the editable region
! files Regions_land.dat and Regions_ocean.dat in the run directory
! (rnassar,dbj, 2009)
! (4 ) New tracers for emissions from international and domestic shipping,
! international and domestic aviation, and the chemical CO2 source
! from the oxidation of CO, CH4, and other organics (rnassar,dbj, 2009)
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
LOGICAL, SAVE :: FIRST = .TRUE.
! Local variables
INTEGER :: I, IJLOOP, J, L, N, NN
INTEGER :: DAY, DOY, HOUR, MONTH, YEAR
REAL*8 :: A_CM2, DTSRCE, E_CO2
REAL*8 :: biomass_sum, bionet_sum
REAL*8, SAVE :: CHEMSRC(IIPAR,JJPAR,LLPAR) ! dbj
! External functions
REAL*8, EXTERNAL :: BOXVL ! dbj
! adj_group
INTEGER :: M
!=================================================================
! EMISSCO2 begins here!
!=================================================================
! First-time initialization
IF ( FIRST ) THEN
! Allocate arrays and read annual-mean data
CALL INIT_CO2
! Set up tagged regions for balanced biosphere & ocean
IF ( LBIOSPHTAG ) THEN
CALL DEF_BIOSPH_CO2_REGIONS_F( BIOSPH_REGION )
CALL DEF_OCEAN_CO2_REGIONS_F( OCEAN_REGION )
ENDIF
! Set up tagged regions for fossil fuel
IF ( LFOSSILTAG ) THEN
CALL DEF_FOSSIL_CO2_REGIONS_F( FOSSIL_REGION )
ENDIF
! Set first-time flag to false
FIRST = .FALSE.
ENDIF
!=================================================================
! Read in monthly, daily or variable emissions fields
!=================================================================
! Emission timestep
! DTSRCE = 60d0 * GET_TS_CHEM() !Line from the orginal code
DTSRCE = 60d0 * GET_TS_EMIS()
! Time variables
DAY = GET_DAY()
DOY = GET_DAY_OF_YEAR()
HOUR = GET_HOUR()
MONTH = GET_MONTH()
YEAR = GET_YEAR()
! adj_group
M = GET_SCALE_GROUP()
!------------------------------------------------------------------------------
! ! Read monthly-mean biomass burning emissions
! IF ( LBIOBRNCO2 .and. ITS_A_NEW_MONTH() ) THEN
! CALL READ_MONTH_BIOBRN_CO2( MONTH, YEAR )
! ENDIF
! This requires a subroutine called READ_MONTH_BIOBRN_CO2
! GFEDv2 biomass burning emissions are a better choice !Ray Nassar
!
!------------------------------------------------------------------------------
! At present, biomass burning emissions are dealt with in the following way:
!
! 1) main.f calls do_emissions in emissions.f
! 2) do_emissions calls compute_biomass_emissions in biomass_mod.f
! 3a) compute_biomass_emissions calls gfed2_compute_biomass
! in gfed2_biomass_mod.f
! ** OR **
! 3b) compute_biomass_emissions calls gfed3_compute_biomass
! in gfed3_biomass_mod.f
! ** OR **
! 3c) compute_biomass_emissions calls gc_read_biomass_co2 in gc_biomass_mod.f
!------------------------------------------------------------------------------
! ! Check if Balanced Biosphere emissions are required
! IF ( LBIOCO2 ) THEN
! ! If LUSECASANEP is TRUE ...
! IF ( LUSECASANEP ) THEN
!----------------------------------------------------------------
! Read in 3-hourly or daily balanced biosphere data
!----------------------------------------------------------------
IF ( LBIODIURNAL ) THEN
write(*,*) '*** USING DIURNAL CASA NEP ***'
! ... then use 3-hourly NEP emissions for Bal Bio ...
IF ( MOD( HOUR, 3 ) == 0 ) THEN
CALL READ_BBIO_DIURNALCYCLE( MONTH, DAY, HOUR, DOY )
ENDIF
ELSEIF ( LBIODAILY ) THEN
! ... otherwise use constant daily emissions of NEP for Bal Bio
IF ( ITS_A_NEW_DAY() ) THEN
CALL READ_BBIO_DAILYAVERAGE( MONTH, DAY, DOY )
ENDIF
ENDIF
!----------------------------------------------------------------
! Fluxes with "possible" monthly variability are called below
! In some cases the annual file is just called at the start
! of the month
!----------------------------------------------------------------
IF ( ITS_A_NEW_MONTH() ) THEN
! Fossil fuel emissions
IF ( LMONFF .OR. LANNFF .OR. LGENFF ) THEN
CALL READ_FOSSILCO2
ENDIF
! Oceanic exchange
IF ( LOCN1997 .OR. LOCN2009ANN .OR. LOCN2009MON ) THEN
CALL READ_OCEANCO2
ENDIF
! Ship emissions from EDGAR
IF ( LSHIPEDG ) CALL READ_SHIPCO2_EDGAR
! Ship emissions from ICOADS
IF ( LSHIPICO ) CALL READ_SHIPCO2_ICOADS
! Aircraft CO2 emissions
IF ( LPLANE ) CALL READ_AVIATION_CO2
! Get chemical source ! dbj
IF ( LCHEMCO2 ) THEN
CALL READ_CHEMCO2
CALL CHEM_SURF
CHEMSRC = CHEMCO2
ENDIF
ENDIF
!=================================================================
! Process emissions and save diagnostics
!=================================================================
! Loop over latitudes
!$OMP PARALLEL DO
!$OMP+DEFAULT( SHARED )
!$OMP+PRIVATE( I, J, L, A_CM2, E_CO2 ) ! dbj
DO J = 1, JJPAR
! Grid box surface area [cm2]
A_CM2 = GET_AREA_CM2( J )
! Loop over longitudes
DO I = 1, IIPAR
!-------------------------------------------
! #1: Total CO2
! #2: CO2 from fossil fuel emissions
!-------------------------------------------
IF ( LGENFF .or. LANNFF .or. LMONFF ) THEN
! Fossil fuel emissions of CO2 [molec/cm2/s]
E_CO2 = EMFOSSCO2(I,J)
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2ff > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2ff)
ENDIF
! ND04 diag: Fossil Fuel CO2 [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,1) = AD04(I,J,1) + E_CO2
ENDIF
! Convert from [molec/cm2/s] to [kg]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #2: Fossil CO2 [kg]
IF ( N_TRACERS > 1 ) THEN
STT(I,J,1,2) = STT(I,J,1,2) + E_CO2
! Split Fossil Fuel CO2 into geographic regions
IF ( LFOSSILTAG ) THEN
N = FOSSIL_REGION(I,J)
STT(I,J,1,N) = STT(I,J,1,N) + E_CO2
ENDIF
ENDIF
! Add to Tracer #12: Background with Fossil CO2 [kg]
IF ( LFFBKGRD ) THEN
STT(I,J,1,12) = STT(I,J,1,12) + E_CO2
ENDIF
! Note: To define the background as including fossil fuels here
! (instead of during data processing) for tagged-CO2 runs which
! will be used for estimating natural bio/ocean fluxes etc., and
! accepting the FF inventory
! use STT(I,J,1,12) = STT(I,J,1,12) + E_CO2.
! Shipping and aviation emissions can be included in a similar way.
ENDIF
!-------------------------------------------
! #3: CO2 from ocean exchange
!-------------------------------------------
IF ( LOCN1997 .or. LOCN2009ANN .or. LOCN2009MON ) THEN
! Ocean CO2 emissions in [molec/cm2/s]
E_CO2 = EMOCCO2(I,J)
! adj_group: apply scaling factors (dkh, 04/25/10)
! Now move this here so ND04 is correct (dkh, 02/08/12, adj32_018)
IF ( LADJ .and. IDADJ_ECO2ocn > 0 ) THEN
! dkh debug
IF ( I == IFD .and. J == JFD .and. LPRINTFD ) THEN
print*, ' ECO2onc fwd = ', E_CO2
print*, ' ECO2onc SF fwd = ',
& EMS_SF(I,J,M,IDADJ_ECO2ocn)
ENDIF
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2ocn)
ENDIF
! ND04 diag: Ocean CO2 [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,2) = AD04(I,J,2) + E_CO2
ENDIF
! Convert from [molec/cm2/s] to [kg]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #3: Ocean CO2 [kg]
IF ( N_TRACERS > 2 ) THEN
STT(I,J,1,3) = STT(I,J,1,3) + E_CO2
! Split ocean CO2 into geographic regions
IF ( LBIOSPHTAG ) THEN
N = OCEAN_REGION(I,J)
STT(I,J,1,N) = STT(I,J,1,N) + E_CO2
ENDIF
ENDIF
ENDIF
!-------------------------------------------
! #4: CO2 from balanced biosphere emissions
!-------------------------------------------
IF ( LBIODAILY .OR. LBIODIURNAL ) THEN
! Balanced biosphere CO2 [molec/cm2/s]
E_CO2 = EMBIOCO2(I,J)
! adj_group: apply scaling factors (dkh, 04/25/10)
! Now move this here so ND04 is correct (dkh, 02/08/12, adj32_018)
IF ( LADJ .and. IDADJ_ECO2bal > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2bal)
ENDIF
! ND04 diag: Bal Bio CO2 [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,3) = AD04(I,J,3) + E_CO2
ENDIF
! Convert from [molec/cm2/s] to [kg CO2]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1 -- total CO2 [kg CO2]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #4 -- Bal Bio CO2 [kg CO2]
IF ( N_TRACERS > 3 ) THEN
STT(I,J,1,4) = STT(I,J,1,4) + E_CO2
! Split biospheric CO2 exchange into geographic regions
IF ( LBIOSPHTAG ) THEN
N = BIOSPH_REGION(I,J)
STT(I,J,1,N) = STT(I,J,1,N) + E_CO2
ENDIF
ENDIF
ENDIF
!-------------------------------------------
! #5: CO2 from biomass burning emissions
!-------------------------------------------
IF ( LSEASBB .OR. LGFED2BB .OR. L8DAYBB .OR.
& LGFED3BB) THEN
! Biomass burning emissions [molec/cm2/s]
E_CO2 = BIOMASS(I,J,IDBCO2)
!E_CO2 = EMBIOBRNCO2(I,J)
!This was from older versions, see note above
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2bb > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2bb)
ENDIF
! ND04 diag: Biomass burning CO2 [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,4) = AD04(I,J,4) + E_CO2
ENDIF
! Convert from [molec/cm2/s] to [kg]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg CO2]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #5: Biomass burning CO2 [kg CO2]
IF ( N_TRACERS > 4 ) THEN
STT(I,J,1,5) = STT(I,J,1,5) + E_CO2
! Split Bioburn CO2 into geographic regions
IF ( LBIOSPHTAG ) THEN
N = BIOSPH_REGION(I,J)
STT(I,J,1,N) = STT(I,J,1,N) + E_CO2
ENDIF
ENDIF
ENDIF
!-------------------------------------------
! #6: CO2 from biofuel emissions
!-------------------------------------------
IF ( LBIOFUEL ) THEN
! Biofuel CO2 emissions [molec/cm2/s]
E_CO2 = EMBIOFUELCO2(I,J)
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2bf > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2bf)
ENDIF
! ND04 diag: Biofuel CO2 [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,5) = AD04(I,J,5) + E_CO2
ENDIF
! Convert E_CO2 from [molec CO2/cm2/s] to [kg CO2]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg CO2]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #6: Biofuel CO2 [kg CO2]
IF (N_TRACERS > 5) THEN
STT(I,J,1,6) = STT(I,J,1,6) + E_CO2
! Split BF CO2 into geographic regions
IF ( LBIOSPHTAG ) THEN
N = BIOSPH_REGION(I,J)
STT(I,J,1,N) = STT(I,J,1,N) + E_CO2
ENDIF
ENDIF
ENDIF
!-------------------------------------------
! #7: CO2 from net terrestrial exchange
!-------------------------------------------
IF ( LBIONETORIG .OR. LBIONETCLIM ) THEN
! CO2 from net terrestrial exchange [molec/cm2/s]
E_CO2 = EMBIONETCO2(I,J)
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2nte > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2nte)
ENDIF
! ND04 diag: net terrestrial exchange [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,6) = AD04(I,J,6) + E_CO2
ENDIF
! Convert from [molec/cm2/s] to [kg]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg CO2]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #7: Net Terr exchange CO2 [kg]
IF ( N_TRACERS > 6 ) THEN
STT(I,J,1,7) = STT(I,J,1,7) + E_CO2
! Split Net Terr Exch CO2 into geographic regions
IF ( LBIOSPHTAG ) THEN
N = BIOSPH_REGION(I,J)
STT(I,J,1,N) = STT(I,J,1,N) + E_CO2
ENDIF
ENDIF
ENDIF
!-------------------------------------------
! #8: CO2 from ship emissions
!-------------------------------------------
IF ( LSHIPEDG .OR. LSHIPICO ) THEN
! Ship CO2 emissions [molec/cm2/s]
E_CO2 = EMSHIPCO2(I,J)
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2shp > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2shp)
ENDIF
! ND04 diag: Ship CO2 [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,7) = AD04(I,J,7) + E_CO2
ENDIF
! Convert E_CO2 from [molec CO2/cm2/s] to [kg CO2]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg CO2]
STT(I,J,1,1) = STT(I,J,1,1) + E_CO2
! Add to Tracer #8: Ship CO2 [kg CO2]
IF (N_TRACERS > 7) THEN
STT(I,J,1,8) = STT(I,J,1,8) + E_CO2
! Tagged tracer for global ship emissions
IF ( LSHIPTAG ) THEN
STT(I,J,1,53) = STT(I,J,1,53) + E_CO2
ENDIF
ENDIF
! Add to Tracer #12: Background with Fossil CO2 [kg]
!-------------------------------------------
!IF ( LFFBKGRD ) THEN
! STT(I,J,1,12) = STT(I,J,1,12) + E_CO2
!ENDIF
!-------------------------------------------
! Uncomment to include ship CO2 emissions in the background
ENDIF
!-------------------------------------------
! #9: CO2 from aircraft emissions
!-------------------------------------------
IF ( LPLANE ) THEN
DO L = 1, LLPAR
! Aircraft CO2 emissions (3-D) [molec/cm3/s]
E_CO2 = EMPLANECO2(I,J,L)
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2pln > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2pln)
ENDIF
! ND04 diag: Aircraft CO2 [molec/cm3/s]
IF ( ND04 > 0 ) THEN
AD04_plane(I,J,L) = AD04_plane(I,J,L) + E_CO2
ENDIF
! Convert E_CO2 from [molec CO2/cm3/s] to [kg]
E_CO2 = E_CO2 * BOXVL(I,J,L) * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg CO2]
STT(I,J,L,1) = STT(I,J,L,1) + E_CO2
! Add to Tracer #9: Aircraft CO2 [kg CO2]
IF ( N_TRACERS > 8 ) THEN
STT(I,J,L,9) = STT(I,J,L,9) + E_CO2
! Tagged tracer for global ship emissions
IF ( LPLANETAG ) THEN
STT(I,J,L,54) = STT(I,J,L,54) + E_CO2
ENDIF
ENDIF
! Add to Tracer #12: Background with Fossil CO2 [kg]
!-------------------------------------------
!IF (LFFBKGRD) THEN
! STT(I,J,L,12) = STT(I,J,L,12) + E_CO2
!ENDIF
!-------------------------------------------
! Uncomment to include aviation CO2 emissions in the background
ENDDO
ENDIF
!-------------------------------------------
! #10 CO2 production from CO oxidation
!-------------------------------------------
IF ( LCHEMCO2 ) THEN
DO L = 1, LLPAR
E_CO2 = CHEMSRC(I,J,L)
! adj_group: apply scaling factors (dkh, 04/25/10)
IF ( LADJ .and. IDADJ_ECO2che > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2che)
ENDIF
! ND04 diag: CO2 chem source from CO loss (3-D) [molec/cm3/s]
IF ( ND04 > 0 ) THEN
AD04_chem(I,J,L) = AD04_chem(I,J,L) + E_CO2
ENDIF
! Convert from [molec/cm3/s] to [kg]
E_CO2 = E_CO2 * BOXVL(I,J,L) * DTSRCE / XNUMOL_CO2
! Add to Tracer #1: Total CO2 [kg CO2]
STT(I,J,L,1) = STT(I,J,L,1) + E_CO2
! Add to Tracer #10: Chemical Source of CO2 [kg CO2]
IF (N_TRACERS > 9) THEN
STT(I,J,L,10) = STT(I,J,L,10) + E_CO2
ENDIF
ENDDO
ENDIF
!-------------------------------------------
! #11 CO2 surface correction for CO oxidation
!-------------------------------------------
IF ( LCHEMCO2 ) THEN
E_CO2 = EMIS_SUB(I,J) ! EMIS_SUB is positive, but is subtracted
! adj_group: apply scaling factors (dkh, 04/25/10)
! Now move this here so ND04 is correct (dkh, 02/08/12, adj32_018)
IF ( LADJ .and. IDADJ_ECO2sur > 0 ) THEN
E_CO2 = E_CO2 * EMS_SF(I,J,M,IDADJ_ECO2sur)
ENDIF
! ND04 diag: CO2 chem source surface correction [molec/cm2/s]
IF ( ND04 > 0 ) THEN
AD04(I,J,10) = AD04(I,J,10) - E_CO2 ! SUBTRACT
ENDIF
! Convert E_CO2 from [molec CO2/cm2/s] to [kg CO2]
E_CO2 = E_CO2 * A_CM2 * DTSRCE / XNUMOL_CO2
! Subtract from Tracer #1: Total CO2 [kg CO2]
STT(I,J,1,1) = STT(I,J,1,1) - E_CO2
! Subtract from Tracer #11: Chem Source Surf Correction [kg CO2]
IF ( N_TRACERS > 10 ) THEN
STT(I,J,1,11) = STT(I,J,1,11) - E_CO2
ENDIF
ENDIF
!-------------------------------------------
! #12: Background CO2
!-------------------------------------------
! Background CO2 without fossil fuels is obtained by setting
! tracer 12 in the restart file, equal to tracer 1 at the start of
! a run. No sources or sinks (chemical or surface) act on this
! tracer if LFFBKGRD == FALSE, it is simply the advected intial CO2.
! To include fossil fuels in the background, see the first loop.
ENDDO
ENDDO
!$OMP END PARALLEL DO
END SUBROUTINE EMISSCO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_chemco2
!
! !DESCRIPTION: Reads the chemical source of CO2 [molec/cm3/s] from disk.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_CHEMCO2
!
! !USES:
!
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE BPCH2_MOD, ONLY : GET_MODELNAME, GET_RES_EXT
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE TIME_MOD, ONLY : GET_MONTH, GET_YEAR
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
!
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: YEAR, MONTH
REAL*4 :: ARRAY(IIPAR,JJPAR,LLPAR)
REAL*8 :: TAU
CHARACTER(LEN=4) :: YEAR_STR
CHARACTER(LEN=255) :: FILENAME
YEAR = GET_YEAR()
if (YEAR < 2000) then
YEAR = 2000
endif
MONTH = GET_MONTH()
TAU = GET_TAU0( MONTH, 1, YEAR )
WRITE( YEAR_STR, '(i4)' ) YEAR
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/ChemSrc/CO2_prod_rates_' //
& TRIM( YEAR_STR ) // '.' //
& TRIM( GET_MODELNAME() ) // '.' //
& GET_RES_EXT()
ARRAY = 0.0e0
Print*,'Reading CO2 Chem. production rates from file = ',
& trim(filename)
!=================================================================
! Read chemical source of CO2 [molec/cm3/s]
!=================================================================
CALL READ_BPCH2( FILENAME, 'PORL-L=$', 4,
& TAU, IIPAR, JJPAR,
& LLPAR, ARRAY, QUIET=.TRUE. )
! Cast from REAL*4 to REAL*8
! assume that incoming data is on the same vertical grid
CHEMCO2 = DBLE(ARRAY)
END SUBROUTINE READ_CHEMCO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_fossilco2
!
! !DESCRIPTION: Subroutine READ\_FOSSILCO2 reads in fossil fuel CO2
! emissions from a bpch file.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_FOSSILCO2
!
! !USES:
!
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 TRANSFER_MOD, ONLY : TRANSFER_2D
USE TIME_MOD, ONLY : GET_YEAR, GET_MONTH
USE LOGICAL_MOD, ONLY : LGENFF, LANNFF, LMONFF, LCHEMCO2, LPLANE
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! Original data provided by Robert Andres (CDIAC), personal communication
! .
! If GENFF=T, then annual data for 1995 are read (but tau is for 1985)
! If ANNFF=T, then annual data for a given year (1985-2006) are read
! If MONFF=T, then annual data for a given month (198501-200612) are read
! .
! ANNFF and MONFF for 2007-2009 were developed based on scaling using
! preliminary data on the CDIAC website for 2007-2008 and LeQuere et al.
! (2009) for 2009
! .
! -- Ray Nassar 2010-03-10
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Updated
! 25 Feb 2011 - R. Nassar - Now point to annual_v2010 and
! monthly_v2010 directories, which
! contain updated CO2 data from CDIAC
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, YEAR, MONTH
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: TAU, GLOB_SCL_FAC
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=4) :: YEAR_STR
CHARACTER(LEN=2) :: MONTH_STR
!=================================================================
! READ_FOSSILCO2 begins here!
!=================================================================
! Time variables
YEAR = GET_YEAR()
MONTH = GET_MONTH()
IF ( YEAR > 2006 ) THEN
WRITE( 6, 90 )
90 FORMAT('Fossil Fuel CO2 data for 2007-2009 are preliminary!')
ENDIF
IF ( YEAR > 2009 ) THEN
YEAR = 2009
WRITE( 6, 95 )
95 FORMAT( 'YEAR > 2009; Using Fossil CO2 emissions for 2009!')
ENDIF
WRITE( YEAR_STR, '(i4)' ) YEAR
WRITE( MONTH_STR, '(i2.2)' ) MONTH
IF ( LMONFF ) THEN
LGENFF = .FALSE.
LANNFF = .FALSE.
ENDIF
IF ( LANNFF ) THEN
LGENFF = .FALSE.
ENDIF
!=================================================================
! Filename and tau for fossil fuel CO2 data
!=================================================================
IF ( LGENFF ) THEN
TAU = GET_TAU0( 1, 1, 1985 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/fossil95_CO2.' // GET_NAME_EXT_2D() //
& '.' // GET_RES_EXT()
WRITE( 6, 100 ) TRIM( FILENAME )
ELSE IF ( LANNFF ) THEN
TAU = GET_TAU0( 1, 1, YEAR )
FILENAME = TRIM( DATA_DIR ) //
!------------------------------------------------------------------------------
! Prior to 2/25/11:
! Now use updated CO2 annual emissions from CDIAC (cf Bob Andres)
! (rnassar, bmy, 2/25/11)
! & 'CO2_201003/fossilfuel_andres/annual/ff.' //
!------------------------------------------------------------------------------
& 'CO2_201003/fossilfuel_andres/annual_v2010/ff.' //
& YEAR_STR // '.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
WRITE( 6, 110 ) TRIM( FILENAME )
ELSE IF ( LMONFF ) THEN
TAU = GET_TAU0( MONTH, 1, YEAR )
FILENAME = TRIM( DATA_DIR ) //
!------------------------------------------------------------------------------
! Prior to 2/25/11:
! Now use updated CO2 annual emissions from CDIAC (cf Bob Andres)
! (rnassar, bmy, 2/25/11) //
! & 'CO2_201003/fossilfuel_andres/monthly/ff.' //
!------------------------------------------------------------------------------
& 'CO2_201003/fossilfuel_andres/monthly_v2010/ff.'//
& YEAR_STR // MONTH_STR // '.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
WRITE( 6, 120 ) TRIM( FILENAME )
ENDIF
! FORMATS
100 FORMAT( ' - READ_GENERIC_FOSSCO2: Reading ', a )
110 FORMAT( ' - READ_ANNUAL_FOSSCO2: Reading ', a )
120 FORMAT( ' - READ_MONTHLY_FOSSCO2: Reading ', a )
!=================================================================
! Read fossil fuel CO2 [molec/cm2/s]
!=================================================================
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 1,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
! Cast from REAL*4 to REAL*8
CALL TRANSFER_2D( ARRAY(:,:,1), EMFOSSCO2 )
IF ( LPLANE ) THEN
CALL AVIATION_DOM_CORR( EMFOSSCO2 )
ENDIF
END SUBROUTINE READ_FOSSILCO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: chem_surf
!
! !DESCRIPTION: This subroutine reads the fossil fuel distribution from
! file to be used for part of the spatial distribution of the CO2 surface
! correction, based on a value of 4.89%, similar to that used in
! Suntharalingam et al. (2005).
!\\
!\\
! !INTERFACE:
!
SUBROUTINE CHEM_SURF
!
! !USES:
!
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE LOGICAL_MOD, ONLY : LGENFF, LANNFF, LMONFF
USE TRANSFER_MOD, ONLY : TRANSFER_2D
USE TIME_MOD, ONLY : GET_YEAR,GET_MONTH
USE GRID_MOD, ONLY : GET_AREA_CM2
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! Methane source distribution are read for the same purpose from 2004 data
! provided by Kevin Wecht.
! .
! Monoterpenes and Isoprene are read and treated as representative NMVOCs.
! .
! -- Ray Nassar 2010-03-27
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
! 25 Feb 2011 - R. Nassar - Now point to annual_v2010 and
! monthly_v2010 directories, which
! contain updated CO2 data from CDIAC
!EOP!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=4) :: YEAR_STR
CHARACTER(LEN=2) :: MONTH_STR
INTEGER :: I, J, YEAR, MONTH
INTEGER, PARAMETER :: NDAYS2004(12) = (/31,29,31,30,31,30,
& 31,31,30,31,30,31/)
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
REAL*8 :: TAU, MONFAC, NMHCFAC, A_CM2(JJPAR)
REAL*8 :: FOSS_MASS(IIPAR,JJPAR), FOSS_SUM
REAL*8 :: LIVE_MASS(IIPAR,JJPAR), LIVE_SUM
REAL*8 :: WASTE_MASS(IIPAR,JJPAR), WASTE_SUM
REAL*8 :: RICE_MASS(IIPAR,JJPAR), RICE_SUM
REAL*8 :: WET_MASS(IIPAR,JJPAR), WET_SUM
REAL*8 :: OTHER_MASS(IIPAR,JJPAR), OTHER_SUM
REAL*8 :: ISO_MASS(IIPAR,JJPAR), ISO_SUM
REAL*8 :: MONO_MASS(IIPAR,JJPAR), MONO_SUM
REAL*8 :: TOT_MASS(IIPAR,JJPAR), TOT_SUM
REAL*8 :: FOSSIL_CORR(IIPAR,JJPAR)
REAL*8 :: LIVE_CORR(IIPAR,JJPAR)
REAL*8 :: WASTE_CORR(IIPAR,JJPAR)
REAL*8 :: RICE_CORR(IIPAR,JJPAR)
REAL*8 :: WET_CORR(IIPAR,JJPAR)
REAL*8 :: OTHER_CORR(IIPAR,JJPAR)
REAL*8 :: ISO_CORR(IIPAR,JJPAR)
REAL*8 :: MONO_CORR(IIPAR,JJPAR)
REAL*8, PARAMETER :: PERCENT_CORRECTION = 4.89d0
!For # molecules <--> mass in kg
REAL*8, PARAMETER :: CH4FAC = 6.022d23/16d-3
REAL*8, PARAMETER :: CFAC = 6.022d23/12d-3
!-----------------------------------------------------------------
! Get month and year
!-----------------------------------------------------------------
MONTH = GET_MONTH()
YEAR = GET_YEAR()
WRITE( YEAR_STR, '(i4)' ) YEAR
WRITE( MONTH_STR, '(i2.2)' ) MONTH
DO J = 1, JJPAR
A_CM2(J) = GET_AREA_CM2(J)
ENDDO
!-----------------------------------------------------------------
! Read Generic or annual or monthly fossil fuel emissions file
!-----------------------------------------------------------------
IF ( LMONFF ) THEN
LGENFF = .FALSE.
LANNFF = .FALSE.
ENDIF
IF ( LANNFF ) THEN
LGENFF = .FALSE.
ENDIF
IF ( LGENFF ) THEN
TAU = GET_TAU0( 1, 1, 1985 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/fossil95_CO2.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ELSE IF ( LANNFF ) THEN
TAU = GET_TAU0( 1, 1, YEAR )
FILENAME = TRIM( DATA_DIR ) //
!------------------------------------------------------------------------------
! Prior to 2/25/11:
! Now use updated CO2 annual emissions from CDIAC (cf Bob Andres)
! (rnassar, bmy, 2/25/11)
! & 'CO2_201003/fossilfuel_andres/annual/ff.' //
!------------------------------------------------------------------------------
& 'CO2_201003/fossilfuel_andres/annual_v2010/ff.' //
& YEAR_STR // '.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ELSE IF ( LMONFF ) THEN
TAU = GET_TAU0( MONTH, 1, YEAR )
FILENAME = TRIM( DATA_DIR ) //
!------------------------------------------------------------------------------
! Prior to 2/25/11:
! Now use updated CO2 annual emissions from CDIAC (cf Bob Andres)
! (rnassar, bmy, 2/25/11)
! & 'CO2_201003/fossilfuel_andres/monthly/ff.' //
!------------------------------------------------------------------------------
& 'CO2_201003/fossilfuel_andres/monthly_v2010/ff.' //
& YEAR_STR // MONTH_STR // '.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ENDIF
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 1,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
DO J = 1, JJPAR
DO I = 1, IIPAR
FOSSIL_corr(I,J) = (PERCENT_CORRECTION/100d0)*ARRAY(I,J,1)
ENDDO
ENDDO
!-----------------------------------------------------------------
! Read Monthly CH4 emissions
!-----------------------------------------------------------------
TAU = GET_TAU0( MONTH, 1, 2004 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/ChemSrc/CH4_source.' //
& GET_NAME_EXT_2D() // '.' //
& GET_RES_EXT()
! %%% Livestock %%%
WRITE( 6, 40 ) TRIM( FILENAME )
40 FORMAT( ' - READ_LIVESTOCK: Reading ', a )
CALL READ_BPCH2( FILENAME, 'CH4-EMIS', 4,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), LIVE_MASS)
! %%% Waste %%%
WRITE( 6, 50 ) TRIM( FILENAME )
50 FORMAT( ' - READ_WASTE: Reading ', a )
CALL READ_BPCH2( FILENAME, 'CH4-EMIS', 5,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), WASTE_MASS)
! %%% Rice %%%
WRITE( 6, 60 ) TRIM( FILENAME )
60 FORMAT( ' - READ_RICE: Reading ', a )
CALL READ_BPCH2( FILENAME, 'CH4-EMIS', 7,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), RICE_MASS)
! %%% Wetlands %%%
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_WETLANDS: Reading ', a )
CALL READ_BPCH2( FILENAME, 'CH4-EMIS', 10,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), WET_MASS)
! %%% Natural %%%
WRITE( 6, 120 ) TRIM( FILENAME )
120 FORMAT( ' - READ_OTHER_NATURAL: Reading ', a )
CALL READ_BPCH2( FILENAME, 'CH4-EMIS', 12,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), OTHER_MASS)
!-----------------------------------------------------------------
! Print raw monthly totals in Tg CH4
!-----------------------------------------------------------------
LIVE_SUM = sum(LIVE_MASS(:,:)*1d-9)
WASTE_SUM = sum(WASTE_MASS(:,:)*1d-9)
RICE_SUM = sum(RICE_MASS(:,:)*1d-9)
WET_SUM = sum(WET_MASS(:,:)*1d-9)
OTHER_SUM = sum(OTHER_MASS(:,:)*1d-9)
write(6,200) " GLOBAL LIVESTOCK ", LIVE_SUM, " TgCH4/month"
write(6,200) " GLOBAL WASTE ", WASTE_SUM," TgCH4/month"
write(6,200) " GLOBAL RICE ", RICE_SUM, " TgCH4/month"
write(6,200) " GLOBAL WETLANDS ", WET_SUM, " TgCH4/month"
write(6,200) " GLOBAL OTHER NATURAL", OTHER_SUM," TgCH4/month"
!-----------------------------------------------------------------
! Convert kg/gridbox/month to molecules/cm2/s
!-----------------------------------------------------------------
MONFAC = ndays2004(month)*86400d0
DO J = 1, JJPAR
DO I = 1, IIPAR
LIVE_CORR(I,J) = LIVE_MASS(I,J)*CH4FAC/MONFAC/A_CM2(J)
WASTE_CORR(I,J) = WASTE_MASS(I,J)*CH4FAC/MONFAC/A_CM2(J)
RICE_CORR(I,J) = RICE_MASS(I,J)*CH4FAC/MONFAC/A_CM2(J)
WET_CORR(I,J) = WET_MASS(I,J)*CH4FAC/MONFAC/A_CM2(J)
OTHER_CORR(I,J) = OTHER_MASS(I,J)*CH4FAC/MONFAC/A_CM2(J)
ENDDO
ENDDO
!-----------------------------------------------------------------
! Read Monthly Isoprene emissions
!-----------------------------------------------------------------
TAU = GET_TAU0( MONTH, 1, 2004 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/ChemSrc/Isoprene-2004.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
WRITE( 6, 150 ) TRIM( FILENAME )
150 FORMAT( ' - READ_ISOPRENE: Reading ', a )
CALL READ_BPCH2( FILENAME, 'BIOGSRCE', 1,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), ISO_corr)
!-----------------------------------------------------------------
! Read Monthly Monoterpene emissions
!-----------------------------------------------------------------
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/ChemSrc/Monoterpene-2004.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
WRITE( 6, 160 ) TRIM( FILENAME )
160 FORMAT( ' - READ_MONOTERPENE: Reading ', a )
! NOTE: use same TAU0 as for isoprene
CALL READ_BPCH2( FILENAME, 'BIOGSRCE', 4,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
CALL TRANSFER_2D( ARRAY(:,:,1), MONO_corr)
!-----------------------------------------------------------------
! Take the sum of all surface corrections.
!-----------------------------------------------------------------
! NMHCFAC is a scale factor which combines the CO yield from
! monoterpenes and isoprenes (~0.2) but increase it to use their
! spatial distribution as a proxy for other NMHCs.
!-----------------------------------------------------------------
NMHCFAC = 0.333d0
DO J = 1, JJPAR
DO I = 1, IIPAR
EMIS_SUB(I,J) = FOSSIL_corr(I,J)
& + LIVE_corr(I,J)
& + WASTE_corr(I,J)
& + RICE_corr(I,J)
& + WET_corr(I,J)
& + OTHER_corr(I,J)
& + ISO_corr(I,J)*NMHCFAC
& + MONO_corr(I,J)*NMHCFAC
ENDDO
ENDDO
!-----------------------------------------------------------------
DO J = 1, JJPAR
DO I = 1, IIPAR
FOSS_MASS(I,J) = FOSSIL_CORR(I,J)*A_CM2(J)*MONFAC/CFAC
ISO_MASS(I,J) = ISO_CORR(I,J)*A_CM2(J)*NMHCFAC*MONFAC/CFAC
MONO_MASS(I,J) = MONO_CORR(I,J)*A_CM2(J)*NMHCFAC*MONFAC/CFAC
TOT_MASS(I,J) = EMIS_SUB(I,J)*A_CM2(J)*MONFAC/CFAC
ENDDO
ENDDO
FOSS_SUM = sum(FOSS_MASS(:,:)*1d-9)
ISO_SUM = sum(ISO_MASS(:,:)*1d-9)
MONO_SUM = sum(MONO_MASS(:,:)*1d-9)
TOT_SUM = sum(TOT_MASS(:,:)*1d-9)
write(6,200) " GLOBAL FOSS CORR ", FOSS_SUM, " TgC/month"
write(6,200) " GLOBAL ISOPRENE ", ISO_SUM, " TgC/month"
write(6,200) " GLOBAL MONTERPENE ", MONO_SUM, " TgC/month"
write(6,200) " GLOBAL TOTAL SURF CORR ", TOT_SUM, " TgC/month"
200 FORMAT( A, F9.5, A )
END SUBROUTINE CHEM_SURF
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: aviation_dom_corr
!
! !DESCRIPTION: This subroutine downscales national fossil fuels emissions
! for the CO2 which is atttibuted to domestic aviation based on Kim et al.
! (2005,2007). It should only be used when the aviation emissions are
! turned on since these emissions will instead be emitted throughout the
! troposphere.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE AVIATION_DOM_CORR( EMFOSS )
!
! !USES:
!
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE LOGICAL_MOD, ONLY : LGENFF
USE TRANSFER_MOD, ONLY : TRANSFER_2D
USE TIME_MOD, ONLY : GET_YEAR, ITS_A_LEAPYEAR
USE GRID_MOD, ONLY : GET_AREA_CM2
# include "CMN_SIZE" ! Size parameters
!
! !INPUT PARAMETERS:
!
REAL*8, INTENT(INOUT) :: EMFOSS(IIPAR,JJPAR) ! Fuel to be scaled
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
! 25 Feb 2011 - R. Nassar - Now point to annual_v2010 and
! monthly_v2010 directories, which
! contain updated CO2 data from CDIAC
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=4) :: YEAR_STR
INTEGER :: I, J, N, YEAR, NDAYS
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
REAL*4 :: REGION(IIPAR,JJPAR)
REAL*8 :: TAU, U_CONV
REAL*8 :: DOM_COR(8), REG_SUM(8), AV_SCLFAC(8)
REAL*8 :: ANN_FOSS(IIPAR,JJPAR), A_CM2(JJPAR)
REAL*8 :: ANN_FOSS_NOAREA(IIPAR,JJPAR)
!-----------------------------------------------------------------
! Read Generic or annual fossil fuel emissions file
!-----------------------------------------------------------------
YEAR = GET_YEAR()
WRITE( YEAR_STR, '(i4)' ) YEAR
print*, " Staring Domestic Aviation Correction"
IF ( LGENFF ) THEN
TAU = GET_TAU0( 1, 1, 1985 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/fossil95_CO2.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ELSE
TAU = GET_TAU0( 1, 1, YEAR )
FILENAME = TRIM( DATA_DIR ) //
!------------------------------------------------------------------------------
! Prior to 2/25/11:
! Now use updated CO2 annual emissions from CDIAC (cf Bob Andres)
! (rnassar, bmy, 2/25/11)
! & 'CO2_201003/fossilfuel_andres/annual/ff.' //
!------------------------------------------------------------------------------
& 'CO2_201003/fossilfuel_andres/annual_v2010/ff.'//
& YEAR_STR // '.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ENDIF
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 1,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
! Cast from REAL*4 to REAL*8
CALL TRANSFER_2D( ARRAY(:,:,1), ANN_FOSS )
!-----------------------------------------------------------------
! Calculate box areas, covert to area-independent emission mass
! i.e. molecules/cm2/s --> Tg/gridbox/year
!-----------------------------------------------------------------
NDAYS = 365
IF ( ITS_A_LEAPYEAR() ) NDAYS = 366
U_CONV = NDAYS*86400*(12./6.022D23)*1D-12
DO J = 1, JJPAR
A_CM2(J) = GET_AREA_CM2(J)
ANN_FOSS_NOAREA(:,J) = ANN_FOSS(:,J)*A_CM2(J)*U_CONV
ENDDO
!-----------------------------------------------------------------
! Read region/continent file
!-----------------------------------------------------------------
TAU = GET_TAU0( 1, 1, 2004 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/Aviation_Regions.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 1,
& TAU, IIPAR, JJPAR,
& 1, REGION, QUIET=.TRUE. )
!-----------------------------------------------------------------
! Sum fossil fuel CO2 (as C) in each region
!-----------------------------------------------------------------
REG_SUM(:) = 0d0
DO J = 1, JJPAR
DO I = 1, IIPAR
DO N = 1, 8
IF ( NINT(REGION(I,J) ) == N ) THEN
REG_SUM(N) = REG_SUM(N) + ANN_FOSS_NOAREA(I,J)
ENDIF
ENDDO
ENDDO
ENDDO
!-----------------------------------------------------------------
! Mean domestic CO2 from aviation for 2000-2004 in TgC/yr
! from Kim et al. (2005). See report or bpch for exact regions.
!-----------------------------------------------------------------
DOM_COR(1) = 49.6 ! North America
DOM_COR(2) = 2.8 ! South America
DOM_COR(3) = 1.8 ! Eastern Europe
DOM_COR(4) = 12.3 ! Western Europe
DOM_COR(5) = 16.1 ! Asia
DOM_COR(6) = 1.0 ! Africa
DOM_COR(7) = 2.2 ! MiddleEast
DOM_COR(8) = 2.0 ! Oceania
!-----------------------------------------------------------------
! Calculate aviation scale factors then apply them
!-----------------------------------------------------------------
DO N = 1,8
AV_SCLFAC(N) = (REG_SUM(N) - DOM_COR(N)) / REG_SUM(N)
ENDDO
print*, " Scaling down EMFOSS "
DO J = 1, JJPAR
DO I = 1, IIPAR
DO N = 1, 8
IF (NINT(REGION(I,J))==N) EMFOSS(I,J) = EMFOSS(I,J)*AV_SCLFAC(N)
ENDDO
ENDDO
ENDDO
print*,
& " Domestic Aviation CO2 subtracted from land fossil fuel CO2"
END SUBROUTINE AVIATION_DOM_CORR
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_oceanco2
!
! !DESCRIPTION: Subroutine READ\_OCEANCO2 reads in either
!
! \begin{itemize}
! \item Annual mean oceanic CO2 exchange from Takahashi 1997
! \item Annual mean oceanic CO2 exchange from Takahashi 2009
! \item Aonthly mean oceanic CO2 exchange from Takahashi 2009
! \end{itemize}
!
! from a binary punch file.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_OCEANCO2
!
! !USES:
!
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 TIME_MOD, ONLY : GET_MONTH
USE TRANSFER_MOD, ONLY : TRANSFER_2D
USE LOGICAL_MOD, ONLY : LOCN1997, LOCN2009ANN, LOCN2009MON
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! See References Above
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Updated
! 25 Feb 2011 - R. Nassar - Now point to annual_v2010 and
! monthly_v2010 directories, which
! contain updated CO2 data from CDIAC
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, MONTH
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: TAU
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=2) :: MONTH_STR
!=================================================================
! READ_OCEANCO2 begins here!
!=================================================================
MONTH = GET_MONTH()
WRITE( MONTH_STR, '(i2.2)' ) MONTH
IF ( LOCN1997 ) THEN
! Start of "generic" year 1985
TAU = GET_TAU0( 1, 1, 1985 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/ocean_CO2.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ELSE IF ( LOCN2009ANN ) THEN
! Start of "generic" year 2000
TAU = GET_TAU0( 1, 1, 2000 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/Ocean/Taka2009_OceanCO2_annual.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ELSE IF ( LOCN2009MON ) THEN
! Start of "generic" month in 2000
TAU = GET_TAU0( MONTH, 1, 2000 )
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/Ocean/Taka2009_OceanCO2_' //
& MONTH_STR // '.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
ENDIF
WRITE( 6, 100 ) TRIM( FILENAME )
! Read ocean CO2 data [molec/cm2/s]
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 2,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize if necessary
CALL TRANSFER_2D( ARRAY(:,:,1), EMOCCO2 )
! Return to calling program
100 FORMAT( ' - READ_OCEANCO2: Reading ', a )
END SUBROUTINE READ_OCEANCO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_annual_biofuelco2
!
! !DESCRIPTION: Subroutine READ\_ANNUAL\_BIOFUELCO2 reads in annual mean
! biofuel CO2 emissions from a binary punch file.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_ANNUAL_BIOFUELCO2
!
! !USES:
!
! 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 TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! References:
! (1 ) Yevich and Logan 2001 gridded (1x1) dataset in combination with
! emission factors for CO2 per kg drymatter burned
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Updated
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J
! adj_group: (zhej, dkh, 01/17/12, adj32_015)
!REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
REAL*8 :: TAU
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_ANNUAL_BIOFUELCO2 begins here!
! Use 1985 emissions or 1995 scaled values
! "Burn in fields" not included (this is already in GFED)
!=================================================================
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/biofuel/biofuel_CO2.' //
& GET_NAME_EXT_2D() // '.' //
& GET_RES_EXT() // '-1995'
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_ANNUAL_BIOFUELCO2: Reading ', a )
! TAU = GET_TAU0( 1, 1, 1985 )
TAU = GET_TAU0( 1, 1, 1995 )
! Read biofuel CO2 emissions [molec/cm2/s]
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 5,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
! Cast from REAL*4 to REAL*8 and resize
CALL TRANSFER_2D( ARRAY(:,:,1), EMBIOFUELCO2 )
END SUBROUTINE READ_ANNUAL_BIOFUELCO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_shipco2_edgar
!
! !DESCRIPTION: Subroutine READ\_SHIPCO2\_EDGAR reads in annual mean ship CO2
! emissions from a binary punch file. Scaling is based on Endresen et al.
! (2007).
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_SHIPCO2_EDGAR
!
! !USES:
!
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, DATA_DIR_1x1
USE TRANSFER_MOD, ONLY : TRANSFER_2D
USE REGRID_1x1_MOD, ONLY : DO_REGRID_G2G_1x1, DO_REGRID_1x1
USE GRID_MOD, ONLY : GET_AREA_CM2
USE TIME_MOD, ONLY : GET_YEAR
# include "CMN_SIZE" ! Size parameters
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, N, YEAR
REAL*4 :: A_CM2(JJPAR)
REAL*4 :: ARRAY(360,180,1)
REAL*8 :: GEN_1x1(360,180,1)
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
REAL*8 :: GEOS_GRID(IIPAR,JJPAR,1)
REAL*8 :: TAU
REAL*8, PARAMETER :: SEC_IN_YEAR = 86400d0 * 365.25d0
REAL*8, PARAMETER :: GlobSTot = 0.117
! EDGAR global total value in PgC/yr
REAL*8 :: GlobSTotNew(25)
! For scaling to a specified global total PgC/yr
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_SHIPCO2_EDGAR begins here!
!=================================================================
YEAR = GET_YEAR()
! Fill array
DO J = 1, JJPAR
A_CM2(J) = GET_AREA_CM2( J )
ENDDO
! File contaning EDGAR ship CO2 data
FILENAME = TRIM( DATA_DIR_1x1 ) //
& 'ARCTAS_SHIP_2008/Arctas_CO2_ship_2008.generic.1x1'
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_ANNUAL_SHIP_CO2_EDGAR: Reading ', a )
! TAU value for start of 2008
TAU = GET_TAU0( 1, 1, 2008 )
! Read CO2 shipping emissions [kg/yr]
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 1,
& TAU, 360, 180,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 before regridding
GEN_1x1(:,:,1) = ARRAY(:,:,1)
! Regrid from GENERIC 1x1 --> GEOS 1x1
CALL DO_REGRID_G2G_1x1( 'kg/yr', GEN_1x1, GEOS_1x1 )
! Regrid from GEOS 1x1 --> current model resolution
CALL DO_REGRID_1x1( 1, 'kg/yr', GEOS_1x1, GEOS_GRID)
! Convert units kg CO2 / yr --> molecules/cm2/s
DO J = 1, JJPAR
EMSHIPCO2(:,J) = GEOS_GRID(:,J,1) * 6.022E23
& / ( 44.0d-3 * SEC_IN_YEAR * A_CM2(J))
ENDDO
!-----------------------------------------------------------------
! Global Ship Totals for the years 1985 to 2009
!-----------------------------------------------------------------
! These were based on a linear fit to 1985 to 2002
! values from Endresen et al. (2007)
! The 2007 value was used for 2009 similar to the case for
! overall fossil fuel use related to the recession
! We have not attempted to extrapolate beyond 2009
!-----------------------------------------------------------------
! Values are essentially all international (domestic negligible)
!-----------------------------------------------------------------
GlobSTotNew(1:25) = (/ 0.122, 0.125, 0.128, 0.132, 0.135,
& 0.138, 0.141, 0.144, 0.148, 0.151,
& 0.154, 0.157, 0.160, 0.163, 0.167,
& 0.170, 0.173, 0.176, 0.179, 0.182,
& 0.186, 0.189, 0.192, 0.195, 0.192 /)
IF (YEAR <= 1985) THEN
n = 1
ELSEIF (YEAR >= 2009) THEN
n = 25
ELSE
n = YEAR - 1985 + 1
ENDIF
! Apply scaling to obtain a specified yearly global total
DO J = 1, JJPAR
EMSHIPCO2(:,J) = EMSHIPCO2(:,J)*(GlobSTotNew(n)/GlobSTot)
ENDDO
END SUBROUTINE READ_SHIPCO2_EDGAR
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_shipco2_icoads
!
! !DESCRIPTION: Subroutine READ\_SHIPCO2\_ICOADS reads in ICOADS monthly
! ship CO2 emissions
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_SHIPCO2_ICOADS
!
! !USES:
!
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, DATA_DIR_1x1
USE TRANSFER_MOD, ONLY : TRANSFER_2D
USE FILE_MOD, ONLY : IU_FILE, IOERROR
USE REGRID_1x1_MOD, ONLY : DO_REGRID_G2G_1x1, DO_REGRID_1x1
USE GRID_MOD, ONLY : GET_AREA_CM2
USE TIME_MOD, ONLY : GET_YEAR, GET_MONTH
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! This subroutine reads from bpch files at GEOS 1x1 (half-polar) resolution
! although the original data are provided as 0.1 deg x 0.1 deg. Regridding to
! the current resolution is carried out in the code.
! .
! References:
! (1) Corbett and Koehler (2003) "Updated emissions from ocean shipping",
! JGR 108, D20, 4650.
! (2) Corbett and Koehler (2004) "Considering alternative input parameters in
! an activity-based ship fuel consumption and emissions model: Reply ..."
! JGR, 109, D23303.
! (3) Endresen et al. (2007) "A historical reconstruction of ships fuel
! consumption and emissions", JGR, 112, D12301.
! .
! NOTE: The Corbett website values do not sum to the values in any Corbett
! et al. or Wang (2008) papers. It is not clear if this relates to the
! ongoing dispute between Corbett et al.(2003,2004) and Endresen et al.
! (2003,2004,2007)
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, MONTH, YEAR, IOS, N
REAL*4 :: A_CM2(JJPAR)
! adj_group: (zhej, dkh, 01/17/12, adj32_015)
!REAL*4 :: ARRAY(360,181,1)
REAL*4 :: ARRAY(I1x1,J1x1,1)
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
REAL*8 :: GEOS_GRID(IIPAR,JJPAR,1)
REAL*8 :: TAU
REAL*8, PARAMETER :: SEC_IN_YEAR = 86400d0 * 365.25d0
REAL*8, PARAMETER :: GlobSTot = 0.1760
!ICOADS global total value in PgC/yr
REAL*8 :: GlobSTotNew(25)
!For scaling to a specified global total PgC/yr
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=2) :: MONTH_STR
!=================================================================
! READ_SHIPCO2_ICOADS begins here!
!=================================================================
! Fill array
DO J = 1, JJPAR
A_CM2(J) = GET_AREA_CM2( J )
ENDDO
YEAR = GET_YEAR()
MONTH = GET_MONTH()
WRITE( MONTH_STR, '(i2.2)' ) MONTH
FILENAME = TRIM( DATA_DIR_1x1 ) //
& 'CO2_201003/ship_ICOADS/co2_' //
& MONTH_STR // '.geos.1x1'
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_MONTHLY_SHIP_CO2_ICOADS: Reading ', a )
! TAU value for start of month in 2004
TAU = GET_TAU0( MONTH, 1, 2004 )
! Read CO2 shipping emissions
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 7,
& TAU, 360, 181,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 before regridding
GEOS_1x1(:,:,1) = ARRAY(:,:,1)
! Regrid to current model resolution
CALL DO_REGRID_1x1( 1, 'molec/cm2/s', GEOS_1x1, GEOS_GRID )
DO J = 1, JJPAR
EMSHIPCO2(:,J) = GEOS_GRID(:,J,1)
ENDDO
!-----------------------------------------------------------------
! Global Ship Totals for the years 1985 to 2009
!-----------------------------------------------------------------
! These were based on a linear fit to 1985 to 2002
! values from Endresen et al. (2007)
! The 2007 value was used for 2009 similar to the case for
! overall fossil fuel use related to the recession
! We have not attempted to extrapolate beyond 2009
!-----------------------------------------------------------------
! Values are essentially all international (domestic negligible)
!-----------------------------------------------------------------
GlobSTotNew(1:25) = (/ 0.122, 0.125,0.128, 0.132, 0.135,
& 0.138, 0.141,0.144, 0.148, 0.151,
& 0.154, 0.157,0.160, 0.163, 0.167,
& 0.170, 0.173,0.176, 0.179, 0.182,
& 0.186, 0.189,0.192, 0.195, 0.192 /)
IF ( YEAR <= 1985 ) THEN
n = 1
ELSEIF ( YEAR >= 2009 ) THEN
n = 25
ELSE
n = YEAR - 1985 + 1
ENDIF
! Apply scaling to obtain a specified yearly global total
DO J = 1, JJPAR
EMSHIPCO2(:,J) = EMSHIPCO2(:,J)*(GlobSTotNew(n)/GlobSTot)
ENDDO
END SUBROUTINE READ_SHIPCO2_ICOADS
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_aviation_co2
!
! !DESCRIPTION: Subroutine READ\_AVIATION\_CO2 reads monthly mean aircraft
! fuel emissions and converts them to CO2 emissions.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_AVIATION_CO2
!
! !USES:
!
! Reference to F90 modules
USE BPCH2_MOD, ONLY : GET_RES_EXT, GET_TAU0, READ_BPCH2
USE DAO_MOD, ONLY : BXHEIGHT
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FILE_MOD, ONLY : IU_FILE, IOERROR
USE TIME_MOD, ONLY : GET_MONTH, GET_YEAR
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! This is a modified version of READ_AIRCRAFT_SO2 from:
! rjp, bdf, bmy, 9/18/02, 10/3/05
! .
! The sulfate data are based on an inventory by the Atmospheric Effects of
! Aviation Project (AEAP) for the year 1992.
! .
! CO2 emission factor of 3155 g/kg fuel was taken from
! (1) Kim et al. (2005) System for assessing Aviation's Global Emissions
! (SAGE) Federal Aviation Administration Office of Environment and
! Energy Version 1.5 (FAA-EE-2005-02), Global Aviation Emissions
! Inventories for 2000 through 2004.
! (2) Kim et al. (2007) System for assessing Aviation's Global Emissions
! (SAGE) Part 1: Model description and inventory results
!
! !REVISION HISTORY:
! (1 ) Extracted from old module routine SULFATE_READMON (bmy, 9/18/02)
! (2 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
! (3 ) Now read files from "sulfate_sim_200508/". Now read data for both
! GCAP and GEOS grids (bmy, 8/16/05)
! (4 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
! (6 ) Reading of GlobPTot values from input.geos has not yet been implemented
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, IOS, J, K, L, THISMONTH, N, YEAR
REAL*8 :: ACCO2(IGLOB,JGLOB,20)
REAL*8 :: FAC, FUEL, DZ(LLPAR), ZH(0:LLPAR)
REAL*8, PARAMETER :: TINY = 1d-20
REAL*8, EXTERNAL :: BOXVL
! For scaling to a specified global total PgC/yr
REAL*8, PARAMETER :: GlobPTot = 0.12 !1992 AEAP estimate
REAL*8 :: GlobPTotNew(22)
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=3) :: CMONTH(12) = (/'jan', 'feb', 'mar', 'apr',
& 'may', 'jun', 'jul', 'aug',
& 'sep', 'oct', 'nov', 'dec'/)
!=================================================================
! READ_AVIATION_CO2 begins here!
!=================================================================
! Zero arrays
EMPLANECO2 = 0d0
ACCO2 = 0d0
THISMONTH = GET_MONTH()
! File name
FILENAME = TRIM( DATA_DIR ) //
& 'sulfate_sim_200508/aircraft.' // GET_RES_EXT() //
& '.1992.' // CMONTH(THISMONTH)
! Echo output
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_AVIATION_CO2: Reading ', a )
!=================================================================
! Read aircraft emissions. These are fuel burned in [kg/box/day],
! from AEAP for 1992. CO2 emission is calculated by assuming
! an emission index EI of 3155, i.e., 3155 g of CO2 emitted per kg
! of fuel burned. It is also assumed that there is no diurnal
! variation of emission rate. Convert to [kg CO2/box/s].
!=================================================================
! Open file
OPEN( IU_FILE, FILE=FILENAME, STATUS='OLD', IOSTAT=IOS )
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_aviation_co2:1' )
! Read header line
READ( IU_FILE, '(/)', IOSTAT=IOS )
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_aviation_co2:2' )
! Read data values until an EOF is found
DO
READ( IU_FILE, '(3i4,e11.3)', IOSTAT=IOS ) I, J, L, FUEL
! EOF encountered
IF ( IOS < 0 ) EXIT
! I/O error condition
IF ( IOS > 0 ) THEN
CALL IOERROR( IOS, IU_FILE, 'read_aviation_co2:3' )
ENDIF
! Unit conversion: [kg Fuel/box/day] -> [kg CO2/box/s]
! Assuming an emission index of 1.0,
! 3155 g CO2 / kg fuel burned [Kim et al., 2005, 2007]
ACCO2(I,J,L+1) = 3.155 * FUEL / ( 24.d0 * 3600d0 )
ENDDO
! Close file
CLOSE( IU_FILE )
!=================================================================
! Interpolate from the 1-km grid to the given GEOS-CHEM grid
! NOTE: we need to account for window grids (bmy, 9/20/02)
!=================================================================
DO J = 1, JJPAR
DO I = 1, IIPAR
! ACCO2 is the aircraft CO2 on the 1-km vertical grid
FUEL = SUM( ACCO2(I,J,:) )
IF ( FUEL < TINY ) CYCLE
! There are 20 1-km levels
DO K = 1, 20
! Initialize
ZH(0) = 0.d0
! Loop over levels
DO L = 1, LLPAR
! Altitude of top edge of level L, from ground [km]
ZH(L) = ZH(L-1) + ( BXHEIGHT(I,J,L) * 1d-3 )
IF ( ZH(L-1) > DBLE(K) ) EXIT
IF ( ZH(L ) < DBLE(K-1) ) CYCLE
IF ( ZH(L) < DBLE(K) ) THEN
FAC = ZH(L) - MAX( ZH(L-1), DBLE(K-1) )
EMPLANECO2(I,J,L) = EMPLANECO2(I,J,L)+ACCO2(I,J,K)*FAC
ELSE
FAC = DBLE(K) - MAX( ZH(L-1), DBLE(K-1) )
EMPLANECO2(I,J,L) = EMPLANECO2(I,J,L)+ACCO2(I,J,K)*FAC
EXIT
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
YEAR = GET_YEAR()
!-----------------------------------------------------------------
! Global Aviation Totals for 1985-2006
!-----------------------------------------------------------------
! 1985-1995 values come directly from Sausen & Schumann (2000)
! 1996-1999 value of 0.155 assumed for bridging
! 2000-2005 values come directly from Kim et al. (2007)
! 2006 value comes from Wilkerson et al. (2010)
! We have not attempted to extrapolate outside of this range
!-----------------------------------------------------------------
! A correction for domestic fuel use is carried out in the
! fossil fuel subroutine.
!-----------------------------------------------------------------
GlobPTotNew(1:22) = (/
& 0.1234, 0.1299, 0.1356, 0.1414, 0.1465,
& 0.1469, 0.1434, 0.1420, 0.1441, 0.1500, 0.1543, ! 1985-1995
& 0.1550, 0.1550, 0.1550, 0.1550, ! 1996-1999
& 0.1560, 0.1462, 0.1470, 0.1519, 0.1620, 0.1748, ! 2000-2005
& 0.16225 /) ! 2006
IF ( YEAR <= 1985 ) THEN
n = 1
ELSEIF ( YEAR >= 2006 ) THEN
n = 22
ELSE
n = YEAR - 2000 + 1
ENDIF
!=================================================================
! Convert units from kg/box/s to molecules/cm3/s
!
! Notes:
! 1) box volume from BOXVL is in cm3
! 2) mass is for CO2 (not C) with emission factor of 3155 g/kg
! 3) optional global scaling to specified value
!=================================================================
DO J = 1, JJPAR
DO I = 1, IIPAR
DO L = 1, LLPAR
EMPLANECO2(I,J,L) = EMPLANECO2(I,J,L) / BOXVL(I,J,L)
& * 6.022d23 / 44.01d-3
! Apply scaling to obtain a specified global Total
EMPLANECO2(I,J,L) = EMPLANECO2(I,J,L)*(GlobPTotNew(n)/GlobPTot)
ENDDO
ENDDO
ENDDO
END SUBROUTINE READ_AVIATION_CO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_annual_bionet_co2
!
! !DESCRIPTION: Subroutine READ\_ANNUAL\_BIONET\_CO2 reads in annual mean
! values of for Net Terrestrial exchange from a binary punch file.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_ANNUAL_BIONET_CO2
!
! !USES:
!
! 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, DATA_DIR_1x1
USE FILE_MOD, ONLY : IU_FILE, IOERROR
USE TRANSFER_MOD, ONLY : TRANSFER_2D
USE LOGICAL_MOD, ONLY : LBIONETORIG, LBIONETCLIM
USE REGRID_1x1_MOD, ONLY : DO_REGRID_G2G_1x1, DO_REGRID_1x1
# include "CMN_SIZE" ! Size parameters
!
! !REMARKS:
! The two choices are:
! (1 ) Old Net Terrestrial Exchange for Year 2000 from David Baker
! (pers. comm.) from undocumented Transcom 3 inversion results
! (2 ) New Baker et al [2006] Transcom 3 climatology 1991-2000 minus
! GFEDv2 climatology 1997-2007.
! .
! References:
! (1 ) Baker et al. (2006), Transcom3 inversion intercomparison: Impact of
! Transport model errors on the interannual vaiability of regional CO2
! fluxes, 1988-2003, Glob. Biogeochem. Cycles, 20, GB1002.
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Updated
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, IOS
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
REAL*4 :: ARRAY_1x1(360,180,1)
REAL*8 :: GEN_1x1(360,180,1)
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
REAL*8 :: GEOS_GRID(IIPAR,JJPAR,1)
REAL*8 :: TAU
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_ANNUAL_BIONET_CO2 begins here!
!=================================================================
! Initialize ARRAY
ARRAY = 0e0
!------------------------------------
! Read original Bionet data
!------------------------------------
! Filename
IF ( LBIONETORIG ) THEN
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/net_terr_exch_CO2.' //
& GET_NAME_EXT_2D() // '.' //
& GET_RES_EXT() // '.txt'
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
! Open file
OPEN( IU_FILE, FILE=TRIM( FILENAME ),
& FORM='FORMATTED', IOSTAT=IOS )
IF ( IOS > 0 ) CALL IOERROR(IOS,IU_FILE, 'read_ann_bionet:1')
! Read data
READ( IU_FILE, '(7e13.6)', IOSTAT=IOS )
& ( ( ARRAY(I,J,1), I=1,IIPAR), J=1,JJPAR )
IF ( IOS > 0 ) CALL IOERROR(IOS,IU_FILE, 'read_ann_bionet:2')
! Close file
CLOSE( IU_FILE )
! Cast to REAL*8 and resize if necessary
CALL TRANSFER_2D( ARRAY(:,:,1), EMBIONETCO2 )
ENDIF
!------------------------------------
! Read climatological Bionet data
!------------------------------------
IF ( LBIONETCLIM ) THEN
! TAU value for start of "generic" year 2000
TAU = GET_TAU0( 1, 1, 2000 )
! Filename
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_201003/Net_terrestrial_exch_5.29Pg.' //
& GET_NAME_EXT_2D() // '.' // GET_RES_EXT()
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
! Read Net Terrestrial CO2 Exchange [molec/cm2/s]
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 6,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
! Cast to REAL*8 and resize if necessary
CALL TRANSFER_2D( ARRAY(:,:,1), EMBIONETCO2 )
!-----------------------------------------------------------------------
! Commented block of code below is nearly equivalent to the block of code
! above but regrids during the model run from generic 1x1. This approach
! is better for working with resolutions finer than 2x2.5, but at present,
! requires a 2-step regridding which is not exaclty equivalent.
!-----------------------------------------------------------------------
!
! FILENAME = TRIM( DATA_DIR_1x1 ) //
! & 'CO2_201003/Net_terrestrial_exch_1x1_4.47Pg.bpch'
!
! ! Echo info
! WRITE( 6, 100 ) TRIM( FILENAME )
!
! ! Read Net Terrestrial CO2 Exchange [molec/cm2/s]
! CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 6,
! & TAU, 360, 180,
! & 1, ARRAY_1x1, QUIET=.TRUE. )
!
! ! Cast to REAL*8 before regridding
! GEN_1x1(:,:,1) = ARRAY_1x1(:,:,1)
!
! ! Regrid from GENERIC 1x1 --> GEOS 1x1
! CALL DO_REGRID_G2G_1x1( 'molec/cm2/s', GEN_1x1, GEOS_1x1 )
!
! ! Regrid from GEOS 1x1 --> current model resolution
! CALL DO_REGRID_1x1( 1, 'molec/cm2/s', GEOS_1x1, GEOS_GRID)
!
! EMBIONETCO2(:,:) = GEOS_GRID(:,:,1)
!
!-----------------------------------------------------------------------
ENDIF
100 FORMAT( ' - READ_ANNUAL_BIONETCO2: Read ', a )
END SUBROUTINE READ_ANNUAL_BIONET_CO2
!EOC
!------------------------------------------------------------------------------
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_bbio_dailyaverage
!
! !DESCRIPTION: Subroutine READ\_DAILY\_BBIO\_CO2 reads in daily values for
! balanced biospheric exchange from a binary punch file.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_BBIO_DAILYAVERAGE( MONTH, DAY, DOY )
!
! !USES:
!
! 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 TRANSFER_MOD, ONLY : TRANSFER_2D
USE TIME_MOD, ONLY : GET_YEAR, ITS_A_LEAPYEAR
# include "CMN_SIZE" ! Size parameters
!
! !INPUT PARAMETERS:
!
INTEGER, INTENT(IN) :: MONTH ! Current month (1-12)
INTEGER, INTENT(IN) :: DAY ! Current day (1-31)
INTEGER, INTENT(IN) :: DOY ! Current day of year (0-366)
!
! !REMARKS:
! Data Source: CASA gridded (1x1) dataset for from M. Thompson
! Monthly values interpolated to daily values : 365 daily files
! NB : These files DO NOT have the diurnal cycle in daily emissions
! See routine ' ' to read in files with diurnal cycle imposed
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Added fixes for leapyears
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, YEAR ! dbj
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: TAU
CHARACTER(LEN=3 ) :: SDOY
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_BBIO_DAILYAVERAGE begins here!
!=================================================================
YEAR = GET_YEAR() ! dbj
! Create string for day of year
! ----------------------------------------------------------------
! Since 2000 is a leap-year, we need to add one to get the correct
! day-of-year for non-leap years, if the date is after Feb 28.
! ! Ray Nassar
! ----------------------------------------------------------------
IF( ITS_A_LEAPYEAR() .OR. DOY <= 59 ) THEN
WRITE( SDOY, '(i3.3)' ) DOY
ELSE
WRITE( SDOY, '(i3.3)' ) DOY + 1
ENDIF
! Get TAU value corresponding to DOY in year 2000
TAU = GET_TAU0( MONTH, DAY, 2000 )
! write(*,*) 'BB day ave DOY, SDOY, Tau = ',DOY, SDOY, Tau
!-----------------------------------------------------------------
! ! Make a string from DOY
! WRITE( SDOY, '(i3.3)' ) DOY
! Name of file with Balanced Bio CO2 data
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/BBIO_DAILYAVG/CO2.daily.' //
& GET_NAME_EXT_2D() // '.' //
& GET_RES_EXT() // '.' // SDOY
! Echo info
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_BBIO_DAILYAVERAGE: Reading ', a )
! ! Get TAU value corresponding to DOY in year 2000
! TAU = GET_TAU0( MONTH, DAY, 2000 )
! Read balanced biosphere CO2 [molec/cm2/s] from disk
CALL READ_BPCH2( FILENAME, 'CO2-SRCE', 3,
& TAU, IGLOB, JGLOB,
& 1, ARRAY, QUIET=.TRUE. )
! Cast from REAL*4 to REAL*8 and resize if necessary
CALL TRANSFER_2D( ARRAY(:,:,1), EMBIOCO2 )
END SUBROUTINE READ_BBIO_DAILYAVERAGE
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: read_bbio_diurnalcycle
!
! !DESCRIPTION: Subroutine READ\_BBIO\_DIURNALCYCLE reads CASA daily Net
! Ecosystem Production (NEP) fluxes but with a diurnal cycle imposed.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE READ_BBIO_DIURNALCYCLE( MONTH, DAY, HOUR, DOY )
!
! !USES:
!
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 TRANSFER_MOD, ONLY : TRANSFER_2D
USE TIME_MOD, ONLY : GET_YEAR, ITS_A_LEAPYEAR
# include "CMN_SIZE" ! Size parameters
!
! !INPUT PARAMETERS:
!
INTEGER, INTENT(IN) :: MONTH ! Current month (1-12)
INTEGER, INTENT(IN) :: DAY ! Current day (1-31)
INTEGER, INTENT(IN) :: HOUR ! Current hour (0-23)
INTEGER, INTENT(IN) :: DOY ! Current day of year (0-365)
!
! !REMARKS:
! References
! (1 ) Olsen and Randerson (2004), Differences between surface and column
! atmospheric CO2 and implications for carbon cycle research, J.
! Geophys. Res., 109, D02301,
! (2 ) Potter et al. (1993), terrestrial Ecosystem Production: A process
! model based on global satellite and surface data, Glob. Biogeochem.
! Cycles, 7(4), 811-841.
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Added fixes for leapyears
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: YEAR
REAL*4 :: ARRAY(IGLOB,JGLOB,1)
REAL*8 :: TAU
CHARACTER(LEN=3 ) :: SDOY
CHARACTER(LEN=255) :: FILENAME
!=================================================================
! READ_BBIO_DIURNALCYCLE begins here!
!=================================================================
YEAR = GET_YEAR() ! dbj
! Create string for day of year
!-----------------------------------------------------------------
! Since 1985 is NOT a leap-year, we need to account for years that
! are leap years if the date is Feb 29 or after by subtracting one
! ! Ray Nassar
!-----------------------------------------------------------------
IF( ITS_A_LEAPYEAR() .AND. DOY >= 60 ) THEN
WRITE( SDOY, '(i3.3)' ) DOY-1
ELSE
WRITE( SDOY, '(i3.3)' ) DOY
ENDIF
! Get TAU of this month & day in "generic" year 1985
IF( MONTH == 2 .AND. DAY == 29) THEN
TAU = GET_TAU0( 2, 28, 1985, HOUR )
ELSE
TAU = GET_TAU0( MONTH, DAY, 1985, HOUR )
ENDIF
! ! Create string for day of year
! WRITE( SDOY, '(i3.3)' ) DOY
! File name
IF (SDOY == '189') THEN
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/BBIO_DIURNAL/nep.' //
& GET_NAME_EXT_2D() // '.' //
& GET_RES_EXT() // '.' //
& SDOY // '.orig'
ELSE
FILENAME = TRIM( DATA_DIR ) //
& 'CO2_200508/BBIO_DIURNAL/nep.' //
& GET_NAME_EXT_2D() // '.' //
& GET_RES_EXT() // '.' //
& SDOY
ENDIF
! Echo file name to stdout
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_BBIO_DIURNALCYCLE: Reading ', a )
!-----------------------------------------------------------------
! Read Net Ecosytem Productivity [molec CO/cm2/s] from disk
! The CASA fluxes use atmospheric convention:
! positive = into atm; negative = into biosphere
!-----------------------------------------------------------------
CALL READ_BPCH2( FILENAME, 'GLOB-NPP', 2,
& TAU, IIPAR, JJPAR,
& 1, ARRAY, QUIET=.TRUE. )
! Cast from REAL*4 to REAL*8 and resize if necessary
CALL TRANSFER_2D( ARRAY(:,:,1), EMBIOCO2 )
END SUBROUTINE READ_BBIO_DIURNALCYCLE
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: total_biomass_tg
!
! !DESCRIPTION: Subroutine TOTAL\_BIOMASS\_Tg prints the amount of biomass
! burning emissions that are emitted each month in Tg or Tg
!\\
!\\
! !INTERFACE:
!
SUBROUTINE TOTAL_BIOMASS_Tg( BBARRAY, MOLWT, NAME )
!
! !USES:
!
USE GRID_MOD, ONLY : GET_AREA_CM2
# include "CMN_SIZE" ! Size parameters
!
! !INPUT PARAMETERS:
!
REAL*8, INTENT(IN) :: MOLWT ! Mol wt [kg/mole]
CHARACTER(LEN=*), INTENT(IN) :: NAME ! Species name
REAL*8, INTENT(IN) :: BBARRAY(IIPAR,JJPAR) ! BB Emissions
! [molec/cm2/month]
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Updated
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J
REAL*8 :: TOTAL, A_CM2
CHARACTER(LEN=6) :: UNIT
!=================================================================
! TOTAL_BIOMASS_TG begins here!
!=================================================================
! Initialize summing variable
TOTAL = 0d0
! Convert from [molec /cm2/month] to [kg /month]
! or from [molec C/cm2/month] to [kg C/month]
DO J = 1, JJPAR
A_CM2 = GET_AREA_CM2( J ) ! Grid box surface area [cm2]
DO I = 1, IIPAR
TOTAL = TOTAL + BBARRAY(I,J) * A_CM2 * ( MOLWT / 6.023d23 )
ENDDO
ENDDO
! Convert from kg --> Tg
TOTAL = TOTAL * 1d-9
! Define unit string
IF ( NAME == 'NOx' .or. NAME == 'CO' .or. NAME == 'CH2O' ) THEN
UNIT = '[Tg ]'
ELSE
UNIT = '[Tg C]'
ENDIF
! Write totals
WRITE( 6, 100 ) NAME, TOTAL, UNIT
100 FORMAT( 'Sum Biomass ', a4, 1x, ': ', f9.3, 1x, a9 )
END SUBROUTINE TOTAL_BIOMASS_TG
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: def_biosph_co2_regions_f
!
! !DESCRIPTION: Subroutine DEF\_BIOSPH\_CO2\_REGIONS defines the land
! biospheric and ocean CO2 exchange regions.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE DEF_BIOSPH_CO2_REGIONS_F( REGION )
!
! !USES:
!
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FILE_MOD, ONLY : IU_FILE, IOERROR
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
!
! !OUTPUT PARAMETERS:
!
INTEGER, INTENT(OUT) :: REGION(IIPAR,JJPAR)
!
! !REMARKS:
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! %%% BUYER BEWARE! Tagged CO2 tracers only work for 2 x 2.5 grid! %%%
! %%% Someone will have to make this more general later on... %%%
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, IOS
INTEGER :: TMP(IIPAR,JJPAR)
INTEGER :: LAND_REG(IIPAR,JJPAR)
CHARACTER(LEN=255) :: LANDFILE
CHARACTER(LEN=144) :: ROW
CHARACTER(LEN=1) :: CHAR1(IIPAR,JJPAR)
!=================================================================
! Reading LAND BIOSPHERE REGIONS
!=================================================================
LANDFILE = 'Regions_land.dat'
WRITE(*,*) ' '
100 FORMAT( ' - READ_REGIONS: Reading ', a )
WRITE( 6, 100 ) TRIM( LANDFILE )
! Initialize ARRAY
LAND_REG = 0
! Open file
OPEN( IU_FILE, FILE = TRIM( LANDFILE ),
& FORM='FORMATTED', IOSTAT=IOS )
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_regions:1' )
! Read data
DO J = 1, JJPAR
IF (IIPAR == 72) READ( IU_FILE, '(72A)', IOSTAT=IOS ) ROW
IF (IIPAR == 144) READ( IU_FILE,'(144A)', IOSTAT=IOS ) ROW
WRITE (*,'(A)') ROW
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_regions:2' )
DO I = 1, IIPAR
CHAR1(I,J) = ROW(I:I)
IF (CHAR1(I,J) == ' ') CHAR1(I,J) = '0'
READ (CHAR1(I,J),'(I1)') TMP(I,J)
ENDDO
ENDDO
! Close file
CLOSE( IU_FILE )
! Flip array in the North-South Direction
DO J = 1, JJPAR
DO I = 1, IIPAR
LAND_REG(I,J) = TMP(I,JJPAR-J+1)
ENDDO
ENDDO
WRITE(*,*) ' '
!=================================================================
! Loop over entire globe -- multiprocessor
!=================================================================
DO J = 1, JJPAR
DO I = 1, IIPAR
!-----------------------------------------------------------------------
! Tracer #13 -- Canadian Tundra
IF (LAND_REG(I,J) == 1 .and. I >= 5 .and. I <= 60) THEN
REGION(I,J) = 13
!----------------------------------------------------------------------
! Tracer #14 -- NA Boreal Forest
ELSE IF (LAND_REG(I,J) == 2 .and. I <= 60) THEN
REGION(I,J) = 14
!-----------------------------------------------------------------------
! Tracer #15 -- Western US/Mexico
ELSE IF (LAND_REG(I,J) == 3 .and. I <= 60) THEN
REGION(I,J) = 15
!-----------------------------------------------------------------------
! Tracer #16 -- Central NA Agricultural
ELSE IF (LAND_REG(I,J) == 4 .and. I <= 60) THEN
REGION(I,J) = 16
!-----------------------------------------------------------------------
! Tracer #17 -- NA Mixed Forest
ELSE IF (LAND_REG(I,J) == 5 .and. I <= 60) THEN
REGION(I,J) = 17
!-----------------------------------------------------------------------
! Tracer #18 -- Central America and Caribbean
ELSE IF (LAND_REG(I,J) == 6 .and. I <= 60) THEN
REGION(I,J) = 18
!-----------------------------------------------------------------------
! Tracer #19 -- SA Tropical Rain Forest
ELSE IF (LAND_REG(I,J) == 7 .and. I <= 60) THEN
REGION(I,J) = 19
!-----------------------------------------------------------------------
! Tracer #20 -- SA Coast and Mountains
ELSE IF (LAND_REG(I,J) == 8 .and. I <= 60) THEN
REGION(I,J) = 20
!-----------------------------------------------------------------------
! Tracer #21 -- SA Wooded Grasslands
ELSE IF (LAND_REG(I,J) == 9 .and. I <= 60) THEN
REGION(I,J) = 21
!-----------------------------------------------------------------------
! Tracer #22 -- Eurasian Tundra
ELSE IF (LAND_REG(I,J) == 1 .and. (I>60 .or. I<=5)) THEN
REGION(I,J) = 22
!-----------------------------------------------------------------------
! Tracer #23 -- Eurasian Boreal Coniferous Forest
ELSE IF (LAND_REG(I,J) == 2 .and. I > 60 .and. J > 65) THEN
REGION(I,J) = 23
!-----------------------------------------------------------------------
! Tracer #24 -- Eurasian Boreal Deciduous Forest
ELSE IF (LAND_REG(I,J) == 5 .and. I > 60 .and. J > 65) THEN
REGION(I,J) = 24
!-----------------------------------------------------------------------
! Tracer #25 -- South and Central Europe
ELSE IF (LAND_REG(I,J) == 6 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 25
!-----------------------------------------------------------------------
! Tracer #26 -- Central Asian Grasslands
ELSE IF (LAND_REG(I,J) == 4 .and. I > 60 .and. J > 46) THEN
REGION(I,J) = 26
!-----------------------------------------------------------------------
! Tracer #27 -- Central Asian Desert
ELSE IF (LAND_REG(I,J) == 8 .and. I >100 .and. I <117) THEN
REGION(I,J) = 27
!-----------------------------------------------------------------------
! Tracer #28 -- East Asia Mainland
ELSE IF (LAND_REG(I,J) == 3 .and. I > 100) THEN
REGION(I,J) = 28
!-----------------------------------------------------------------------
! Tracer #29 -- Japan
ELSE IF (LAND_REG(I,J) == 9 .and. I > 100) THEN
REGION(I,J) = 29
!-----------------------------------------------------------------------
! Tracer #30 -- Northern African Desert
ELSE IF (LAND_REG(I,J) == 8 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 30
!-----------------------------------------------------------------------
! Tracer #31 -- Northern Africa Grasslands
ELSE IF (LAND_REG(I,J) == 3 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 31
!-----------------------------------------------------------------------
! Tracer #32 -- Africa Tropical Forest
ELSE IF (LAND_REG(I,J) == 7 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 32
!-----------------------------------------------------------------------
! Tracer #33 -- Southern Africa Grasslands
ELSE IF (LAND_REG(I,J) == 4 .and. I > 60 .and. J < 50) THEN
REGION(I,J) = 33
!-----------------------------------------------------------------------
! Tracer #34 -- Southern African Desert
ELSE IF (LAND_REG(I,J) == 9 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 34
!-----------------------------------------------------------------------
! Tracer #35 -- Middle East
ELSE IF (LAND_REG(I,J) == 2 .and. J > 40 .and. J < 65) THEN
REGION(I,J) = 35
!-----------------------------------------------------------------------
! Tracer #36 -- India and bordering countries
ELSE IF (LAND_REG(I,J) == 5 .and. I > 60 .and. J < 65) THEN
REGION(I,J) = 36
!-----------------------------------------------------------------------
! Tracer #37 -- Maritime Asia (Indonesia, Malaysia, New Guinea, etc.)
ELSE IF (LAND_REG(I,J) == 7 .and. I > 100) THEN
REGION(I,J) = 37
!-----------------------------------------------------------------------
! Tracer #38 -- Australian Forest/Grassland
ELSE IF (LAND_REG(I,J) == 6 .and. I > 100) THEN
REGION(I,J) = 38
!-----------------------------------------------------------------------
! Tracer #39 -- Australian Desert
ELSE IF (LAND_REG(I,J) == 8 .and. I >116 .and. J < 46) THEN
REGION(I,J) = 39
!-----------------------------------------------------------------------
! Tracer #40 -- New Zealand
ELSE IF (LAND_REG(I,J) == 2 .and. I > 120) THEN
REGION(I,J) = 40
!-----------------------------------------------------------------------
! Tracer #52 -- CO2 from everywhere else (Remote Islands & Ice Caps)
ELSE
REGION(I,J) = 52
!-----------------------------------------------------------------------
ENDIF
ENDDO
ENDDO
END SUBROUTINE DEF_BIOSPH_CO2_REGIONS_F
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: def_ocean_co2_regions_f
!
! !DESCRIPTION: Subroutine DEF\_OCEAN\_CO2\_REGIONS defines CO2 regions
! for ocean exchange.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE DEF_OCEAN_CO2_REGIONS_F( REGION )
!
! !USES:
!
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FILE_MOD, ONLY : IU_FILE, IOERROR
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
!
! !OUTPUT PARAMETERS:
!
INTEGER, INTENT(OUT) :: REGION(IIPAR,JJPAR)
!
! !REMARKS:
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! %%% BUYER BEWARE! Tagged CO2 tracers only work for 2 x 2.5 grid! %%%
! %%% Someone will have to make this more general later on... %%%
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
INTEGER :: I, J, IOS
INTEGER :: TMP(IIPAR,JJPAR), OCEAN_REG(IIPAR,JJPAR)
CHARACTER(LEN=255) :: OCEANFILE
CHARACTER(LEN=144) :: ROW
CHARACTER(LEN=1) :: CHAR1(IIPAR,JJPAR)
!=================================================================
! DEF_CO2_OCEAN_REGIONS begins here!
!=================================================================
OCEANFILE = 'Regions_ocean.dat'
WRITE( 6, 100 ) TRIM( OCEANFILE )
100 FORMAT( ' - READ_REGIONS: Reading ', a )
WRITE(*,*) ' '
! Initialize ARRAYS
OCEAN_REG = 0
! Open file
OPEN( IU_FILE, FILE = TRIM( OCEANFILE ),
& FORM='FORMATTED', IOSTAT=IOS )
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_regions:1' )
! Read data
DO J = 1, JJPAR
IF (IIPAR == 72) READ( IU_FILE, '(72A)', IOSTAT=IOS ) ROW
IF (IIPAR == 144) READ( IU_FILE,'(144A)', IOSTAT=IOS ) ROW
WRITE (*,'(A)') ROW
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_regions:2' )
DO I = 1, IIPAR
CHAR1(I,J) = ROW(I:I)
IF (CHAR1(I,J) == ' ') CHAR1(I,J) = '0'
READ (CHAR1(I,J),'(I1)') TMP(I,J)
ENDDO
ENDDO
! Close file
CLOSE( IU_FILE )
! Flip array in the North-South Direction
DO J = 1, JJPAR
DO I = 1, IIPAR
OCEAN_REG(I,J) = TMP(I,JJPAR-J+1)
ENDDO
ENDDO
WRITE(*,*) ' '
!=================================================================
! Loop over entire globe -- multiprocessor
!=================================================================
DO J = 1, JJPAR
DO I = 1, IIPAR
!-----------------------------------------------------------------------
! Tracer #41 -- Arctic Ocean
IF (OCEAN_REG(I,J) == 5 .and. J > 60) THEN
REGION(I,J) = 41
!-----------------------------------------------------------------------
! Tracer #42 -- North Pacific
ELSE IF (OCEAN_REG(I,J) == 1) THEN
REGION(I,J) = 42
!-----------------------------------------------------------------------
! Region #43 -- Tropical West Pacific
ELSE IF (OCEAN_REG(I,J) == 2) THEN
REGION(I,J) = 43
!-----------------------------------------------------------------------
! Tracer #44 -- Tropical East Pacific
ELSE IF (OCEAN_REG(I,J) == 3) THEN
REGION(I,J) = 44
!-----------------------------------------------------------------------
! Tracer #45-- South Pacific
ELSE IF (OCEAN_REG(I,J) == 4) THEN
REGION(I,J) = 45
!-----------------------------------------------------------------------
! Tracer #46 -- North Atlantic
ELSE IF (OCEAN_REG(I,J) == 6 .and. J > 45) THEN
REGION(I,J) = 46
!-----------------------------------------------------------------------
! Tracer #47 -- Tropical Atlantic
ELSE IF (OCEAN_REG(I,J) == 7) THEN
REGION(I,J) = 47
!-----------------------------------------------------------------------
! Tracer #48 -- South Atlantic
ELSE IF (OCEAN_REG(I,J) == 8) THEN
REGION(I,J) = 48
!-----------------------------------------------------------------------
! Tracer #49 -- Tropical Indian Ocean
ELSE IF (OCEAN_REG(I,J) == 5 .and. J < 60) THEN
REGION(I,J) = 49
!-----------------------------------------------------------------------
! Tracer #50 -- Southern Indian Ocean
ELSE IF (OCEAN_REG(I,J) == 6 .and. J < 45) THEN
REGION(I,J) = 50
!-----------------------------------------------------------------------
! Tracer #51 -- Southern (Antacrtic) Ocean
ELSE IF (OCEAN_REG(I,J) == 9) THEN
REGION(I,J) = 51
!-----------------------------------------------------------------------
! Tracer #52 -- CO2 from everywhere else (Remote Islands & Ice Caps)
ELSE
REGION(I,J) = 52
!-----------------------------------------------------------------------
ENDIF
ENDDO
ENDDO
END SUBROUTINE DEF_OCEAN_CO2_REGIONS_F
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: def_fossil_co2_regions_f
!
! !DESCRIPTION: Subroutine DEF\_FOSSIL\_CO2\_REGIONS defines CO2 regions
! for anthropogenic emissions
!\\
!\\
! !INTERFACE:
!
SUBROUTINE DEF_FOSSIL_CO2_REGIONS_F( REGION )
!
! !USES:
!
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
USE DIRECTORY_MOD, ONLY : DATA_DIR
USE FILE_MOD, ONLY : IU_FILE, IOERROR
USE TRANSFER_MOD, ONLY : TRANSFER_2D
# include "CMN_SIZE" ! Size parameters
!
! !OUTPUT PARAMETERS:
!
INTEGER, INTENT(OUT) :: REGION(IIPAR,JJPAR)
!
! !REMARKS:
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! %%% BUYER BEWARE! Tagged CO2 tracers only work for 2 x 2.5 grid! %%%
! %%% Someone will have to make this more general later on... %%%
! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
!
! !REVISION HISTORY:
! 18 May 2010 - R. Nassar, D. Jones - Initial version
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
INTEGER :: I, J, IOS
INTEGER :: TMP(IIPAR,JJPAR), REG_CODE(IIPAR,JJPAR)
CHARACTER(LEN=255) :: FILENAME
CHARACTER(LEN=144) :: ROW
CHARACTER(LEN=1) :: CHAR1(IIPAR,JJPAR)
!=================================================================
! DEF_CO2_FOSSIL_REGIONS begins here!
!=================================================================
FILENAME = 'Regions_land.dat'
WRITE( 6, 100 ) TRIM( FILENAME )
100 FORMAT( ' - READ_REGIONS: Reading ', a )
! Initialize ARRAYS
REG_CODE = 0
! Open file
OPEN( IU_FILE, FILE = TRIM( FILENAME ),
& FORM='FORMATTED', IOSTAT=IOS )
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_regions:1' )
! Read data
DO J = 1, JJPAR
IF (IIPAR == 72) READ( IU_FILE, '(72A)', IOSTAT=IOS ) ROW
IF (IIPAR == 144) READ( IU_FILE,'(144A)', IOSTAT=IOS ) ROW
WRITE (*,'(A)') ROW
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_regions:2' )
DO I = 1, IIPAR
CHAR1(I,J) = ROW(I:I)
IF (CHAR1(I,J) == ' ') CHAR1(I,J) = '0'
READ (CHAR1(I,J),'(I1)') TMP(I,J)
ENDDO
ENDDO
! Close file
CLOSE( IU_FILE )
! Flip array in the North-South Direction
DO J = 1, JJPAR
DO I = 1, IIPAR
REG_CODE(I,J) = TMP(I,JJPAR-J+1)
ENDDO
ENDDO
!=================================================================
! Loop over entire globe -- multiprocessor
!=================================================================
DO J = 1, JJPAR
DO I = 1, IIPAR
!-----------------------------------------------------------------------
! Tracer #13 -- Canadian Tundra
IF (REG_CODE(I,J) == 1 .and. I >= 5 .and. I <= 60) THEN
REGION(I,J) = 13
!-----------------------------------------------------------------------
! Tracer #14 -- NA Boreal Forest
ELSE IF (REG_CODE(I,J) == 2 .and. I <= 60) THEN
REGION(I,J) = 14
!-----------------------------------------------------------------------
! Tracer #15 -- Western US/Mexico
ELSE IF (REG_CODE(I,J) == 3 .and. I <= 60) THEN
REGION(I,J) = 15
!-----------------------------------------------------------------------
! Tracer #16 -- Central NA Agricultural
ELSE IF (REG_CODE(I,J) == 4 .and. I <= 60) THEN
REGION(I,J) = 16
!-----------------------------------------------------------------------
! Tracer #17 -- NA Mixed Forest
ELSE IF (REG_CODE(I,J) == 5 .and. I <= 60) THEN
REGION(I,J) = 17
!-----------------------------------------------------------------------
! Tracer #18 -- Central America and Caribbean
ELSE IF (REG_CODE(I,J) == 6 .and. I <= 60) THEN
REGION(I,J) = 18
!-----------------------------------------------------------------------
! Tracer #19 -- SA Tropical Rain Forest
ELSE IF (REG_CODE(I,J) == 7 .and. I <= 60) THEN
REGION(I,J) = 19
!-----------------------------------------------------------------------
! Tracer #20 -- SA Coast and Mountains
ELSE IF (REG_CODE(I,J) == 8 .and. I <= 60) THEN
REGION(I,J) = 20
!-----------------------------------------------------------------------
! Tracer #21 -- SA Wooded Grasslands
ELSE IF (REG_CODE(I,J) == 9 .and. I <= 60) THEN
REGION(I,J) = 21
!-----------------------------------------------------------------------
! Tracer #22 -- Eurasian Tundra
ELSE IF (REG_CODE(I,J) == 1 .and. (I>60 .or. I<=5)) THEN
REGION(I,J) = 22
!-----------------------------------------------------------------------
! Tracer #23 -- Eurasian Boreal Coniferous Forest
ELSE IF (REG_CODE(I,J) == 2 .and. I > 60 .and. J > 55) THEN
REGION(I,J) = 23
!-----------------------------------------------------------------------
! Tracer #24 -- Eurasian Boreal Deciduous Forest
ELSE IF (REG_CODE(I,J) == 5 .and. I > 60 .and. J > 64) THEN
REGION(I,J) = 24
!-----------------------------------------------------------------------
! Tracer #25 -- South and Central Europe
ELSE IF (REG_CODE(I,J) == 6 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 25
!-----------------------------------------------------------------------
! Tracer #26 -- Central Asian Grasslands
ELSE IF (REG_CODE(I,J) == 4 .and. I > 60 .and. J > 46) THEN
REGION(I,J) = 26
!-----------------------------------------------------------------------
! Tracer #27 -- Central Asian Desert
ELSE IF (REG_CODE(I,J) == 8 .and. I >100 .and. I <117) THEN
REGION(I,J) = 27
!-----------------------------------------------------------------------
! Tracer #28 -- East Asia Mainland
ELSE IF (REG_CODE(I,J) == 3 .and. I > 100) THEN
REGION(I,J) = 28
!-----------------------------------------------------------------------
! Tracer #29 -- Japan
ELSE IF (REG_CODE(I,J) == 9 .and. I > 100) THEN
REGION(I,J) = 29
!-----------------------------------------------------------------------
! Tracer #30 -- Northern African Desert
ELSE IF (REG_CODE(I,J) == 8 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 30
!-----------------------------------------------------------------------
! Tracer #31 -- Northern Africa Grasslands
ELSE IF (REG_CODE(I,J) == 3 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 31
!-----------------------------------------------------------------------
! Tracer #32 -- Africa Tropical Forest
ELSE IF (REG_CODE(I,J) == 7 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 32
!-----------------------------------------------------------------------
! Tracer #33 -- Southern Africa Grasslands
ELSE IF (REG_CODE(I,J) == 4 .and. I > 60 .and. J < 50) THEN
REGION(I,J) = 33
!-----------------------------------------------------------------------
! Tracer #34 -- Southern African Desert
ELSE IF (REG_CODE(I,J) == 9 .and. I > 60 .and. I <100) THEN
REGION(I,J) = 34
!-----------------------------------------------------------------------
! Tracer #35 -- Middle East
ELSE IF (REG_CODE(I,J) == 2 .and. J > 40 .and. J < 60) THEN
REGION(I,J) = 35
!-----------------------------------------------------------------------
! Tracer #36 -- India and bordering countries
ELSE IF (REG_CODE(I,J) == 5 .and. I > 60 .and. J < 64) THEN
REGION(I,J) = 36
!-----------------------------------------------------------------------
! Tracer #37 -- Maritime Asia (Indonesia, Malaysia, New Guinea, etc.)
ELSE IF (REG_CODE(I,J) == 7 .and. I > 100) THEN
REGION(I,J) = 37
!-----------------------------------------------------------------------
! Tracer #38 -- Australian Forest/Grassland
ELSE IF (REG_CODE(I,J) == 6 .and. I > 100) THEN
REGION(I,J) = 38
!-----------------------------------------------------------------------
! Tracer #39 -- Australian Desert
ELSE IF (REG_CODE(I,J) == 8 .and. I > 116 .and. J <45) THEN
REGION(I,J) = 39
!-----------------------------------------------------------------------
! Tracer #40 -- New Zealand
ELSE IF (REG_CODE(I,J) == 2 .and. I > 120) THEN
REGION(I,J) = 40
!-----------------------------------------------------------------------
! Tracer #52 -- CO2 from everywhere else (Remote Islands & Ice Caps)
ELSE
REGION(I,J) = 52
!-----------------------------------------------------------------------
ENDIF
ENDDO
ENDDO
END SUBROUTINE DEF_FOSSIL_CO2_REGIONS_F
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_co2
!
! !DESCRIPTION: Subroutine INIT\_CO2 allocates memory to module arrays and
! reads in annual mean emissions.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE INIT_CO2
!
! !USES:
!
! References to F90 modules
USE ERROR_MOD, ONLY : ALLOC_ERR
USE LOGICAL_MOD, ONLY : LGENFF, LANNFF, LMONFF, LSTREETS
USE LOGICAL_MOD, ONLY : LSEASBB, LGFED2BB, L8DAYBB, LBIOFUEL
USE LOGICAL_MOD, ONLY : LBIODAILY, LBIODIURNAL
USE LOGICAL_MOD, ONLY : LBIONETORIG, LBIONETCLIM
USE LOGICAL_MOD, ONLY : LOCN1997, LOCN2009ANN, LOCN2009MON
USE LOGICAL_MOD, ONLY : LFFBKGRD
USE LOGICAL_MOD, ONLY : LSHIPEDG, LSHIPICO, LPLANE
USE LOGICAL_MOD, ONLY : LBIOSPHTAG, LFOSSILTAG
USE LOGICAL_MOD, ONLY : LSHIPTAG, LPLANETAG
USE TRACER_MOD, ONLY : N_TRACERS
# include "CMN_SIZE"
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Updated
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
LOGICAL, SAVE :: IS_INIT = .FALSE.
INTEGER :: AS
!=================================================================
! INIT_CO2 begins here!
!=================================================================
! Exit if we have already intialized
IF ( IS_INIT ) RETURN
! Array for Fossil fuel CO2
ALLOCATE( EMFOSSCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMFOSSCO2' )
EMFOSSCO2 = 0d0
! Array for CO2 from ocean exchange
ALLOCATE( EMOCCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMOCCO2' )
EMOCCO2 = 0d0
! Array for Balanced Bio CO2
ALLOCATE( EMBIOCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMBIOCO2' )
EMBIOCO2 = 0d0
! Array for Biomass burning CO2
ALLOCATE( EMBIOBRNCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMBIOBRNCO2' )
EMBIOBRNCO2 = 0d0
! Array for Biofuel CO2
ALLOCATE( EMBIOFUELCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMBIOFUELCO2' )
EMBIOFUELCO2 = 0d0
! Array for NET BIO CO2
ALLOCATE( EMBIONETCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMBIONETCO2' )
EMBIONETCO2 = 0d0
! Array for Ship CO2
ALLOCATE( EMSHIPCO2( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMSHIPCO2' )
EMSHIPCO2 = 0d0
! Array for Aircraft CO2
ALLOCATE( EMPLANECO2( IIPAR, JJPAR, LLPAR), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMPLANECO2' )
EMPLANECO2 = 0d0
! Array for chemical source of CO2 ! dbj
ALLOCATE( CHEMCO2( IIPAR, JJPAR, LLPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CHEMCO2' )
CHEMCO2 = 0d0
! Array for compensation to chemical source !dbj
ALLOCATE( EMIS_SUB( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMIS_SUB' )
EMIS_SUB = 0d0
! Array for Fossil Fuel regions
ALLOCATE( FOSSIL_REGION( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'FOSSIL_REGION' )
FOSSIL_REGION = 0
! Array for Biospheric regions
ALLOCATE( BIOSPH_REGION( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOSPH_REGION' )
BIOSPH_REGION = 0
! Array for Ocean Regions
ALLOCATE( OCEAN_REGION( IIPAR, JJPAR ), STAT=AS )
IF ( AS /= 0 ) CALL ALLOC_ERR( 'OCEAN_REGION' )
OCEAN_REGION = 0
!=================================================================
! Read in annual mean emissions
!=================================================================
! Biofuel emissions
IF (LBIOFUEL) CALL READ_ANNUAL_BIOFUELCO2
! Net terrestrial exchange
IF (LBIONETORIG .OR. LBIONETCLIM) CALL READ_ANNUAL_BIONET_CO2
! Reset IS_INIT flag
IS_INIT = .TRUE.
END SUBROUTINE INIT_CO2
!EOC
!------------------------------------------------------------------------------
! University of Toronto and !
! Harvard University Atmospheric Chemistry Modeling Group !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: cleanup_co2
!
! !DESCRIPTION: Subroutine CLEANUP\_CO2 deallocates all module arrays.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE CLEANUP_CO2
!
! !REVISION HISTORY:
! 16 Aug 2005 - P. Suntharalingam - Initial version
! 18 May 2010 - R. Nassar, D. Jones - Updated
!EOP
!------------------------------------------------------------------------------
!BOC
!=================================================================
! CLEANUP_CO2 begins here!
!=================================================================
IF ( ALLOCATED( EMFOSSCO2 ) ) DEALLOCATE( EMFOSSCO2 )
IF ( ALLOCATED( EMOCCO2 ) ) DEALLOCATE( EMOCCO2 )
IF ( ALLOCATED( EMBIOCO2 ) ) DEALLOCATE( EMBIOCO2 )
IF ( ALLOCATED( EMBIOBRNCO2 ) ) DEALLOCATE( EMBIOBRNCO2 )
IF ( ALLOCATED( EMBIOFUELCO2 ) ) DEALLOCATE( EMBIOFUELCO2 )
IF ( ALLOCATED( EMBIONETCO2 ) ) DEALLOCATE( EMBIONETCO2 )
IF ( ALLOCATED( EMSHIPCO2 ) ) DEALLOCATE( EMSHIPCO2 )
IF ( ALLOCATED( EMPLANECO2 ) ) DEALLOCATE( EMPLANECO2 )
IF ( ALLOCATED( CHEMCO2 ) ) DEALLOCATE( CHEMCO2 )
IF ( ALLOCATED( EMIS_SUB ) ) DEALLOCATE( EMIS_SUB )
END SUBROUTINE CLEANUP_CO2
!EOC
END MODULE CO2_MOD