! #define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') rname, __FILE__, __LINE__ ; call goErr #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if ! #include "tm5.inc" ! !----------------------------------------------------------------------------- ! TM5 ! !----------------------------------------------------------------------------- !BOP ! ! !MODULE: EMISSION_READ ! ! !DESCRIPTION: This module provides objects and methods related to ! IPCC-AR5, EDGAR-4, RETRO_FIRES, LPJ and MACC emissions. ! ! AR5 netCDF files are provided by FZ-Juelich and IIASA: ! ftp://ftp-ipcc.fz-juelich.de/pub/emissions/gridded_netcdf/ ! http://www.iiasa.ac.at/web-apps/tnt/RcpDb/ ! ! These data sets are not covering natural emissions. For these ! sources additional data from the MACC project are used (sectors ! ocean, soil, biogenic and natural, see below). ! ! There are a few keys in the rc-file which control the behaviour of ! this module and the data used: ! # specify the (main) provider of emission sets ! input.emis.provider : AR5 ! # where to find the emissions (this will be used by install-emis-ar5) ! input.emis.dir : ${TEMP}/EMIS/AR5 ! # year of emissions (AR5 emissions will be linearly interpolated) ! input.emis.year : 2000 ! # choose RCP out of RCP26, RCP45, RCP60, RCP85 ! input.emis.AR5.RCP : RCP45 ! !\\ !\\ ! !INTERFACE: ! MODULE EMISSION_READ ! ! !USES: ! use GO, only : gol, goErr, goPr, goLabel use emission_data, only : emis_input_dir_ar5 use emission_data, only : emis_input_dir_ed4, emis_input_dir_mac use emission_data, only : vd_class_name_len use dims, only : nlon360, nlat180, iglbsfc use chem_param, only : ncb4 use chem_param, only : xmc, xmh, xmch2o, xmeth, xmgly use chem_param, only : xmole, xmald2, xmpar, xmo use Dims, only : okdebug USE MDF, ONLY : MDF_Open, MDF_NETCDF, MDF_HDF4, MDF_READ USE MDF, ONLY : MDF_Inq_VarID, MDF_Get_Var, MDF_Close implicit none private ! ! !PUBLIC MEMBER FUNCTIONS: ! public :: emission_read_init, emission_read_done !!$ public :: emission_ar5_readcategory public :: emission_ar5_regrid_aircraft public :: numb_2dsec, numb_3dsec public :: numb_sectors, sectors_def public :: numb_providers, providers_def public :: sector_name_len public :: emission_ar5_readsector public :: emission_macc_readsector public :: emission_ed4_readsector public :: emission_gfed_readsector public :: emission_retro_readsector public :: emission_lpj_readsector public :: emission_hymn_readsector public :: emission_megan_readsector public :: ar5_dim_3ddata public :: emis_ar5_voc2cbm4_default public :: emis_ar5_voc2cbm4_biomassb public :: emis_ar5_voc2cbm4_biogenic public :: emis_ar5_voc_name, emis_ar5_nvoc public :: ar5_cat_ant, ar5_cat_shp, ar5_cat_air, ar5_cat_bmb ! MACC public :: emis_macc_voc2cbm4_default public :: emis_macc_voc2cbm4_biogenic public :: emis_macc_voc2cbm4_biomassb public :: emis_macc_voc_name, emis_macc_nvoc ! MEGAN public :: emis_megan_voc2cbm4_biogenic public :: emis_megan_nvoc, emis_megan_voc_name public :: emis_gfed_voc_name, emis_gfed_nvoc public :: emis_retro_voc_name public :: sector_type, provider_type ! EDGAR 4.2 public :: ed42_nsect_co, ed42_nsect_ch4 public :: ed42_nsect_nox, ed42_nsect_hc public :: ed42_nsect_nh3, ed42_nsect_so2 public :: ed42_co_sectors, ed42_ch4_sectors public :: ed42_nox_sectors, ed42_hc_sectors public :: ed42_nh3_sectors, ed42_so2_sectors ! ! !PRIVATE DATA MEMBERS: ! character(len=*), parameter :: mname = 'emission_read' ! ------------------------------ ! global characteristics ! ------------------------------ integer, parameter :: nlat360 = 360 ! number of latitudes for AR5, MACC, EDGAR, GFED, RETRO data (0.5deg) integer, parameter :: nlon720 = 720 ! number of longitudes for AR5, MACC, EDGAR, GFED, RETRO data (0.5deg) integer, parameter :: lpj_dim_nlat = 150 ! number of latitudes (1deg), no emissions 60S-90S integer, parameter :: lpj_dim_nlon = 360 ! number of longitudes (1deg) integer, parameter :: sector_name_len = 18 ! length of sector descriptor integer, parameter :: categ_name_len = 14 ! length of category descriptor integer, parameter :: numb_sectors = 72 ! number of sectors (All providers!) integer, parameter :: numb_2dsec = 67 ! number of 2d sectors (all except aircraft) integer, parameter :: numb_3dsec = 2 ! number of 3d sectors (aircraft) integer, parameter :: numb_providers = 9 ! AR5, MACC, ED41, ED42, LPJ, HYMN, GFEDv3, RETRO, MEGAN integer, parameter :: ar5_dim_3ddata = 25 ! number of layers for aircraft data ! full list of providers character(8), dimension(numb_providers), parameter :: all_providers = & & (/ 'RETRO ', 'AR5 ', 'MACC ', 'ED41 ', 'ED42 ', 'LPJ ', 'HYMN ', 'GFEDv3 ','MEGAN '/) ! List of providers effectively used character(8), PUBLIC, allocatable :: used_providers(:) ! general: CO, NMVOC, NOX, SOx, NH3 character(8), PUBLIC, allocatable :: used_providers_isop(:) ! ISOP character(8), PUBLIC, allocatable :: used_providers_ch4(:) ! CH4 character(8), PUBLIC, allocatable :: used_providers_aer(:) ! BC and POM ! flag for degenerated cases logical, PUBLIC :: has_aer_emis = .true. logical, PUBLIC :: has_ch4_emis = .true. logical, PUBLIC :: has_isop_emis = .true. logical, PUBLIC :: has_emis = .true. ! extra params EDGAR 4.2: sectors used per species (here we already take out BMB and transport) integer, parameter :: ed42_nsect_co = 8 ! (all=11) number of sectors for CO integer, parameter :: ed42_nsect_ch4 = 13 ! (all=16) number of sectors for CH4 integer, parameter :: ed42_nsect_nox = 10 ! (all=13) number of sectors for NOx integer, parameter :: ed42_nsect_hc = 9 ! (all=12) number of sectors for NMVOC integer, parameter :: ed42_nsect_nh3 = 9 ! (all=11) number of sectors for NH3 integer, parameter :: ed42_nsect_so2 = 8 ! (all=11) number of sectors for SO2 character(len=sector_name_len), dimension(ed42_nsect_co) :: ed42_co_sectors ! CO sectors in EDGAR 4.2 character(len=sector_name_len), dimension(ed42_nsect_ch4) :: ed42_ch4_sectors ! CH4 sectors in EDGAR 4.2 character(len=sector_name_len), dimension(ed42_nsect_nox) :: ed42_nox_sectors ! NOx sectors in EDGAR 4.2 character(len=sector_name_len), dimension(ed42_nsect_hc) :: ed42_hc_sectors ! NMVOC sectors in EDGAR 4.2 character(len=sector_name_len), dimension(ed42_nsect_nh3) :: ed42_nh3_sectors ! NH3 sectors in EDGAR 4.2 character(len=sector_name_len), dimension(ed42_nsect_so2) :: ed42_so2_sectors ! SO2 sectors in EDGAR 4.2 ! ------------------------------ ! data used to construct filenames ! ------------------------------ character(len=15), parameter :: filestr_common_pre = 'IPCC_emissions' character(len=25), parameter :: filestr_common_post = '0.5x0.5.nc' ! ------------------------------ ! identifier of RCPs (RCP26, RCP45,...) ! ------------------------------ character(len=5) :: filestr_rcpiden ! ------------------------------ ! available years and related parameters/variables ! ------------------------------ ! availability (min, max years) - Limit MACC and MEGAN to one year for EC-Earth integer, dimension(2), parameter :: retro_avail = (/1960, 2000/) integer, dimension(2), parameter :: ar5_avail = (/1850, 2100/) integer, dimension(2), parameter :: macc_avail = (/1998, 1998/) integer, dimension(2), parameter :: ed41_avail = (/2005, 2005/) integer, dimension(2), parameter :: ed42_avail = (/1970, 2008/) integer, dimension(2), parameter :: lpj_avail = (/1990, 2008/) integer, dimension(2), parameter :: hymn_avail = (/ 999, 999/) ! not used integer, dimension(2), parameter :: gfed3_avail = (/1997, 2010/) integer, dimension(2), parameter :: megan_avail = (/2000, 2000/) integer, parameter :: ar5_nr_avail_yrs = 27 integer, dimension(ar5_nr_avail_yrs), parameter :: & ar5_avail_yrs = (/ 1850, 1860, 1870, 1880, 1890, 1900, & 1910, 1920, 1930, 1940, 1950, 1960, & 1970, 1980, 1990, & 2000, 2005, 2010, 2020, 2030, 2040, & 2050, 2060, 2070, 2080, 2090, 2100 /) integer, parameter :: ed41_nr_avail_yrs = 12 integer, dimension(ed41_nr_avail_yrs), parameter :: & ed41_avail_yrs = (/ 1970, 1975, 1980, 1985, 1990, 1995, 2000, & 2001, 2002, 2003, 2004, 2005 /) logical, dimension(:), allocatable :: ltimeind logical, save :: lpj_fractions_found real, dimension(:,:,:), allocatable :: lpj_frac_wetlands real, dimension(:,:,:), allocatable :: lpj_frac_rice real, dimension(:,:), allocatable :: lpj_frac_peatlands character(len=7) :: ar5_coverage = 'monthly' character(len=7) :: ed4_coverage = 'yearly ' character(len=7) :: lpj_coverage = 'monthly' ! AR5 list of species available for each category character(len=26), target, dimension(31) :: ar5_cat_ant=(/ & 'Acids ', 'alcohols ', 'BC ', & 'benzene ', 'butanes ', 'CH4 ', & 'chlorinated_HC ', 'CO ', 'esters ', & 'ethane ', 'ethene ', 'ethers ', & 'ethyne ', 'formaldehyde ', 'hexanes_and_higher_alkanes', & 'ketones ', 'NH3 ', 'NMVOC ', & 'NO ', 'OC ', 'other_alkanals ', & 'other_alkenes_and_alkynes ', 'other_aromatics ', 'other_VOC ', & 'pentanes ', 'propane ', 'propene ', & 'SO2 ', 'toluene ', 'trimethyl_benzenes ', & 'xylene '/) character(len=26), target, dimension(3) :: ar5_cat_air=(/ & 'BC ', 'NO2 ', 'NO '/) character(len=26), target, dimension(22) :: ar5_cat_shp=(/ & 'BC ', 'benzene ', 'butanes ', & 'CH4 ', 'CO ', 'ethane ', & 'ethene ', 'ethyne ', 'hexanes_and_higher_alkanes', & 'NH3 ', 'NMVOC ', 'NO ', & 'OC ', 'other_alkenes_and_alkynes ', 'other_aromatics ', & 'pentanes ', 'propane ', 'propene ', & 'SO2 ', 'toluene ', 'trimethyl_benzenes ', & 'xylene '/) character(len=26), target, dimension(31) :: ar5_cat_bmb=(/ & 'acids ', 'alcohols ', 'BC ', & 'benzene ', 'butanes ', 'CH4 ', & 'chlorinated_HC ', 'CO ', 'ethane ', & 'ethene ', 'ethers ', 'ethyne ', & 'formaldehyde ', 'hexanes_and_higher_alkanes', 'isoprene ', & 'ketones ', 'NH3 ', 'NMVOC ', & 'NO ', 'OC ', 'other_alkanals ', & 'other_alkenes_and_alkynes ', 'other_aromatics ', 'other_VOC ', & 'pentanes ', 'propane ', 'propene ', & 'SO2 ', 'terpenes ', 'toluene ', & 'xylene '/) ! and number of sectors in each category integer, public :: n_ar5_ant_sec, n_ar5_shp_sec, n_ar5_air_sec, n_ar5_bmb_sec ! reduced ar5 species available per anthro-sector (to screen out unavailable VOC) character(len=26), target, dimension(28) :: ar5_cat_ant_ene_ind=(/ & 'acids ', 'alcohols ', 'BC ', & 'benzene ', 'butanes ', 'CH4 ', & 'CO ', 'ethane ', 'ethene ', & 'ethyne ', 'formaldehyde ', 'hexanes_and_higher_alkanes', & 'ketones ', 'NH3 ', 'NMVOC ', & 'NO ', 'OC ', 'other_alkanals ', & 'other_alkenes_and_alkynes ', 'other_aromatics ', 'other_VOC ', & 'pentanes ', 'propane ', 'propene ', & 'SO2 ', 'toluene ', 'trimethyl_benzenes ', & 'xylene '/) character(len=26), target, dimension(29) :: ar5_cat_ant_dom=(/& 'acids ', 'alcohols ', 'BC ', & 'benzene ', 'butanes ', 'CH4 ', & 'CO ', 'ethane ', 'ethene ', & 'ethers ', 'ethyne ', 'formaldehyde ', & 'hexanes_and_higher_alkanes', 'ketones ', 'NH3 ', & 'NMVOC ', 'NO ', 'OC ', & 'other_alkanals ', 'other_alkenes_and_alkynes ', 'other_aromatics ', & 'other_VOC ', 'pentanes ', 'propane ', & 'propene ', 'SO2 ', 'toluene ', & 'trimethyl_benzenes ', 'xylene '/) character(len=26), target, dimension(27) :: ar5_cat_ant_agr=(/ & 'acids ', 'alcohols ', 'BC ', & 'benzene ', 'butanes ', 'CH4 ', & 'CO ', 'ethane ', 'ethene ', & 'ethers ', 'ethyne ', 'formaldehyde ', & 'hexanes_and_higher_alkanes', 'ketones ', 'NH3 ', & 'NMVOC ', 'NO ', 'OC ', & 'other_alkanals ', 'other_alkenes_and_alkynes ', 'other_aromatics ', & 'pentanes ', 'propane ', 'propene ', & 'SO2 ', 'toluene ', 'xylene '/) character(len=26), target, dimension(25) :: ar5_cat_ant_awb=(/& 'acids ', 'alcohols ', 'BC ', & 'benzene ', 'butanes ', 'CH4 ', & 'CO ', 'ethane ', 'ethene ', & 'ethyne ', 'formaldehyde ', 'hexanes_and_higher_alkanes', & 'ketones ', 'NH3 ', 'NMVOC ', & 'NO ', 'OC ', 'other_alkanals ', & 'other_alkenes_and_alkynes ', 'pentanes ', 'propane ', & 'propene ', 'SO2 ', 'toluene ', & 'xylene '/) character(len=26), target, dimension(18) :: ar5_cat_ant_slv=(/& 'alcohols ', 'BC ', 'CH4 ', & 'chlorinated_HC ', 'CO ', 'esters ', & 'ethers ', 'hexanes_and_higher_alkanes', 'ketones ', & 'NH3 ', 'NMVOC ', 'NO ', & 'OC ', 'other_aromatics ', 'other_VOC ', & 'SO2 ', 'toluene ', 'xylene '/) character(len=26), target, dimension(29) :: ar5_cat_ant_tra=(/& 'BC ', 'benzene ', 'butanes ', & 'CH4 ', 'chlorinated_HC ', 'CO ', & 'esters ', 'ethane ', 'ethene ', & 'ethers ', 'ethyne ', 'formaldehyde ', & 'hexanes_and_higher_alkanes', 'ketones ', 'NH3 ', & 'NMVOC ', 'NO ', 'OC ', & 'other_alkanals ', 'other_alkenes_and_alkynes ', 'other_aromatics ', & 'other_VOC ', 'pentanes ', 'propane ', & 'propene ', 'SO2 ', 'toluene ', & 'trimethyl_benzenes ', 'xylene '/) ! ------------------------------ ! gridbox area (to be read only once per proc) ! ------------------------------ character(len=25),parameter :: ar5_filestr_gridboxarea = 'gridbox_area.nc' character(len=25),parameter :: ed4_filestr_gridboxarea = 'gridbox_area.nc' character(len=25),parameter :: lpj_filestr_gridboxarea = 'maps/lpj_gridcell_area.nc' logical, save :: area_found_05 logical, save :: lpj_area_found real, dimension(:,:), allocatable :: gridbox_area_05 ! gridbox area on 0.5x0.5 deg - used for AR5, MACC, EDGAR, GFED, RETRO, MEGAN real, dimension(:,:), allocatable :: lpj_gridbox_area ! ----------------------- ! data type for sectors ! ----------------------- type sector_type sequence character(len=sector_name_len) :: name ! name of sector character(len=categ_name_len) :: catname ! name of category to be found in logical :: f3d ! 3d-data y/n character(len=vd_class_name_len) :: vdisttype ! vertical distribution type (equal to "classes" still to be defined) character(len=8) :: prov ! provider of information (AR5, MACC, ED4) character(len=26), dimension(:), pointer :: species ! list of species available for that sector (use for AR5 only) end type sector_type type provider_type character(len=8) :: name integer :: nsect2d, nsect3d end type provider_type type(sector_type), dimension(numb_sectors) :: sectors_def type(provider_type), dimension(numb_providers) :: providers_def ! ---------------------------------------------------------------------------------- ! NMVOC settings ! ---------------------------------------------------------------------------------- ! ------------------------------------------------------------------- ! A R 5 ( following GEMS setup ) - also used for EDGAR ! ------------------------------------------------------------------- ! ! Quotation of emission_tools_gems.F90: ! ------------------------------------- ! Distribution of NMV over the CBM-4 components (kg C/kg NMV) . ! VOC numbering according to TNO/RETRO speciation. ! Anthropogenic emissions of isoprene (ivoc=10), monoterpenes(ivoc=11) and others(ivoc=25) ! are not used (set to zero in voc2c_tno and voc2c_fires) . ! The speciation is slightly different for biomass burning emissions, where: ! voc_1 is methanol (which does not contribute) instead of alcohols, ! voc_23 is acetone instead of ketones and ! acetaldehyde is given instead of 'other aldehydes' (voc_22) ! For biomass burning isoprene (ivoc_10) and monoterpene (ivoc_11) are nonzero ! and need to be included separately. ! integer, parameter :: emis_ar5_nvoc = 25 ! ! AR5 components TM4-RETRO Available EDGAR41 UNavailable EDGAR42 from ED42_HC_SECTORS ! Transport sectors (1A3*) (ignoring 1A3* transport, and 5A_C_D_F_4E fires) ! -------------------------------------------------------------------------------------------------------------------------- ! alcohols 1) alcohols 1A3b_c_e (2005 only) 1A4 ! ethane 2) ethane 1A3b_c_e 1A3d1 1A3d_SHIP = id. 3 ! propane 3) propane id. 3 ! butanes 4) butanes id. 3 ! pentanes 5) pentanes id. 3 ! hexanes and higher alkanes 6) hexanes and higher alkanes id. ! ethene 7) ethene id. 3 ! propene 8) propene id. 3 ! ethyne 9) ethyne id. 3 ! isoprene 10) isoprene --none-- all ! terpenes 11) terpenes --none-- all ! other alkenes and alkynes 12) lumped alkenes id. 3 ! benzene 13) benzene id. 3 ! toluene 14) toluene id. ! xylene 15) xylene id. ! trimethyl benzenes 16) trimethylbenzene id. 3; 4F ! other aromatics 17) other_aromatics id. 4F ! esters 18) esters 1A3b_c_e 1A1a, 1A1b_c_1B_2C1_2C2, 1A2, 2A_B_D_E_F_G, 4F; 7A ! ethers 19) ethers 1A3b_c_e 1A1a, 1A1b_c_1B_2C1_2C2, 1A2, 2A_B_D_E_F_G, 4F; 7A ! chlorinated HC 20) Cl HC 1A3b_c_e 1A1a, 1A1b_c_1B_2C1_2C2, 1A2, 2A_B_D_E_F_G, 4F; 7A ! formaldehyde 21) formaldehyde 1A3b_c_e 3 ! other alkanal 22) acetaldehyde 1A3b_c_e 3 ! ketones 23) acetone/ketones 1A3b_c_e ! acids 24) acids 1A3b_c_e (2005 only) 1A4; 3 ! other VOC 25) othervoc 1A3b_c_e 4F ! character(len=26), parameter :: emis_ar5_voc_name(emis_ar5_nvoc) = (/ & 'alcohols ', & ! 1 'ethane ', & ! 2 'propane ', & ! 3 'butanes ', & ! 4 'pentanes ', & ! 5 'hexanes_and_higher_alkanes', & ! 6 'ethene ', & ! 7 'propene ', & ! 8 'ethyne ', & ! 9 'isoprene ', & ! 10 'terpenes ', & ! 11 'other_alkenes_and_alkynes ', & ! 12 'benzene ', & ! 13 'toluene ', & ! 14 'xylene ', & ! 15 'trimethyl_benzenes ', & ! 16 'other_aromatics ', & ! 17 'esters ', & ! 18 'ethers ', & ! 19 'chlorinated_HC ', & ! 20 'formaldehyde ', & ! 21 'other_alkanals ', & ! 22 'ketones ', & ! 23 'acids ', & ! 24 'other_VOC ' /) ! 25 ! ! voc_to_cbm4: Table to convert kg(nmvoc) to 'kg(cbm4) for variable cbm4 ! JEW: the addition of some components is reassessd for eg butanes/pentanes ! JEW: see xl file : TAR_VOC_emissions_speciation-TM-2010 ! JEW: for other voc species 20% of total C is assumed to be PAR real, parameter :: emis_ar5_voc2cbm4_default(emis_ar5_nvoc*ncb4) = (/ & ! PAR 3.3946E-01 , xmc/(2*xmc+6*xmh) , 1.5*xmc/(3*xmc+8*xmh) , 4.0*(xmc/(4*xmc+10*xmh)) , 5.0*(xmc/(5*xmc+12*xmh)) , & 6.0*(xmc/(6*xmc+14*xmh)) , 0.0 , xmc/(3*xmc+6*xmh) , 4.6157E-01 , 0.0 , & 0.0 , 4.9970E-01 , xmc/(xmc*6+xmh*6) , xmc/(xmc*7+xmh*8) , xmc/(xmc*8+xmh*10) , & 2.0997E-01 , 2.5229E-01 , 3.6635E-01 , 3.8643E-01 , 2.6354E-01 , & 0.0 , 0.0 , 4.4762E-01 , 1.8433E-01 , 1.85E-01 , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , 0.0 , 3.5668E-01 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmald2/(2*xmc+xmo+4*xmh) , 0.0 , 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.2*(xmgly/92.) , 2.7167E-01 , & 2.3978E-01 , 2.2409E-01 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 1.0 , 0.0 , 0.0 , 0.0 , 0.0 /) ! ! The table below is used for the RETRO FIRES inventory only. ! It differs from the default AR5 table above in that ! methanol and acetaldehyde are provided directly. ! Remaining differences are either small or ! occur for species that are not provided. real, parameter :: emis_ar5_voc2cbm4_biomassb(emis_ar5_nvoc*ncb4) = (/ & ! PAR 0.0 , xmpar/(2*xmc+6*xmh) , 1.5*xmpar/(3*xmc+8*xmh) , 4.0*(xmc/( 4*xmc+10*xmh)) , 5.0*(xmc/(5*xmc+12*xmh)) , & 6.0*(xmc/(6*xmc+14*xmh)), 0.0 , xmpar/(3*xmc+6*xmh) , 4.6157E-01 , 0.0 , & 0.0 , 0.0 , xmc/(xmc*6+xmh*6) , xmc/(xmc*7+xmh*8) , xmc/(xmc*8+xmh*10) , & 2.9995E-01 , 2.5229E-01 , 3.6635E-01 , 3.8643E-01 , 2.6354E-01 , & 0.0 , 0.0 , 2*xmc/(3*xmc+xmo+6*xmh) , 1.8433E-01 , 0.0 , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , 0.0 , 3.5693E-01 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmald2/(2*xmc+xmo+4*xmh), 0.0 , 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.2*(xmgly/92.) , 2.7167E-01 , & 2.3996E-01 , 2.2426E-01 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 1.0 , 0.0 , 0.0 , 0.0 , 0.0 /) ! voc_to_cbm4: Table to convert kg(nmvoc) to kg(cbm4) for variable cbm4 ! specific for biogenic emissions ! For alcohols methanol is used to account for ethanol. Therefore ! use 0.1 scaling factor. For other species the ratio of xmpar/xmspecies is adopted, ! using molecular weights for each species given in Schultz and Stein (2004) ! For species that have no biogenic contribution we adopt a value of 0. real, parameter :: emis_ar5_voc2cbm4_biogenic(emis_ar5_nvoc*ncb4) = (/ & ! PAR 0.1 , xmpar/(2*xmc+6*xmh) , 1.5*xmpar/(3*xmc+8*xmh), 4.0*(xmc/(4*xmc+10*xmh)), 5.0*(xmc/(5*xmc+12*xmh)) , & 8.4049E-01 , 0.0 , xmpar/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , 4.9970E-01 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.3184 , 0.0 , 0.0 , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmald2/(2*xmc+xmo+4*xmh), 0.0 , 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.2*(xmgly/92.) , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 1.0 , 0.0 , 0.0 , 0.0 , 0.0 /) ! ------------------------------------------------------------------- ! M A C C ! ------------------------------------------------------------------- ! ! Distribution of NMV over the CBM-4 components (kg C/kg NMV) . ! VOC numbering according to TNO/RETRO speciation. ! Anthropogenic emissions of isoprene (ivoc=10), monoterpenes(ivoc=11) and others(ivoc=25) ! are not used (set to zero in voc2c_tno and voc2c_fires) . ! The speciation is slightly different for biomass burning emissions, where: ! voc_1 is methanol (which does not contribute) instead of alcohols, ! voc_23 is acetone instead of ketones and ! acetaldehyde is given instead of 'other aldehydes' (voc_22) ! For biomass burning isoprene (ivoc_10) and monoterpene (ivoc_11) are nonzero ! and need to be included separately. ! integer, parameter :: emis_macc_nvoc = 14 ! ! TM4-RETRO names MACC/grg names ! ---------------------------------- ------------------------ ! 2.1 CO ! 2.2 NO ! 1 alcohols 2.x CH3OH <- no C-C bond: not included TM5 ! 2.4 C2H5OH <-1 PAR ! 2 ethane 2.5 C2H6 ! 3 propane 2.6 C3H8 ! 2.7 BIGALK: lumped_alkanes: (58 g/mole = butane) ! 4 butanes incl- c4h10 ! 5 pentanes ! 6 hexanes_plus_higher_alkanes ! 7 ethene 2.8 C2H4 ! 8 propene 2.9 C3H6 ! 9 ! 10 2.10 ISOPRENE ! 11 2.11 TERPENES ! 12 other_alkenes_and_alkynes 2.12 BIKENE: lumped_alkenes (56 g/mole -> CBM-5 speciation gives one OLE. (1 double bond) ! 2.13 TOLUENE: lumped_aromatics: ! 13 incl?- benzene ! 14 - toluene ! 15 xylene - xylene ! 16 trimethylbenzenes ! 17 other_aromatics ! 18 esters ! 19 ethers ! 20 chlorinated_hydrocarbons ! 21 methanal 2.14 CH2O (formaldehyde,methanal) ! 22 alkanals 2.15 CH3CHO (acetaldehyde,acetal) ! 23 ketones 2.16 CH3COCH3: acetone ! 24 acids ! 2.17 h2 ! ! vh. According to Angelika Heil (FZ Juelich) the mol. weights for lumped species in biomass burning are ! vh different from the anthropogenic emissions, as follows: ! vh Ankelika Heil: ! We updated these molecular weights for biomass burning for the MOZART ! lumped groups as follows: ! Higher_Alkanes: 58 g/mole ==> 78.8 g/mole ! Higher_Alkenes: 56 g/mole ==> 64.0 g/mole ! Toluene_lump: 92 g/mole ==> 85.7 g/mole ! The MOZART lumped groups were formed as follows: ! Toluene_lump (C7H8+ C6H6 + C8H10): MOZART lumped toluene species, ! incorporating benzene, toluene, xylene ! Higher Alkenes (CnH2n, C>=4): all alkenes (C>=4) specified in Andreae ! and Merlet (2001) which are not contained in the Toluene_lump group. ! These are: Butenes (1-butene + i-butene + tr-2-butene + cis-2-butene) ! (C4H8), Pentenes (1-pentene + 2-pentene) (C5H10), Hexene (C6H12), ! Octene (C8H16) ! Higher Alkanes (CnH2n+2, C>=4): all alkanes (C>=4) specified in Andreae ! and Merlet (2001). These are: Butanes (n-butane + i-butane) (C4H10), ! Pentanes (n-pentane + i-pentane) (C5H12), Hexane (n-hexane + i-hexane) ! (C6H14), Heptane (C7H16) ! We calculated the molecular weight of these lumped groups from weighting ! the molecular mass of the individual species with their relative mass ! contribution to the total fire emissions of each group during 2001-2006 ! (calculated from GFEDv2 data). ! JEW: looking at the decomposition of TOL reveals ther is a product yield of 0.2MGLY ! which should be added analogous to the xylene > MGLY link in Houweling et al. (1998) integer, parameter :: emis_gfed_nvoc = 11 ! the same as MACC, except CH3CHO, CH3COCH3, and MEK ! From the CB05 speciation guide : CH3COCH3 = 3.0*par ! character(len=26), parameter :: emis_macc_voc_name(emis_macc_nvoc) = (/ & 'C2H5OH ', & ! 1 'C2H6 ', & ! 2 'C3H8 ', & ! 3 'BIGALK ', & ! 4 'C2H4 ', & ! 5 'C3H6 ', & ! 6 'ISOPRENE ', & ! 7 'TERPENES ', & ! 8 'BIGENE ', & ! 9 'TOLUENE ', & ! 10 'CH2O ', & ! 11 'CH3CHO ', & ! 12 'CH3COCH3 ', & ! 13 'MEK '/) ! 14 ! voc_to_cbm4: Table to convert kg(nmvoc) to 'kg(cbm4) for variable cbm4 real, parameter :: emis_macc_voc2cbm4_default(emis_macc_nvoc*ncb4) = (/ & ! PAR xmpar/(xmc*2+xmo+xmh*6) , xmpar/(2*xmc+6*xmh) , 1.5*xmpar/(3*xmc+8*xmh) , 4.0*xmpar/(58.0) , & 0.0 , xmpar/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , xmpar/92. , 0.0 , 0.0 , & 3.0*xmpar/(58.) , 4*xmpar/72. , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , & xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & xmole/(56.) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , xmald2/44. , & 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.2*(xmgly/92.) , 0.0 , 0.0 , & 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 1.0 , 0.0 , & 0.0 , 0.0 /) ! For Biomass burning, use a the same table real, parameter :: emis_macc_voc2cbm4_biomassb(emis_macc_nvoc*ncb4) = (/ & ! PAR xmpar/(xmc*2+xmo+xmh*6) , xmpar/(2*xmc+6*xmh) , 1.5*xmpar/(3*xmc+8*xmh) , 4.0*xmpar/(78.8) , & 0.0 , xmpar/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , xmpar/85.7 , 0.0 , 0.0 , & 2*xmpar/(3*xmc+xmo+6*xmh) ,4*xmpar/72. , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , & xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & xmole/(64.) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , xmald2/44. , & 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.2*(xmgly/92.) , 0.0 , 0.0 , & 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 1.0 , 0.0 , & 0.0 , 0.0 /) ! specific for biogenic emissions real, parameter :: emis_macc_voc2cbm4_biogenic(emis_macc_nvoc*ncb4) = (/ & ! PAR xmpar/(xmc*2+xmo+xmh*6) , xmpar/(2*xmc+6*xmh) , 1.5*xmpar/(3*xmc+8*xmh) , 4.0*xmpar/(58.0) , & 0.0 , xmpar/(3*xmc+6*xmh) , 0.0 , 0.0 , & 0.0 , xmpar/92. , 0.0 , 0.0 , & 2*xmpar/(3*xmc+xmo+6*xmh) ,4*xmpar/72. , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , & xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & xmole/(56.) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , xmald2/44. , & 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.2*(xmgly/92.) , 0.0 , 0.0 , & 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 1.0 , 0.0 , & 0.0 , 0.0 /) ! ------------------------------------------------------------------- ! M A C C - M E G A N ! ------------------------------------------------------------------- ! ! Distribution of NMV over the CBM-4 components (kg C/kg NMV) . ! VOC numbering according to TNO/RETRO speciation. ! The speciation is slightly different for biomass burning emissions, where: ! voc_1 is methanol (which does not contribute) instead of alcohols, ! voc_23 is acetone instead of ketones and ! acetaldehyde is given instead of 'other aldehydes' (voc_22) ! For biomass burning isoprene (ivoc_10) and monoterpene (ivoc_11) are nonzero ! and need to be included separately. ! ! ! TM4-RETRO names MEGAN/grg names ! ---------------------------------- ------------------------ ! 2.1 CO ! 1 alcohols 2.2 methanol <- no C-C bond: not included TM5 ! 2.3 ethanol <-1 PAR ! 2 ethane 2.4 ethane ! 3 propane 2.5 propane ! 4 butanes 2.6 butanes_and_higher_alkanes (58 g/mole = butane) ! incl- c4h10 ! 5 pentanes ! 6 hexanes_plus_higher_alkanes ! 7 ethene 2.7 ethene ! 8 propene 2.8 propene ! 9 ! 10 2.10 ISOPRENE ! 11 2.11 monoterpenes ! 12 other_alkenes_and_alkynes 2.12 butenes_and_higher_alkenes -> (56g/mole = butene) ! 13 2.13 toluene (92g/mole=toluene) <- 0.2 MGLY ! 14 ! 15 xylene ! 16 trimethylbenzenes ! 17 other_aromatics ! 18 esters ! 19 ethers ! 20 chlorinated_hydrocarbons ! 21 methanal 2.14 formaldehyde ! 22 alkanals 2.15 acetaldehyde ! 2.16 other_aldehydes (44g/mole=C2 and above aldehydes): ignore other double count ! 23 ketones 2.17 acetone ! 2.18 other_ketones (72g/mole=other ketones except acetone): <-4*PAR as lower limit ! 24 acids 2.19 formic acid <- no C-C bond: not included TM5 ! 2.20 acetic acid <-1 PAR ! integer, parameter :: emis_megan_nvoc = 18 ! the same as MACC, except no MEK character(len=26), parameter :: emis_megan_voc_name(emis_megan_nvoc) = (/ & 'methanol ', & ! 1 'ethanol ', & ! 2 'ethane ', & ! 3 'propane ', & ! 4 'butanes_and_higher_alkanes', & ! 5 'ethene ', & ! 6 'propene ', & ! 7 'isoprene ', & ! 8 'monoterpenes ', & ! 9 'butenes_and_higher_alkenes', & ! 10 'toluene ', & ! 11 'formaldehyde ', & ! 12 'acetaldehyde ', & ! 13 'other_aldehydes ', & ! 14 'acetone ', & ! 15 'other_ketones ', & ! 16 'formic_acid ', & ! 17 'acetic_acid '/) ! 18 ! specific for MEGAN biogenic emissions real, parameter :: emis_megan_voc2cbm4_biogenic(emis_megan_nvoc*ncb4) = (/ & ! PAR 0.0 , xmpar/(2*xmc+xmo+5*xmh), xmpar/(2*xmc+6*xmh), xmpar/(3*xmc+8*xmh), & 4.0*xmpar/(58.0) , 0.0 , xmpar/(3*xmc+6*xmh) , 0.0 , 0.0 , & xmpar/(4*xmc+xmh*8) , xmpar/(92.0) , 0.0 , 0.0 , 0.0 , & 3.0*xmpar/(58.0) , 4.0*xmpar/(72.0) , 0.0 , xmpar/(60.0) , & ! ETH 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & ! OLE 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , xmole/(3*xmc+6*xmh) , 0.0 , 0.0 , & xmole/(56.) , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & ! ALD2 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , xmald2/44. , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & ! MGLY 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.2*xmgly/(92.0) , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , & ! CH2O 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , & 0.0 , 0.0 , 0.0 , 0.0 /) character(len=26), parameter :: emis_gfed_voc_name(emis_gfed_nvoc) = (/ & 'c2h5oh ', & ! 1 'c2h6 ', & ! 2 'c3h8 ', & ! 3 'higher_alkanes ', & ! 4 'c2h4 ', & ! 5 'c3h6 ', & ! 6 'isoprene ', & ! 7 'terpenes ', & ! 8 'higher_alkenes ', & ! 9 'toluenes ', & ! 10 'ch2o '/) ! 11 ! NB: base the RETRO voc speciation on AR5 (retro species are a subset of AR5) character(len=26), parameter :: emis_retro_voc_name(emis_ar5_nvoc) = (/ & 'not provided ', & ! 1 ! only methanol provided, we do not include it 'ETHANE ', & ! 2 'PROPANE ', & ! 3 'not provided ', & ! 4 'not provided ', & ! 5 'not provided ', & ! 6 'ETHENE ', & ! 7 'PROPENE ', & ! 8 'ETHYNE ', & ! 9 'ISOPRENE ', & ! 10 'MONOTERPENES ', & ! 11 'not provided ', & ! 12 'BENZENE ', & ! 13 'TOLUENE ', & ! 14 'XYLENE ', & ! 15 'not provided ', & ! 16 'not provided ', & ! 17 'not provided ', & ! 18 'not provided ', & ! 19 'not provided ', & ! 20 'CH2O ', & ! 21 'CH3CHO ', & ! 22 'ACETONE ', & ! 23 'not provided ', & ! 24 'not provided ' /) ! 25 ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 for AR5, MACC ! 1 Dec 2011 - Narcisa Banda - added EDGAR 4.1 and 4.2 ! 19 Jun 2012 - P. Le Sager - cosmetic for lon-lat MPI domain decomposition ! (all reading/regridding on root for now) ! 20 Nov 2012 - Ph. Le Sager - defined and build lists of used providers ! - deal with inventories years availability ! - switch to MDF interface to read data ! ! !TODO: ! - should be renamed something like "emission_inventories" or "emiss_providers" ! - and need to get a **SEPARATE** module for each inventories, before it ! becomes unmanageable again ! !EOP !------------------------------------------------------------------------ CONTAINS !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_READ_INIT ! ! !DESCRIPTION: Initialise reading related parameters and ! allocate needed arrays ! !\\ ! !INTERFACE: ! SUBROUTINE EMISSION_READ_INIT( rcF, status ) ! ! !USES: ! use GO, only : TrcFile, ReadRc use partools, only : isRoot use emission_data, only : LAR5, LEDGAR4, LRETROF, LGFED3, LMACC, LLPJ, LHYMN, LAR5BMB, LMACCITY, LMEGAN use meteodata, only : set, gph_dat use dims, only : im, jm, lm, nregions ! ! !INPUT PARAMETERS: ! type(TrcFile) :: rcF ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 for AR5 ! 1 Dec 2011 - Narcisa Banda - added EDGAR 4.1 and 4.2 ! 20 Nov 2012 - Ph. Le Sager - build lists of used providers ! 29 Nov 2014 - Jason Williams - Introduced yearly specific biogenic emissions ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname=mname//'/emission_read_init' integer :: isect, iprov, nused, region logical :: mask(numb_providers), LEDGARCH4 ! --- begin -------------------------------------- call ReadRc( rcF, 'input.emis.AR5.RCP', filestr_rcpiden, status ) IF_ERROR_RETURN(status=1) ! ------------------ ! build list of used providers ! ------------------ ! LMACCITY does not provide anthropogenic CH4, then use EDGAR instead if (LMACCITY) then LEDGARCH4=.true. else LEDGARCH4=LEDGAR4 end if ! CH4 (any inventory, but skip MACC and MEGAN since they have no CH4) mask = (/ LRETROF, LAR5, .false., LEDGARCH4, LEDGARCH4, LLPJ, LHYMN, LGFED3, .false. /) nused = count(mask) if (nused /= 0) then allocate( used_providers_ch4(nused) ) used_providers_ch4 = pack( all_providers, mask) else has_ch4_emis = .false. end if ! ISOP (anything except EDGAR, LPJ and HYMN; AR5 : only if fires requested) mask = (/ LRETROF, LAR5BMB, LMACC, .false., .false., .false., .false., LGFED3, LMEGAN /) nused = count(mask) if (nused /= 0) then allocate( used_providers_isop(nused) ) used_providers_isop = pack( all_providers, mask) else has_isop_emis = .false. end if ! Others gases (anything except LPJ and HYMN) mask = (/ LRETROF, LAR5, LMACC, LEDGAR4, LEDGAR4, .false., .false., LGFED3, LMEGAN /) nused = count(mask) if (nused /= 0) then allocate( used_providers(nused) ) used_providers = pack( all_providers, mask) else has_emis = .false. end if ! BC and POM (anything except EDGAR, LPJ, HYMN and MEGAN) mask = (/ LRETROF, LAR5, LMACC, .false., .false., .false., .false., LGFED3, .false. /) nused = count(mask) if (nused /= 0) then allocate( used_providers_aer(nused) ) used_providers_aer = pack( all_providers, mask) else has_aer_emis = .false. end if ! info if (has_isop_emis) then write(gol,*) 'EMISS-INFO - Emissions providers used for ISOP : ', used_providers_isop ; call goPr else write(gol,*) 'EMISS-INFO - Emissions providers used for ISOP : NONE' ; call goPr end if if ( has_ch4_emis ) then write(gol,*) 'EMISS-INFO - Emissions providers used for CH4 : ', used_providers_ch4 ; call goPr else write(gol,*) 'EMISS-INFO - Emissions providers used for CH4 : NONE' ; call goPr end if if ( has_aer_emis ) then write(gol,*) 'EMISS-INFO - Emissions providers used for BC/POM : ', used_providers_aer ; call goPr else write(gol,*) 'EMISS-INFO - Emissions providers used for BC/POM : NONE' ; call goPr end if if ( has_emis ) then write(gol,*) 'EMISS-INFO - Emissions providers used for others : ', used_providers ; call goPr else write(gol,*) 'EMISS-INFO - Emissions providers used for others : NONE' ; call goPr end if ! ------------------ ! initialise sectors ! ------------------ ! Type sequence is (name, category, is_3D_data, vdisttype, providers) sectors_def( 1) = sector_type('emiss_ene ', 'anthropogenic ', .false., 'combenergy ', 'AR5 ', NULL() ) ! Energy production & distribution sectors_def( 2) = sector_type('emiss_dom ', 'anthropogenic ', .false., 'combrescom ', 'AR5 ', NULL() ) ! Residential and commercial combustion sectors_def( 3) = sector_type('emiss_ind ', 'anthropogenic ', .false., 'industry ', 'AR5 ', NULL() ) ! Industrial processes and combustion sectors_def( 4) = sector_type('emiss_wst ', 'anthropogenic ', .false., 'waste ', 'AR5 ', NULL() ) ! Waste treatment and disposal sectors_def( 5) = sector_type('emiss_agr ', 'anthropogenic ', .false., 'surface ', 'AR5 ', NULL() ) ! Agriculture sectors_def( 6) = sector_type('emiss_awb ', 'anthropogenic ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Agricultural waste burning sectors_def( 7) = sector_type('emiss_slv ', 'anthropogenic ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Solvent production and use sectors_def( 8) = sector_type('emiss_tra ', 'anthropogenic ', .false., 'surface ', 'AR5 ', NULL() ) ! Land transport sectors_def( 9) = sector_type('emiss_shp ', 'ships ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Ships sectors_def(10) = sector_type('emiss_air ', 'aircraft ', .true. , 'aircraft ', 'AR5 ', NULL() ) ! Aircraft sectors_def(11) = sector_type('grassfire ', 'biomassburning', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Grassland Fire sectors_def(12) = sector_type('forestfire', 'biomassburning', .false., 'forestfire ', 'AR5 ', NULL() ) ! Grassland Fire ! macc sectors (-> natural, missing in AR5 and EDGAR ) sectors_def(13) = sector_type('emiss_soil', 'natural ', .false., 'surface ', 'MACC ', NULL() ) ! Natural sources (soil) - only for NO and NH3 sectors_def(14) = sector_type('emiss_oc ', 'natural ', .false., 'surface ', 'MACC ', NULL() ) ! Natural sources (ocean) sectors_def(15) = sector_type('emiss_bio ', 'natural ', .false., 'surface ', 'MACC ', NULL() ) ! Natural sources (biogenic) sectors_def(16) = sector_type('emiss_nat ', 'natural ', .false., 'volcanic ', 'MACC ', NULL() ) ! Natural sources (volcanic) if (LMACCITY) then sectors_def(70) = sector_type('emiss_anthro', 'anthropogenic ', .false., 'combrescom ', 'MACC ', NULL() ) ! Anthropogenic (MACCITY only) sectors_def(71) = sector_type('emiss_air ', 'aircraft ', .true. , 'aircraft ', 'MACC ', NULL() ) ! Aircraft (MACCITY only) else sectors_def(70) = sector_type('emiss_anthro', 'anthropogenic ', .false., 'combrescom ', 'DUMMY ', NULL() ) ! Off if MACC only to provide natural emissions sectors_def(71) = sector_type('emiss_air ', 'aircraft ', .true. , 'aircraft ', 'DUMMY ', NULL() ) ! end if ! MEGAN emissions from MACC sectors_def(72) = sector_type('MEGAN_MACC ', 'natural ', .false., 'surface ', 'MEGAN ', NULL())! Natural sources (soil) ! edgar 4.1 sectors sectors_def(17) = sector_type('1A1_ENE ', 'anthropogenic ', .false., 'combenergy ', 'ED41 ', NULL()) ! Energy production & distribution sectors_def(18) = sector_type('1A2_2 ', 'anthropogenic ', .false., 'industry ', 'ED41 ', NULL()) ! Industrial processes and combustion sectors_def(19) = sector_type('1A3b_c_e ', 'anthropogenic ', .false., 'surface ', 'ED41 ', NULL()) ! Land transport sectors_def(20) = sector_type('1A3a ', 'aircraft ', .true. , 'aircraft ', 'ED41 ', NULL()) ! Aircraft sectors_def(21) = sector_type('1A3d_SHIP ', 'ships ', .false., 'nearsurface ', 'ED41 ', NULL()) ! Ships domestic sectors_def(22) = sector_type('1A3d1 ', 'ships ', .false., 'nearsurface ', 'ED41 ', NULL()) ! Ships international sectors_def(23) = sector_type('1A4_5 ', 'anthropogenic ', .false., 'combrescom ', 'ED41 ', NULL()) ! Residential and commercial combustion sectors_def(24) = sector_type('1B ', 'anthropogenic ', .false., 'combenergy ', 'ED41 ', NULL()) ! Fugitive emissions sectors_def(25) = sector_type('3 ', 'anthropogenic ', .false., 'nearsurface ', 'ED41 ', NULL()) ! Solvent emissions sectors_def(26) = sector_type('4_but_4E ', 'anthropogenic ', .false., 'surface ', 'ED41 ', NULL()) ! Agriculture (soils, waste burning, livestock) sectors_def(27) = sector_type('6A_6C ', 'anthropogenic ', .false., 'waste ', 'ED41 ', NULL()) ! Waste disposal and incineration sectors_def(28) = sector_type('7 ', 'anthropogenic ', .false., 'waste ', 'ED41 ', NULL()) ! Fossil fuel fires ! edgar 4.2 sectors sectors_def(29) = sector_type('1A1a ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy production sectors_def(30) = sector_type('1A1a_6 ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy production and waste (CO & NH3 sector; waste part is small compared to energy, so use energy vdist) sectors_def(31) = sector_type('1A1a_6C ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy production and waste (SO2 sector; waste part is small compared to energy, so use energy vdist) sectors_def(32) = sector_type('1A1_1A2 ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Energy and manufacturing industry (CH4 sector; energy part is small compared to industry, so use industry vdist) sectors_def(33) = sector_type('1A1b_c ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy production sectors_def(34) = sector_type('1A1b_c_1B_2C1_2C2', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy, fugitive and metal industry (NMVOC sector; metal part is small, so use energy vdist) sectors_def(35) = sector_type('1A2 ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Combustion in manufacturing industry sectors_def(36) = sector_type('1A3 ', 'anthropogenic ', .false. , 'nearsurface', 'ED42 ', NULL()) ! Transport (including ships, aircraft!) sectors_def(37) = sector_type('1A3a_c_d_e', 'anthropogenic ', .false. , 'nearsurface', 'ED42 ', NULL()) ! Non-road transport (including ships, aircraft!) sectors_def(38) = sector_type('1A3b ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Road transport sectors_def(39) = sector_type('1A4 ', 'anthropogenic ', .false., 'combrescom ', 'ED42 ', NULL()) ! Residential sectors_def(40) = sector_type('1B1 ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive emissions sectors_def(41) = sector_type('1B1_1B2_1A1b_c', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive and energy emissions sectors_def(42) = sector_type('1B2a ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive emissions sectors_def(43) = sector_type('1B2b ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive emissions sectors_def(44) = sector_type('1B2a_c_1A1b_c', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive and energy emissions sectors_def(45) = sector_type('2A_B_D_E_F_G', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions sectors_def(46) = sector_type('2 ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions sectors_def(47) = sector_type('2A ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions sectors_def(48) = sector_type('2A_2B_2D ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions sectors_def(49) = sector_type('2B ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions sectors_def(50) = sector_type('2C ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions sectors_def(51) = sector_type('3 ', 'anthropogenic ', .false., 'nearsurface ', 'ED42 ', NULL()) ! Solvent emissions sectors_def(52) = sector_type('4A ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agriculture sectors_def(53) = sector_type('4B ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agriculture sectors_def(54) = sector_type('4C_4D ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agriculture sectors_def(55) = sector_type('4F ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agricultural waste burning sectors_def(56) = sector_type('6A_6C ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Waste disposal and incineration sectors_def(57) = sector_type('6B ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Waste disposal and incineration sectors_def(58) = sector_type('7 ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Fossil fuel fires sectors_def(59) = sector_type('7A ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Fossil fuel fires sectors_def(60) = sector_type('5A_C_D_F_4E', 'biomassburning', .false., 'forestfire ', 'ED42 ', NULL()) ! Large scale biomass burning ! natural methane emissions LPJ and HYMN project sectors_def(61) = sector_type('wetlands ', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane from wetlands sectors_def(62) = sector_type('peatlands ', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane from peatlands sectors_def(63) = sector_type('wetsoils ', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane from wet soils sectors_def(64) = sector_type('soilconsumption', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane soil uptake sectors_def(65) = sector_type('oceans ', 'natural ', .false., 'surface ', 'HYMN ',NULL()) ! Methane ocean emissions sectors_def(66) = sector_type('wildanimals', 'natural ', .false., 'surface ', 'HYMN ',NULL()) ! Methane emissions from wild animals sectors_def(67) = sector_type('termites ', 'natural ', .false., 'surface ', 'HYMN ',NULL()) ! Methane ternite emissions ! Biomass burning GFEDv3 monthly sectors_def(68) = sector_type('wildfires ', 'biomassburning', .false., 'forestfire ', 'GFEDv3 ', NULL()) ! Biomass burning RETRO sectors_def(69) = sector_type('fire_emis ', 'biomassburning', .false., 'forestfire ', 'RETRO ',NULL()) ! ------------------------- ! info per species ! ------------------------ ! ED42 sectors are not available for all species, so we define a sectors list per species. !! These are the "ALL AVAILABLE". Kept for reference. !ed42_co_sectors = (/'1A1a_6 ', '1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ', & ! '1B2a_c_1A1b_c', '2A_2B_2D ', '2C ', '4F ', '5A_C_D_F_4E ', '7A ' /) ! !ed42_ch4_sectors = (/'1A1_1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ', '1B1 ', '1B2a ', & ! '1B2b ', '2 ', '4A ', '4B ', '4C_4D ', '4F ', & ! '5A_C_D_F_4E', '6A_6C ', '6B ', '7A '/) ! !ed42_nox_sectors = (/'1A1a ', '1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ',& ! '1B2a_c_1A1b_c', '2 ', '4B ', '4C_4D ', '4F ',& ! '5A_C_D_F_4E ', '6A_6C ', '7A ' /) ! !ed42_hc_sectors = (/'1A1a ', '1A1b_c_1B_2C1_2C2', '1A2 ', '1A3a_c_d_e ', & ! '1A3b ', '1A4 ', '2A_B_D_E_F_G ', '3 ', & ! '4F ', '5A_C_D_F_4E ', '6A_6C ', '7A ' /) ! !ed42_nh3_sectors = (/'1A1a_6 ', '1A1b_c ', '1A2 ', '1A3 ', '1A4 ', '2A ',& ! '2B ', '4B ', '4C_4D ', '4F ', '5A_C_D_F_4E' /) ! !ed42_so2_sectors = (/'1A1a_6C ', '1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ',& ! '1B1_1B2_1A1b_c', '2B_2D ', '2C ', '4F ', '5A_C_D_F_4E ', '7A '/) ! Use only non-transport sectors (they are provided by ED41), and remove biomassburning: ed42_co_sectors = (/'1A1a_6 ', '1A2 ', '1A4 ', '1B2a_c_1A1b_c', '2A_2B_2D ', & '2C ', '4F ', '7A ' /) ed42_ch4_sectors = (/'1A1_1A2 ', '1A4 ', '1B1 ', '1B2a ', '1B2b ', '2 ', & '4A ', '4B ', '4C_4D ', '4F ', '6A_6C ', & '6B ', '7A '/) ed42_nox_sectors = (/'1A1a ', '1A2 ', '1A4 ', '1B2a_c_1A1b_c', '2 ', & '4B ', '4C_4D ', '4F ', '6A_6C ', & '7A ' /) ! Note that '5A_C_D_F_4E' is not only fire, but it is available only for the NMVOC species which we do not use (instead we loop through emis_ar5_nvoc constituents) anyway ed42_hc_sectors = (/'1A1a ', '1A1b_c_1B_2C1_2C2', '1A2 ', & '1A4 ', '2A_B_D_E_F_G ', '3 ', & '4F ', '6A_6C ', '7A ' /) ed42_nh3_sectors = (/'1A1a_6 ', '1A1b_c ', '1A2 ', '1A4 ', '2A ', & '2B ', '4B ', '4C_4D ', '4F ' /) ed42_so2_sectors = (/'1A1a_6C ', '1A2 ', '1A4 ', '1B1_1B2_1A1b_c', '2B_2D ', & '2C ', '4F ', '7A '/) ! ED41 sectors are used only for the transport sector - the screening is ! coded in the *declare routines of each emission_*.F90 according to ! sector name. It boils down to four cases: ! ! (/'1A3a', '1A3b_c_e', '1A3d1', '1A3d_SHIP'/) : NOx ! (/'1A3b_c_e', '1A3d1', '1A3d_SHIP'/) : some NMVOC, CO, CH4, SOx ! (/'1A3b_c_e'/) : some NMVOC, NH3 ! NONE : some NMVOC ! AR5 sectors_def( 1)%species => ar5_cat_ant_ene_ind sectors_def( 2)%species => ar5_cat_ant_dom sectors_def( 3)%species => ar5_cat_ant_ene_ind sectors_def( 4)%species => ar5_cat_ant sectors_def( 5)%species => ar5_cat_ant_agr sectors_def( 6)%species => ar5_cat_ant_awb sectors_def( 7)%species => ar5_cat_ant_slv sectors_def( 8)%species => ar5_cat_ant_tra sectors_def( 9)%species => ar5_cat_shp sectors_def(10)%species => ar5_cat_air sectors_def(11)%species => ar5_cat_bmb sectors_def(12)%species => ar5_cat_bmb n_ar5_ant_sec=8 ! hardcoded but could be counted n_ar5_shp_sec=1 n_ar5_air_sec=1 n_ar5_bmb_sec=2 ! ------------------------- ! initialise providers info ! ------------------------ do iprov = 1, numb_providers providers_def(iprov)%name = all_providers(iprov) providers_def(iprov)%nsect2d = count( (sectors_def%prov == all_providers(iprov)) .and. (sectors_def%f3d .eqv. .false.)) providers_def(iprov)%nsect3d = count( (sectors_def%prov == all_providers(iprov)) .and. (sectors_def%f3d .eqv. .true.)) if(okdebug) then write(gol,'("EMISS-INFO - Inventory ",a," has ",i3, " 2d-sectors, and ",i3," 3d-sectors")')& & all_providers(iprov), providers_def(iprov)%nsect2d, providers_def(iprov)%nsect3d ; call goPr endif end do ! ------------------------- ! initialise GeopPotential Height on 1x1 ! ------------------------ do region=1, nregions call Set( gph_dat(region), status, used=.true. ) end do ! ---------------------------------------- ! allocate gridbox_area arrays ! ---------------------------------------- allocate( gridbox_area_05( nlon720, nlat360 ) ) #ifdef with_ch4_emis allocate( lpj_gridbox_area ( lpj_dim_nlon, lpj_dim_nlat ) ) allocate( lpj_frac_wetlands ( lpj_dim_nlon, lpj_dim_nlat, 12 ) ) allocate( lpj_frac_rice ( lpj_dim_nlon, lpj_dim_nlat, 12 ) ) allocate( lpj_frac_peatlands ( lpj_dim_nlon, lpj_dim_nlat ) ) #endif ! OK status = 0 END SUBROUTINE EMISSION_READ_INIT !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_READ_DONE ! ! !DESCRIPTION: Free allocated arrays. !\\ !\\ ! !INTERFACE: ! subroutine emission_read_done( status ) ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname=mname//'/emission_read_done' deallocate( gridbox_area_05 ) #ifdef with_ch4_emis deallocate( lpj_gridbox_area ) deallocate( lpj_frac_wetlands ) deallocate( lpj_frac_rice ) deallocate( lpj_frac_peatlands ) #endif if (allocated( used_providers )) deallocate( used_providers ) if (allocated( used_providers_ch4 )) deallocate( used_providers_ch4 ) if (allocated( used_providers_isop)) deallocate( used_providers_isop ) if (allocated( used_providers_aer )) deallocate( used_providers_aer ) ! OK status = 0 END SUBROUTINE EMISSION_READ_DONE !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !FUNCTION: EMISSION_COARSEN_TO_1X1 ! ! !DESCRIPTION: Coarsen the gridded information to 1x1 deg. ! (taken from GEMS/MACC repository) !\\ !\\ ! !INTERFACE: ! function emission_coarsen_to_1x1( emis_in, dim_nlon, dim_nlat, shift_lon, status ) ! ! !RETURN VALUE: ! real, dimension(360,180) :: emission_coarsen_to_1x1 ! ! !INPUT PARAMETERS: ! integer, intent(in) :: dim_nlon integer, intent(in) :: dim_nlat real, intent(in) :: emis_in(dim_nlon, dim_nlat) logical, intent(in) :: shift_lon ! ! OUTPUT PARAMETERS: ! integer , intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 for AR5 ! 1 Dec 2011 - Narcisa Banda - works for any input resolution lower than 1x1 ! if 1x1 can be divided into exact number of gridcells (no interpolation) ! 1 Jul 2012 - Narcisa Banda - added the shift_lon logical flag: ! true if the data is read on longitudes [0,360] (then they need to be shifted on [-180,180]) ! false if the data is read already on [-180,180] ! !EOP !------------------------------------------------------------------------ !BOC integer :: i, j integer :: nri, nrj ! --- begin ----------------------------------- ! combine grid cells : ! from [ 0,360]x[-90,90] 001:360,361:720 001:360 ! to [-180,180]x[-90,90] 001:180,181:360 001:180 if ((mod(dim_nlon, 360) /= 0 ) .or. (mod(dim_nlat, 180) /= 0)) then write(gol,*) 'coarsening of emissions to 1x1 does not work for this resolution' ; call goErr status = 1 return endif nri = dim_nlon/360 nrj = dim_nlat/180 if (shift_lon) then ! combine grid cells : ! from [ 0,360]x[-90,90] 001:360,361:720 001:360 ! to [-180,180]x[-90,90] 001:180,181:360 001:180 do j = 1, 180 ! west half do i = 1, 180 emission_coarsen_to_1x1(i,j) = sum(emis_in(nri*180+nri*i-nri+1:nri*180+nri*i,nrj*j-nrj+1:nrj*j)) end do ! east half do i = 1, 180 emission_coarsen_to_1x1(180+i,j) = sum(emis_in(nri*i-nri+1:nri*i,nrj*j-nrj+1:nrj*j)) end do end do else do j=1, 180 do i=1, 360 emission_coarsen_to_1x1(i,j) = sum(emis_in(nri*i-nri+1:nri*i,nrj*j-nrj+1:nrj*j)) end do end do endif ! ok status = 0 end function emission_coarsen_to_1x1 !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !FUNCTION: VALID_YEAR ! ! !DESCRIPTION: return a valid year for an emission inventory, based on ! requested year. !\\ !\\ ! !INTERFACE: ! FUNCTION VALID_YEAR( iyear, iminmax, provider_name, verbose) ! ! !RETURN VALUE: ! integer :: valid_year ! ! !INPUT PARAMETERS: ! integer, intent(in) :: iyear, iminmax(2) character(len=*), intent(in) :: provider_name logical, intent(in) :: verbose ! ! !REVISION HISTORY: ! 26 Nov 2012 - Ph. Le Sager - v0 ! !EOP !------------------------------------------------------------------------ !BOC valid_year = MIN(iminmax(2),MAX(iyear,iminmax(1))) ! info only once a year, and per inventory if (verbose) then write(gol,'(a,i4," (avail: ",i4,"-",i4,")")') ' EMISS-INFO - EMISS YEAR for '//trim(provider_name)//' : ', & valid_year, iminmax ; call goPr end if END FUNCTION VALID_YEAR !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_AR5_READSECTOR ! ! !DESCRIPTION: Reading one sector of the files to be interpolated and ! returning an interpolated 3d emission field (d3data) !\\ !\\ ! !INTERFACE: ! subroutine emission_ar5_ReadSector( comp, iyear, imonth, sector, d3data, status ) ! ! !INPUT PARAMETERS: ! character(len=*) , intent(in) :: comp integer , intent(in) :: iyear integer , intent(in) :: imonth integer , intent(in) :: sector ! ! !OUTPUT PARAMETERS: ! integer , intent(out) :: status real, dimension(nlon360,nlat180,ar5_dim_3ddata), intent(out) :: d3data ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ar5_read2dsector' character(len=256) :: fname character(len=256) :: fname_gridboxarea character(32) :: secname integer :: lt, year logical :: existfile integer, dimension(2) :: ltimes character(len=4), dimension(2) :: ar5_cyears real, dimension(2) :: ar5_ipcoef_years logical :: first=.true. real, dimension(nlon360,nlat180) :: d2data ! --- begin ----------------------------------- ! initialise target array d3data = 0.0 ! read in gridbox-area; once per CPU if( .not. area_found_05 ) then fname_gridboxarea = trim(emis_input_dir_ar5)//'/'//trim(ar5_filestr_gridboxarea) call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, & & nlon720, nlat360, status ) IF_NOTOK_RETURN(status=1) area_found_05=.true. endif ! ---------------------------------------- ! get the right times to interpolate and related coefficients ! (ar5_avail_yrs(ltimes)) ! ! --> result will be a linear interpolation between neighbouring files ! ! ---------------------------------------- allocate( ltimeind( ar5_nr_avail_yrs ) ) ltimeind = .false. ! deal with out-of-bounds requested years year = valid_year( iyear, ar5_avail, 'AR5', first) first=.false. where( ar5_avail_yrs < year ) ltimeind = .true. ! times(1): index representing time instance earlier than current year ! times(2): -"- -"- later than current year ltimes(2) = count( ltimeind ) + 1 ltimes(1) = max( ltimes(2) - 1, 1 ) ! check a match with repository ! (in order to copy only one file instead of two) if( ar5_avail_yrs(ltimes(2)) == year ) & ltimes(1) = ltimes(2) deallocate( ltimeind ) ! ar5_cyears will contain strings with the years write(ar5_cyears(1),'(I4.4)') ar5_avail_yrs(ltimes(1)) write(ar5_cyears(2),'(I4.4)') ar5_avail_yrs(ltimes(2)) ! ar5_ipcoef_years will contain interpolation coefficients ! default: factors 1.0/0.0 ar5_ipcoef_years(1) = 1.0 ar5_ipcoef_years(2) = 0.0 if( ltimes(2) /= ltimes(1) ) then ar5_ipcoef_years(1) = (ar5_avail_yrs(ltimes(2)) - year) / & real( ar5_avail_yrs(ltimes(2)) - ar5_avail_yrs(ltimes(1)) ) ar5_ipcoef_years(2) = 1.0 - ar5_ipcoef_years(1) end if ! ------------------------ ! read files (index=1: earlier file; index=2: later file) ! ------------------------ do lt = 1, 2 if (ar5_ipcoef_years(lt) == 0.) cycle ! ------------------------ ! construct filename ! e.g.: /IPCC_emissions_RCP45_CO_biomassburning_2010_0.5x0.5_v1_21_12_2009.nc ! ------------------------ if (trim(filestr_rcpiden)=='hist') then fname = trim(emis_input_dir_ar5) //'/'// & trim(filestr_common_pre) //'_'// & trim(comp) //'_'// & trim(sectors_def(sector)%catname) //'_'// & ar5_cyears(lt) //'_'// & trim(filestr_common_post) else fname = trim(emis_input_dir_ar5) //'/'// & trim(filestr_common_pre) //'_'// & trim(filestr_rcpiden) //'_'// & trim(comp) //'_'// & trim(sectors_def(sector)%catname) //'_'// & ar5_cyears(lt) //'_'// & trim(filestr_common_post) endif ! test existence of file inquire( file=trim(fname), exist=existfile) if( .not. existfile ) then write (gol,'(" AR5 file `",a,"` not found ")') trim(fname); call goErr status = 1; TRACEBACK; return end if ! ------------------------------------------------ ! data record is read by emission_ar5_Read2/3DRecord ! add data scaled by interpolation factor ar5_ipcoef_years secname = sectors_def(sector)%name ! distinguish 2d/3d sectors if( sectors_def(sector)%f3d ) then d3data(:,:,:) = d3data(:,:,:) + ar5_ipcoef_years(lt) * & emission_ar5_Read3DRecord( fname, secname, imonth, status ) else !>>> TvN ! Set sectoral emissions not provided in the historical AR5 files to zero ! for years before 2000. ! Note these emissions are non-zero in the RCPs. ! It is assumed below that the data for 2000 (and 2005) are taken from the RCP files. if ( ar5_avail_yrs(ltimes(lt)) .lt. 2000 .and. & ( ( trim(secname) .eq. 'emiss_slv' .and. (trim(comp) .eq. 'CO') ) .or. & ( trim(secname) .eq. 'emiss_agr' .and. & ( trim(comp) .eq. 'acids' .or. & trim(comp) .eq. 'alcohols' .or. & trim(comp) .eq. 'benzene' .or. & trim(comp) .eq. 'butanes' .or. & trim(comp) .eq. 'ethane' .or. & trim(comp) .eq. 'ethene' .or. & trim(comp) .eq. 'ethers' .or. & trim(comp) .eq. 'ethyne' .or. & trim(comp) .eq. 'formaldehyde' .or. & trim(comp) .eq. 'hexanes_and_higher_alkanes' .or. & trim(comp) .eq. 'ketones' .or. & trim(comp) .eq. 'other_alkanals' .or. & trim(comp) .eq. 'other_alkenes_and_alkynes' .or. & trim(comp) .eq. 'other_aromatics' .or. & trim(comp) .eq. 'pentanes' .or. & trim(comp) .eq. 'propane' .or. & trim(comp) .eq. 'propene' .or. & trim(comp) .eq. 'toluene' .or. & trim(comp) .eq. 'xylene' ) ) ) ) then d2data(:,:) = 0. else d2data(:,:) = emission_ar5_Read2DRecord( fname, secname, imonth, status ) endif !d3data(:,:,1) = d3data(:,:,1) + ar5_ipcoef_years(lt) * & ! emission_ar5_Read2DRecord( fname, secname, imonth, status ) d3data(:,:,1) = d3data(:,:,1) + ar5_ipcoef_years(lt) * d2data(:,:) !<<< TvN end if IF_NOTOK_RETURN(status=1) end do ! lt end subroutine emission_ar5_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !FUNCTION: EMISSION_AR5_READ2DRECORD ! ! !DESCRIPTION: Read a single 2d record of a given file and ! return a 2d emission field interpolated on 1x1 grid. !\\ !\\ ! !INTERFACE: ! function emission_ar5_Read2DRecord( fname, secname, imonth, status ) ! ! !RETURN VALUE: ! real :: emission_ar5_Read2DRecord(nlon360,nlat180) ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fname character(len=sector_name_len), intent(in) :: secname integer, intent(in) :: imonth ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ar5_Read2DRecord' integer :: fid, varid real :: emis_in(nlon720, nlat360, 1) ! --- begin ----------------------------------- ! initialise emission_ar5_Read2DRecord = 0.0 CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, TRIM(secname), varid, status ) IF_ERROR_RETURN(status=1) if ( varid < 0 ) then write (gol,'("EMISS - AR5 - no `",a,"` emissions in file ",a)') & secname, trim(fname) ; call goErr status=1; TRACEBACK; return else if( okdebug ) then write (gol,'("EMISS-INFO - AR5 - found `",a,"` emissions in file ",a)') & secname, trim(fname) ; call goPr endif CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) ) IF_NOTOK_RETURN(status=1) ! convert from kg(species)/m^2/s to kg(species)/gridbox/s emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05 ! now coarsen to nlon360,nlat180 emission_ar5_Read2DRecord = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360,.true., status ) IF_NOTOK_RETURN(status=1) end if CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 return end function emission_ar5_Read2DRecord !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !FUNCTION: EMISSION_AR5_READ3DRECORD ! ! !DESCRIPTION: read one 3D sector ! !\\ !\\ ! !INTERFACE: ! function emission_ar5_Read3DRecord( fname, secname, imonth, status ) ! ! !RETURN VALUE: ! real :: emission_ar5_Read3DRecord(nlon360,nlat180,ar5_dim_3ddata) ! ! !INPUT/OUTPUT PARAMETERS: ! character(len=*), intent(in) :: fname character(32), intent(inout) :: secname ! ! !INPUT PARAMETERS: ! integer, intent(in) :: imonth ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ar5_Read3DRecord' integer :: fid, varid, lk real, dimension(nlon720,nlat360,ar5_dim_3ddata,1) :: emis_in ! --- begin ----------------------------------- ! initialise emission_ar5_Read3DRecord = 0.0 CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, TRIM(secname), varid, status ) IF_ERROR_RETURN(status=1) if ( varid < 0 ) then write (gol,'("EMISS - AR5 - no `",a,"` emissions in file ",a)') & secname, trim(fname) ; call goErr status=1; TRACEBACK; return else if( okdebug ) then write (gol,'("EMISS-INFO - AR5 - found `",a,"` emissions in file ",a)') & secname, trim(fname) ; call goPr endif CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth/) ) IF_NOTOK_RETURN(status=1) do lk = 1, ar5_dim_3ddata ! convert from kg(species)/m^2/s to kg(species)/gridbox/s : emis_in(:,:,lk,1) = emis_in(:,:,lk,1) * gridbox_area_05 ! now coarsen to nlon360,nlat180 emission_ar5_Read3DRecord(:,:,lk) = emission_coarsen_to_1x1( emis_in(:,:,lk,1) ,& & nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) end do end if CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 return end function emission_ar5_Read3DRecord !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_READGRIDBOXAREA ! ! !DESCRIPTION: ! reading gridbox surface areas for 0.5 x 0.5 Edgar 4 ! needed to scale the emissions from mass/m^2 to mass/grid !\\ !\\ ! !INTERFACE: ! subroutine emission_ReadGridboxArea(fname, recname, gridbox_area, dim_nlon, dim_nlat, status ) ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fname character(len=*), intent(in) :: recname integer, intent(in) :: dim_nlon integer, intent(in) :: dim_nlat ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status real, dimension(dim_nlon, dim_nlat), intent(out) :: gridbox_area ! ! !REVISION HISTORY: ! ! 1 Oct 2010 - Achim Strunk - v0 ! 1 Dec 2011 - Narcisa Banda - generalized it for any gridbox area size ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ReadGridboxArea' integer :: fid, varid ! --- begin ----------------------------------- CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, TRIM(recname), varid, status ) IF_ERROR_RETURN(status=1) CALL MDF_Get_Var( fid, varid, gridbox_area, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine emission_ReadGridboxArea !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_AR5_REGRID_AIRCRAFT ! ! !DESCRIPTION: Vertical regridding of the AR5 aircraft data. ! The vertical levels of the input data are hard coded. ! (Taken from GFED_daily_AR5 (VH) and left as is) !\\ !\\ ! !INTERFACE: ! subroutine emission_ar5_regrid_aircraft(region, i0, j0, field_in, field_out, status ) ! ! !USES: ! use meteodata, only : gph_dat use tm5_distgrid, only : dgrid, get_distgrid use dims, only : lm ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status ! ! !INPUT PARAMETERS: ! integer, intent(in) :: region, i0, j0 real, dimension(i0:, j0:, 1:), intent(in) :: field_in real, dimension(i0:, j0:, 1:), intent(out) :: field_out ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - Taken from GFED_daily_AR5 (VH) and left as is ! 3 Dec 2012 - Ph. Le Sager - modified for lat-lon mpi decomposition ! - work with zoom regions ! - mass conservation per column ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ar5_regrid_aircraft' integer, parameter :: lm_in=25 ! must be same as ar5_dim_3ddata ! real, dimension(:,:,:), pointer :: gph ! geopotential height (m) integer :: i,j,l real, dimension(lm_in) :: height_in_min, height_in_max real, allocatable :: dz(:), height(:) real :: height_min,height_max real :: height_out_min,height_out_max real, dimension(lm_in), parameter :: height_in=(/ & ! Height in meter 305., 915., 1525., 2135., 2745., 3355., 3965., 4575., 5185., 5795., & 6405., 7015., 7625., 8235., 8845., 9455.,10065.,10675.,11285., & 11895.,12505.,13115.,13725.,14335.,14945./) real :: dz_in(25) integer :: l_in, i1, i2, j1, j2, lmr real :: total_in, total_out, total_ratio ! --- begin -------------------------------------- call golabel() gph => gph_dat(region)%data CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 ) lmr = lm(region) allocate(dz(lmr), height(lmr+1)) ! sanity check if (okdebug) then if (i1/=i0 .or. j1/=j0) then status = 1 ; TRACEBACK return end if if (lm_in /= ubound(field_in,3) ) then write(gol,*)'wrong vertical input resolution'; call goErr status = 1 TRACEBACK; return endif if ((ubound(field_out,3)+1) /= ubound(gph,3)) then write(gol,*)'wrong vertical output resolution'; call goErr status = 1 TRACEBACK; return endif end if ! locally flat atmosphere assumed ! area linear in i,j ! height above sea level height_in_min(1)=0. do l_in = 2,lm_in height_in_min(l_in)=(height_in(l_in-1)+height_in(l_in))/2. enddo height_in_max(lm_in)=15555. do l_in = 1,lm_in-1 height_in_max(l_in)=(height_in(l_in)+height_in(l_in+1))/2. enddo ! init field_out = 0.0 ! regrid do i=i1, i2 do j=j1, j2 total_in = 0.0 ! calculate total input emissions do l_in=1, lm_in dz_in(l_in) = height_in_max(l_in)-height_in_min(l_in) total_in =total_in + field_in(i,j,l_in)*dz_in(l_in) enddo ! zero based height: height(1) = 0.0 do l=1, lmr dz(l) = gph(i,j,l+1) - gph(i,j,l) height(l+1) = height(l) + dz(l) enddo do l=1,lmr-1 height_out_min=height(l) height_out_max=height(l+1) ! write(*,*)'DO AR5- regrid - C2',i,j,l,height_out_min,height_out_max do l_in=1,lm_in if (height_out_max .le. height_in_min(l_in)) exit if (height_out_min .lt. height_in_max(l_in)) then height_max=min(height_out_max,height_in_max(l_in)) height_min=max(height_out_min,height_in_min(l_in)) ! helpfield as field_in is ordered from high to low ! field_out(i,j,l) = field_out(i,j,l) + helpfield2(i,j,lm_in-l_in+1)* & ! (height_max-height_min)/(height_in_max(l_in)-height_in_min(l_in)) ! helpfield as field_in is ordered from low to high ! write(*,*)'DO AR5- regrid - C',i,j,l,l_in,height_max-height_min field_out(i,j,l) = field_out(i,j,l) + field_in(i,j,l_in)* & (height_max-height_min) ! kg/m -> kg / gridbox endif enddo enddo ! conserve total exactly: not possible because units are in kg/m... total_out = sum(field_out(i,j,:)) if (total_out /= 0) then total_ratio = total_in/total_out field_out(i,j,:) = field_out(i,j,:)*total_ratio end if enddo enddo deallocate(dz, height) call golabel() ! ok status = 0 end subroutine emission_ar5_regrid_aircraft !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_MACC_READSECTOR ! ! !DESCRIPTION: Read an MACC sector field out of an open file. !\\ !\\ ! !INTERFACE: ! subroutine emission_macc_ReadSector( fpath, comp, iyear, imonth, fext, recname, unit, emis, status ) ! ! !USES: ! use chem_param, only : xmn, xmno2 ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath ! dir character(len=*), intent(in) :: comp ! species name (as in filename) integer, intent(in) :: iyear integer, intent(in) :: imonth character(len=*), intent(in) :: fext ! tail of filename character(len=*), intent(in) :: recname ! sector name character(len=*), intent(in) :: unit ! ! !OUTPUT PARAMETERS: ! real, intent(out) :: emis(nlon360,nlat180,ar5_dim_3ddata) integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - ! 28 Nov 2012 - Ph. Le Sager - switch to MDF interface ! 6 Jan 2014 - Ph. Le Sager - code for MACCity: 3D emission field to deal with IPCC aircraft file ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_macc_ReadSector' character(len=256) :: fname character(len=256) :: fname_gridboxarea character(len=32) :: fcomp integer :: fid, varid, year, lk real :: emis_in( nlon720, nlat360, ar5_dim_3ddata, 1) logical :: first=.true. ! --- begin ----------------------------------- ! read in gridbox-area; same name as ar5 gridbox area file if( .not. area_found_05 ) then fname_gridboxarea = trim(emis_input_dir_mac)//'/'//trim(ar5_filestr_gridboxarea) call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, & & nlon720, nlat360, status ) IF_NOTOK_RETURN(status=1) area_found_05 = .true. endif ! file name component: fcomp = comp year = valid_year( iyear, macc_avail, 'MACC', first) first = .false. ! zero field emis = 0.0 !=== FILENAME if (trim(recname) == "emiss_air") then ! If MACC-CITY, specific handling of aircraft emissions ! available only for NO or BC if ( (trim(fcomp) /= "NO").and.(trim(fcomp) /= "BC") ) return write (fname,'(a,"/IPCC_emissions_",a,"_aircraft_",i4.4,"_0.5x0.5.nc")') trim(fpath), trim(fcomp), year else write (fname,'(a,"/JUELICH_MACC_reanalysis_",a,"_",i4.4,"_",a)') trim(fpath), trim(fcomp), year, trim(fext) end if !=== SCREEN OUT cases without data (There are more cases, but they are already handled in calling routines.) ! *************************************************************************** ! ****** THIS IS MESSY. IT NEEDS CONSOLIDATION: SHOULD BUILD LIST OF ******** ! ****** SECTORS PER SPECIES, LIKE ED42 ******** ! *************************************************************************** if (trim(recname) == "emiss_oc") then ! no "emiss_oc" for : C2H5OH, BIGALK, ISOPRENE, TERPENES, BIGENE, TOLUENE, CH2O, CH3CHO, CH3COCH3, MEK ! only for : C2H6, C3H8, C2H4, C3H6, NH3, and CO if ( (trim(fcomp) /= "C2H6").and.(trim(fcomp) /= "C3H8").and.(trim(fcomp) /= "C2H4").and.& (trim(fcomp) /= "C3H6").and.(trim(fcomp) /= "NH3").and.(trim(fcomp) /= "CO") ) return else if (trim(recname) == "emiss_anthro") then ! there is no "emiss_anthro" for : ISOPRENE, TERPENES if ( (trim(fcomp) == "ISOPRENE").or.(trim(fcomp) == "TERPENES") ) return end if if (trim(recname) == "emiss_bio") then ! We arrive here if we are not using MEGAN. No "emiss_bio" for C2H5OH, BIGALK, BIGENE: if ( (trim(fcomp) == "C2H5OH").or.(trim(fcomp) == "BIGALK").or.(trim(fcomp) == "BIGENE") ) return endif if (trim(fcomp) == "BC") then if ((trim(recname) /= "emiss_anthro").and.(trim(recname) /= "emiss_air") ) return endif if ((trim(fcomp) == "OC").and.(trim(recname) /= "emiss_anthro")) return !=== READ CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, trim(recname), varid, status ) IF_NOTOK_RETURN(status=1) if( okdebug ) then write (gol,'("EMISS-INFO - MACC - found `",a,"` emissions category in file `",a,"`")') trim(recname), trim(fname); call goPr endif ! 3D if (trim(recname) == "emiss_air") then CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth/) ) IF_NOTOK_RETURN(status=1) do lk = 1, ar5_dim_3ddata ! convert from kg(species)/m^2/s to kg(species)/gridbox/s : emis_in(:,:,lk,1) = emis_in(:,:,lk,1) * gridbox_area_05 ! now coarsen to nlon360,nlat180 emis(:,:,lk) = emission_coarsen_to_1x1( emis_in(:,:,lk,1) , nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) end do else !2D CALL MDF_Get_Var( fid, varid, emis_in(:,:,1,1), status, start=(/1,1,imonth/) ) IF_NOTOK_RETURN(status=1) ! convert from kg(species)/m^2/s to kg(species)/s emis_in(:,:,1,1) = emis_in(:,:,1,1) * gridbox_area_05 ! combine grid cells emis(:,:,1) = emission_coarsen_to_1x1( emis_in(:,:,1,1), nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) endif CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine Emission_macc_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_ED4_READSECTOR ! ! !DESCRIPTION: Read an EDAGR-4 sector field out of an open file. ! !\\ !\\ ! !INTERFACE: ! function emission_ed4_Read2DRecord( fname, secname, status ) ! ! !RETURN VALUE: ! real :: emission_ed4_Read2DRecord(nlon360,nlat180) ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fname character(32), intent(in) :: secname ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Apr 2012 - Narcisa Banda - v0 ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ed4_Read2DRecord' integer :: fid, varid real, dimension(nlon720,nlat360) :: emis_in ! initialise emission_ed4_Read2DRecord = 0.0 ! search for the record CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, secname, varid, status ) IF_ERROR_RETURN(status=1) if ( varid < 0 ) then write (gol,'("EMISS-INFO - ED41 - no `",a,"` emissions in file", a)') & trim(secname), trim(fname); call goPr status=1; TRACEBACK; return else if( okdebug ) then write (gol,'("EMISS-INFO - ED41 - found `",a,"` emissions in file", a)') & trim(secname), trim(fname); call goPr endif CALL MDF_Get_Var( fid, varid, emis_in, status ) IF_NOTOK_RETURN(status=1) ! convert from kg(species)/m^2/s to kg(species)/s emis_in = emis_in * gridbox_area_05 ! combine grid cells emission_ed4_Read2DRecord = emission_coarsen_to_1x1( emis_in , nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) end if CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 return end function Emission_ed4_Read2DRecord !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_ED4_READSECTOR ! ! !DESCRIPTION: Reading one sector of the files to be interpolated and ! returning an interpolated 3d emission field (d3data) !\\ !\\ ! !INTERFACE: ! subroutine emission_ed4_ReadSector( fpath, comp, compl, iyear, imonth, sector, version, unit, d3data, status) ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath character(len=*), intent(in) :: comp character(len=*), intent(in) :: compl integer, intent(in) :: iyear integer, intent(in) :: sector character(len=*), intent(in) :: version character(len=*), intent(in) :: unit integer, intent(in) :: imonth ! ! !OUTPUT PARAMETERS: ! integer, intent(out) :: status real, intent(out) :: d3data( nlon360, nlat180, ar5_dim_3ddata) ! ! !REVISION HISTORY: ! 1 Apr 2012 - Narcisa Banda - v0 ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_ed4_readsector' character(len=256) :: fname character(len=256) :: fname_gridboxarea character(len=sector_name_len) :: secname character(len=32) :: recname character(len=4) :: ver integer :: lt, year logical :: existfile logical :: first41=.true., first42=.true. integer, dimension(2) :: ltimes character(len=4), dimension(2) :: ed41_cyears real, dimension(2) :: ed41_ipcoef_years ! --- begin ----------------------------------- ! initialise target array d3data = 0.0 ! read in gridbox-area; once per CPU if( .not. area_found_05 ) then fname_gridboxarea = trim(emis_input_dir_ar5)//'/'//trim(ed4_filestr_gridboxarea) call emission_ReadGridboxArea(fname_gridboxarea, 'cell_area', gridbox_area_05, & & nlon720, nlat360, status ) IF_NOTOK_RETURN(status=1) area_found_05 = .true. endif ! ------------------------ ! target year(s) ! ------------------------ if (version == 'ED41') then ver='41' year = valid_year( iyear, ed41_avail, 'EDGAR 4.1', first41) first41=.false. allocate( ltimeind( ed41_nr_avail_yrs ) ) ltimeind = .false. where( ed41_avail_yrs < year ) ltimeind = .true. ! times(1): index representing time instance earlier than current year ! times(2): -"- -"- later than current year ltimes(2) = count( ltimeind ) + 1 ltimes(1) = max( ltimes(2) - 1, 1 ) ! check a match with repository (in order to copy only one file instead of two) if( ed41_avail_yrs(ltimes(2)) == year ) ltimes(1) = ltimes(2) deallocate( ltimeind ) ! ed41_cyears will contain strings with the years write(ed41_cyears(1),'(I4.4)') ed41_avail_yrs(ltimes(1)) write(ed41_cyears(2),'(I4.4)') ed41_avail_yrs(ltimes(2)) ! ed41_ipcoef_years will contain interpolation coefficients ! default: factors 1.0/0.0 ed41_ipcoef_years(1) = 1.0 ed41_ipcoef_years(2) = 0.0 if( ltimes(2) /= ltimes(1) ) then ed41_ipcoef_years(1) = (ed41_avail_yrs(ltimes(2)) - year) / & real( ed41_avail_yrs(ltimes(2)) - ed41_avail_yrs(ltimes(1)) ) ed41_ipcoef_years(2) = 1.0 - ed41_ipcoef_years(1) end if else if (version == 'ED42') then ver='42' year = valid_year( iyear, ed42_avail, 'EDGAR 4.2', first42) first42=.false. else write (gol,'("ERROR - This version of EDGAR has not been implemented ")'); call goErr status=1; TRACEBACK; return endif ! ------------------------ ! read files (EDv4.1 - index=1: earlier file; index=2: later file) ! ------------------------ recname = 'emi_'//trim(compl) if (version=='ED41') then do lt = 1, 2 if (ed41_ipcoef_years(lt) == 0.) cycle write (fname,'(a,"/v",a,"_",a,"_",a,"_IPCC_",a,".0.5x0.5.nc")') trim(fpath), trim(ver), trim(comp), & & ed41_cyears(lt), trim(sectors_def(sector)%name) ! test existence of file inquire( file=trim(fname), exist=existfile) if( .not. existfile ) then write (gol,'(" EDGAR4.1 - file `",a,"` not found ")') trim(fname); call goErr status=1; TRACEBACK; return end if ! distinguish 2d/3d sectors if( sectors_def(sector)%f3d ) then d3data(:,:,:) = d3data(:,:,:) + ed41_ipcoef_years(lt) * & emission_ar5_Read3DRecord( trim(fname), recname, imonth, status ) else d3data(:,:,1) = d3data(:,:,1) + ed41_ipcoef_years(lt) * & emission_ed4_Read2DRecord( trim(fname), recname, status ) end if IF_NOTOK_RETURN(status=1) enddo else write (fname,'(a,"/v",a,"_",a,"_",i4.4,"_IPCC_",a,".0.5x0.5.nc")') trim(fpath), trim(ver), trim(comp), & & year, trim(sectors_def(sector)%name) ! test existence of file inquire( file=trim(fname), exist=existfile) if( .not. existfile ) then write (gol,'(" EDGAR4.2 - file `",a,"` not found ")') trim(fname); call goErr status=1; TRACEBACK; return end if if( sectors_def(sector)%f3d ) then d3data(:,:,:) = d3data(:,:,:) + emission_ar5_Read3DRecord( trim(fname), recname, imonth, status ) else d3data(:,:,1) = d3data(:,:,1) + emission_ed4_Read2DRecord( trim(fname), recname, status ) end if IF_NOTOK_RETURN(status=1) end if status=0 end subroutine emission_ed4_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_LPJ_READSECTOR ! ! !DESCRIPTION: Read an LPJ sector field out of an open file. !\\ !\\ ! !INTERFACE: ! subroutine emission_LPJ_ReadSector( fpath, iyear, imonth, sector, unit, emis, status ) ! ! !USES: ! use dims, only : sec_year ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath integer, intent(in) :: iyear integer, intent(in) :: imonth character(len=*), intent(in) :: sector character(len=*), intent(in) :: unit ! ! !OUTPUT PARAMETERS: ! real, intent(out) :: emis(nlon360,nlat180) integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_LPJ_ReadSector' ! --- local ----------------------------------- character(len=256) :: fname character(len=256) :: fname_gridboxarea real :: emis_in(lpj_dim_nlon,lpj_dim_nlat,1) integer :: fid, varid, year, i, j logical :: first=.true. ! --- begin ----------------------------------- ! read in gridbox-area; once per CPU if( .not. lpj_area_found ) then fname_gridboxarea = trim(fpath)//'/'//trim(lpj_filestr_gridboxarea) call emission_ReadGridboxArea(fname_gridboxarea, 'areaw', lpj_gridbox_area, & & lpj_dim_nlon, lpj_dim_nlat, status ) lpj_area_found = .true. IF_NOTOK_RETURN(status=1) endif ! Following emissions are from the EU HYMN project via the LPJ model (Spahni et al., Biogeosciences, 2011) ! Three categories used: peatlands, wetsoils and wetlands ! units in inputfiles: g CH4/y/m2 ! coverage is 60S - 90N ; no emissions south of 60S ! grid cells with any emission have values -999 there skip in the summing across all emission types ! ! CALCULATION EXAMPLE FOR CH4 FLUXES (e.g. for the year 2004): ! *************************************************************************** ! PEATLAND FLUX per grid cell (PLFpgc): ! PLF = lpj_NHpeatlands_2004.nc(ch4_flux) * 0.75 ! PLFpgc = PLF * A * PF/2.61 ! "The PLF is corrected for microtopography of peatlands: half of the area emits only half as much thus 25% less in total [Wania et al., 2010]" ! "The PF map overestimates total peatland area by a factor of 2.61 compared to Prigent et al., 2007" !RICE AGRICULTURE FLUX per grid cell (RAFpgc) - Not Used as implicitly in EDGAR 4.0 !RAF = lpj_rice_2004.nc(ch4_flux) !RAFpgc = RAF * A * RF !WETLAND FLUX per grid cell (WLFpgc): !WLF = lpj_wetlands_2004.nc(ch4_flux) !WLFpgc = WLF * A * IF !WETSOILS FLUX per grid cell (WSFpgc): !WSF = lpj_wetsoils_2004.nc(ch4_flux) !WSFpgc = WSF * A * (1-PF/2.61-IF-RF) !"PF is set =0 between 60°S-45°N, IF is set =0 between 45°N-90°N" !TOTAL NET FLUX per grid cell (TFpgc): !TFpgc = PLFpgc + WLFpgc + RAFpgc + WSFpgc - SCFpgc !e.g. for 2004 this results in a global net source: !TFpgc = 28.17 + 81.31 + 43.11 + 63.16 - 25.83 Tg CH4/year !TFpgc = 189.92 Tg CH4/year ! ! sink term for uptake of CH4 by soils given in mg CH4/ y/ m2 / ppmv(CH4) ! therefore store field and then apply later on using latitudinal average for CH4 ! ! SOIL CONSUMPTION FLUX per grid cell (SCFpgc): ! SCF = lpj_soilconsumption_2004.nc(ch4_flux) ! or ! SCF = lpj_soilconsumption-perconc_2004.nc(ch4_flux) * atm. CH4 (in ppmv) ! SCFpgc = SCF * A * (1-IF-RF) "peatland grid cells are already excluded" if( .not. lpj_fractions_found ) then fname = trim(fpath)//'/maps/lpj_natwet_fraction.nc' CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, 'inund', varid, status ) IF_ERROR_RETURN(status=1) CALL MDF_Get_Var( fid, varid, lpj_frac_wetlands, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) fname = trim(fpath)//'/maps/lpj_rice_fraction.nc' CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, 'rice', varid, status ) IF_ERROR_RETURN(status=1) CALL MDF_Get_Var( fid, varid, lpj_frac_rice, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) fname = trim(fpath)//'/maps/lpj_peatland_fraction.nc' CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, 'scfrac', varid, status ) IF_ERROR_RETURN(status=1) CALL MDF_Get_Var( fid, varid, lpj_frac_peatlands, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) lpj_fractions_found = .true. lpj_frac_peatlands = lpj_frac_peatlands/2.61 endif year = valid_year( iyear, lpj_avail, 'LPJ', first) first=.false. ! target file name with year if (trim(sector).eq.'soilconsumption') then write (fname,'(a,"/",a,"/lpj_",a,"-perconc_",i4.4,".nc")') trim(fpath), trim(sector), trim(sector), year else write (fname,'(a,"/",a,"/lpj_",a,"_",i4.4,".nc")') trim(fpath), trim(sector), trim(sector), year end if CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, 'ch4_flux', varid, status ) IF_NOTOK_RETURN(status=1) if( okdebug ) then write (gol,'("EMISS-INFO - LPJ - found ch4 emissions for sector `",a,"` in file ",a)') & trim(sector), trim(fname); call goPr endif emis = 0.0 ! extract record for requested month CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) ) IF_NOTOK_RETURN(status=1) do j=1,lpj_dim_nlat do i=1, lpj_dim_nlon if(emis_in(i,j,1)>0.) then select case( trim(sector) ) case('wetlands') !convert from [g m-2 per year] to [kg per cell per sec] emis(i,j+30) = emis_in(i,j,1)*lpj_gridbox_area(i,j)*lpj_frac_wetlands(i,j,imonth)*(1.e-3/sec_year) case('peatlands') emis(i,j+30) = emis_in(i,j,1)*0.75*lpj_gridbox_area(i,j)*lpj_frac_peatlands(i,j)*(1.e-3/sec_year) case('wetsoils') emis(i,j+30) = emis_in(i,j,1)*lpj_gridbox_area(i,j)*& &(1.-lpj_frac_wetlands(i,j,imonth)-lpj_frac_peatlands(i,j)-lpj_frac_rice(i,j,imonth))*(1.e-3/sec_year) case('rice') emis(i,j+30) = emis_in(i,j,1)*lpj_gridbox_area(i,j)*lpj_frac_rice(i,j,imonth)*(1.e-3/sec_year) case('soilconsumption') !convert from [mg m-2 per year per ppmv] to [kg per cell per sec per ppmv] emis(i,j+30) = emis_in(i,j,1)*lpj_gridbox_area(i,j)*& &(1. - lpj_frac_wetlands(i,j,imonth) - lpj_frac_rice(i,j,imonth))*(1.e-6/sec_year) end select endif enddo enddo ! no coarsening needed, but used to shift the longitudes from [0, 360] ! to [-180, 180] emis = emission_coarsen_to_1x1( emis, nlon360, nlat180,.true., status ) CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine Emission_LPJ_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: EMISSION_HYMN_READSECTOR ! ! !DESCRIPTION: Read a HYMN Non-LPJ sector field out of an open file. !\\ !\\ ! !INTERFACE: ! subroutine emission_HYMN_ReadSector( fpath, sector, unit, emis, status ) ! ! !USES: ! use dims, only : sec_year, dxy11 ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath character(len=*), intent(in) :: sector character(len=*), intent(in) :: unit ! ! !OUTPUT PARAMETERS: ! real, intent(out) :: emis(nlon360,nlat180) integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - v0 ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_HYMN_ReadSector' ! --- local ----------------------------------- character(len=256) :: fname character(len=256) :: fname_gridboxarea integer :: fid, varid, i, j real :: emis_in(nlon360,nlat180,1,1) character(len=80) :: title character(len=80) :: units ! --- begin ----------------------------------- ! target file name with year select case(trim(sector)) case('oceans') write (fname,'(a,"/CH4-natural-nonLPJ/CH4-N40-Lambert-0000-sfc-glb100x100.hdf")' ) trim(fpath) case('wildanimals') write (fname,'(a,"/CH4-natural-nonLPJ/CH4-N70-Olson-0000-sfc-glb100x100.hdf")' ) trim(fpath) case('termites') write (fname,'(a,"/CH4-natural-nonLPJ/CH4-N71-Sanderson-0000-sfc-glb100x100.hdf")') trim(fpath) end select CALL MDF_Open( TRIM(fname), MDF_HDF4, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, 'field', varid, status ) IF_NOTOK_RETURN(status=1) if( okdebug ) then write (gol,'("EMISS-INFO - HYMN - found ch4 emissions from sector `",a,"` in file ",a)') & trim(sector), trim(fname); call goPr endif emis = 0.0 CALL MDF_Get_Var( fid, varid, emis_in, status ) IF_NOTOK_RETURN(status=1) do j=1,nlat180 do i=1, nlon360 ! from [kg fm cl-1 yr-1] or [1e-10 kg/m2/yr] to [kg/cell/sec] emis(i,j) = emis_in(i,j,1,1)*dxy11(j) *1.e-10/sec_year enddo enddo CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine Emission_HYMN_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: emission_gfed_ReadSector ! ! !DESCRIPTION: Read GFEDv3 out of an open file. !\\ !\\ ! !INTERFACE: ! subroutine emission_gfed_ReadSector( fpath, comp, iyear, imonth, recname, unit, emis, status ) ! ! !USES: ! use chem_param, only : xmn, xmno2 ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath character(len=*), intent(in) :: comp integer, intent(in) :: iyear integer, intent(in) :: imonth character(len=*), intent(in) :: recname character(len=*), intent(in) :: unit ! ! !OUTPUT PARAMETERS: ! real, intent(out) :: emis(nlon360,nlat180) integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_gfed_ReadSector' ! --- local ----------------------------------- character(len=256) :: fname real :: emis_in(nlon720,nlat360,1) real :: emis_help(nlon360,nlat180) integer :: fid, varid, year, j logical :: first=.true. ! --- begin ----------------------------------- ! target file name with year year = valid_year( iyear, gfed3_avail, 'GFEDv3', first) first=.false. write (fname,'(a,"/GFEDv3_surface_",a,"_",i4.4,".0.5x0.5.nc")') trim(fpath), trim(comp), year ! read in gridbox-area; once per CPU if( .not. area_found_05 ) then call emission_ReadGridboxArea(fname, 'gridbox_area', gridbox_area_05, & & nlon720, nlat360, status ) IF_NOTOK_RETURN(status=1) area_found_05 = .true. endif CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, trim(recname), varid, status ) IF_ERROR_RETURN(status=1) if ( varid < 0 ) then write (gol,'("EMISS-INFO - GFEDv3 - no `",a,"` emissions for `",a,"` in file ",a)') & trim(recname), trim(comp), trim(fname); call goErr status=1; TRACEBACK; return else if( okdebug ) then write (gol,'("EMISS-INFO - GFEDv3 - found `",a,"` emissions for `",a,"` in file ",a)') & trim(recname), trim(comp), trim(fname); call goPr endif CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) ) IF_NOTOK_RETURN(status=1) ! convert from kg(species)/m^2/s to kg(species)/s emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05 ! combine grid cells : if (trim(comp)=='bc' .or. trim(comp)=='oc') then ! GFED3 emissions of BC and OC are correctly given in the files. ! They don't need a shift in the zonal direction, but latitudes need to be reversed. emis_help = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .false., status ) IF_NOTOK_RETURN(status=1) do j=1,nlat180 emis(:,j)=emis_help(:,nlat180-j+1) end do else ! GFED3 emissions of other components are erroneously shifted by 180 degrees in the files. ! This is corrected by applying a shift to the data. emis = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) endif endif CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine Emission_gfed_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: emission_retro_ReadSector ! ! !DESCRIPTION: Read a RETRO sector field out of an open file. !\\ !\\ ! !INTERFACE: ! subroutine emission_retro_ReadSector( fpath, comp, iyear, imonth, recname, unit, emis, status ) ! ! !USES: ! use chem_param, only : xmn, xmno2 ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath character(len=*), intent(in) :: comp integer, intent(in) :: iyear integer, intent(in) :: imonth character(len=*), intent(in) :: recname character(len=*), intent(in) :: unit ! ! !OUTPUT PARAMETERS: ! real, intent(out) :: emis(nlon360,nlat180) integer, intent(out) :: status ! ! !REVISION HISTORY: ! 1 Oct 2010 - Achim Strunk - ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_retro_ReadSector' character(len=256) :: fname real :: emis_in(nlon720,nlat360,1) integer :: fid, varid, year logical :: first=.true. ! --- begin ----------------------------------- year = valid_year( iyear, retro_avail, 'RETRO', first) first=.false. write (fname,'(a,"/RETRO_FIRES_V2_",i4.4,"_",a,"_aggregated.nc")') trim(fpath), year, trim(comp) ! read in gridbox-area if( .not. area_found_05 ) then call emission_ReadGridboxArea(fname, 'gridbox_area', gridbox_area_05, & & nlon720, nlat360, status ) IF_NOTOK_RETURN(status=1) area_found_05 = .true. endif CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, trim(recname), varid, status ) IF_ERROR_RETURN(status=1) if ( varid < 0 ) then write (gol,'("EMISS-INFO - RETRO - no `",a,"` emissions for `",a,"` in file ", a)') & trim(recname), trim(comp), trim(fname); call goErr status=1; TRACEBACK; return else if( okdebug ) then write (gol,'("EMISS-INFO - RETRO - found `",a,"` emissions for `",a,"` in file ", a)') & trim(recname), trim(comp), trim(fname); call goPr endif CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) ) IF_NOTOK_RETURN(status=1) !convert from kg(species)/m^2/s to kg(species)/s emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05 ! combine grid cells : emis = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) end if ! emis category found CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine Emission_retro_ReadSector !EOC !-------------------------------------------------------------------------- ! TM5 ! !-------------------------------------------------------------------------- !BOP ! ! !IROUTINE: emission_megan_ReadSector ! ! !DESCRIPTION: Read a MACC-MEGAN sector field out of an open file. !\\ !\\ ! !INTERFACE: ! subroutine emission_megan_ReadSector( fpath, comp, iyear, imonth, recname, unit, emis, status ) ! ! !USES: ! use chem_param, only : xmn, xmno2 ! ! !INPUT PARAMETERS: ! character(len=*), intent(in) :: fpath character(len=*), intent(in) :: comp integer, intent(in) :: iyear integer, intent(in) :: imonth character(len=*), intent(in) :: recname character(len=*), intent(in) :: unit ! ! !OUTPUT PARAMETERS: ! real, intent(out) :: emis(nlon360,nlat180) integer, intent(out) :: status integer :: i,j ! ! REVISION HISTORY: ! 29 Jan 2014 - Jason Williams - ! ! !REMARKS: ! !EOP !------------------------------------------------------------------------ !BOC character(len=*), parameter :: rname = mname//'/emission_megan_ReadSector' character(len=256) :: fname real :: emis_in(nlon720,nlat360,1) real :: flip_array(360,180) integer :: fid, varid, year logical :: first=.true. ! --- begin ----------------------------------- ! target file name with year year = valid_year( iyear, megan_avail, 'MACC-MEGAN', first) first=.false. write (fname,'(a,"/MEGAN-MACC_biogenic_",i4.4,"_",a,".nc")') trim(fpath), year, trim(comp) ! read in gridbox-area; once per CPU if( .not. area_found_05 ) then call emission_ReadGridboxArea(fname, 'gridbox_area', gridbox_area_05, nlon720, nlat360, status ) IF_NOTOK_RETURN(status=1) area_found_05 = .true. endif CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status ) IF_NOTOK_RETURN(status=1) CALL MDF_Inq_VarID( fid, trim(recname), varid, status ) IF_ERROR_RETURN(status=1) if ( varid < 0 ) then write (gol,'("EMISS-INFO - MACC-MEGAN - no `",a,"` emissions for `",a,"` in file ", a)') & trim(recname), trim(comp), trim(fname); call goErr status=1; TRACEBACK; return else if (okdebug) then write (gol,'("EMISS-INFO - MACC-MEGAN - found `",a,"` emissions for `",a,"` in file ", a)') & trim(recname), trim(comp), trim(fname); call goPr endif CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) ) IF_NOTOK_RETURN(status=1) !convert from kg(species)/m^2/s to kg(species)/s emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05 ! combine grid cells : emis = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .true., status ) IF_NOTOK_RETURN(status=1) flip_array(:,:)=emis(:,:) ! ! flip the array ! do j=1,180 emis(:,j)=flip_array(:,(180-j)+1) enddo do i=1,180 flip_array(i,:)=emis(i+180,:) flip_array(i+180,:)=emis(i,:) enddo do j=1,180 emis(:,j)=flip_array(:,j) enddo end if ! emis category found CALL MDF_Close( fid, status ) IF_NOTOK_RETURN(status=1) status = 0 end subroutine Emission_megan_ReadSector !EOC END MODULE EMISSION_READ