1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151 |
- !
- #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.: <emisdir>/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
|