emission_read.F90 234 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175
  1. #define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') rname, __FILE__, __LINE__ ; call goErr
  2. #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
  3. #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
  4. !
  5. #include "tm5.inc"
  6. !
  7. !-----------------------------------------------------------------------------
  8. ! TM5 !
  9. !-----------------------------------------------------------------------------
  10. !BOP
  11. !
  12. ! !MODULE: EMISSION_READ
  13. !
  14. ! !DESCRIPTION: This module provides objects and methods related to
  15. ! CMIP6, IPCC-AR5, EDGAR-4, RETRO_FIRES, LPJ and MACC emissions.
  16. !
  17. ! AR5 netCDF files are provided by FZ-Juelich and IIASA:
  18. ! ftp://ftp-ipcc.fz-juelich.de/pub/emissions/gridded_netcdf/
  19. ! http://www.iiasa.ac.at/web-apps/tnt/RcpDb/
  20. !
  21. ! These data sets are not covering natural emissions. For these
  22. ! sources additional data from the MACC project are used (sectors
  23. ! ocean, soil, biogenic and natural, see below).
  24. !
  25. ! There are a few keys in the rc-file which control the behaviour of
  26. ! this module and the data used:
  27. ! # specify the (main) provider of emission sets
  28. ! input.emis.provider : AR5
  29. ! # where to find the emissions (this will be used by install-emis-ar5)
  30. ! input.emis.dir : ${TEMP}/EMIS/AR5
  31. ! # year of emissions (AR5 emissions will be linearly interpolated)
  32. ! input.emis.year : 2000
  33. ! # choose RCP out of RCP26, RCP45, RCP60, RCP85
  34. ! input.emis.AR5.RCP : RCP45
  35. !
  36. !\\
  37. !\\
  38. ! !INTERFACE:
  39. !
  40. MODULE EMISSION_READ
  41. !
  42. ! !USES:
  43. !
  44. use GO, only : gol, goErr, goPr, goLabel
  45. use emission_data, only : emis_input_dir_cmip6
  46. use emission_data, only : emis_input_dir_ar5
  47. use emission_data, only : emis_input_dir_ed4, emis_input_dir_mac
  48. use emission_data, only : vd_class_name_len
  49. use dims, only : nlon360, nlat180, iglbsfc
  50. use chem_param, only : ncb5
  51. use chem_param, only : xmc, xmh, xmch2o, xmeth, xmgly, xmhcooh, xmmcooh, xmacet
  52. use chem_param, only : xmole, xmald2, xmpar, xmo
  53. use Dims, only : okdebug
  54. USE MDF, ONLY : MDF_Open, MDF_NETCDF, MDF_READ
  55. USE MDF, ONLY : MDF_Inq_VarID, MDF_Get_Var, MDF_Close
  56. implicit none
  57. private
  58. !
  59. ! !PUBLIC MEMBER FUNCTIONS:
  60. !
  61. public :: emission_read_init, emission_read_done
  62. !!$ public :: emission_ar5_readcategory
  63. public :: emission_ar5_regrid_aircraft
  64. public :: numb_2dsec, numb_3dsec
  65. public :: numb_sectors, sectors_def
  66. public :: numb_providers, providers_def
  67. public :: sector_name_len
  68. public :: read_cmip6_zch4
  69. public :: emis_cmip6_voc_name
  70. public :: emission_cmip6_readsector
  71. public :: emission_cmip6bmb_readsector
  72. public :: emission_ar5_readsector
  73. public :: emission_macc_readsector
  74. public :: emission_ed4_readsector
  75. public :: emission_gfed_readsector
  76. public :: emission_retro_readsector
  77. public :: emission_lpj_readsector
  78. public :: emission_hymn_readsector
  79. public :: emission_megan_readsector
  80. public :: ar5_dim_3ddata
  81. public :: emis_ar5_voc2cbm5_default
  82. public :: emis_ar5_voc2cbm5_biomassb
  83. public :: emis_ar5_voc2cbm5_biogenic
  84. public :: emis_ar5_voc_name, emis_ar5_nvoc
  85. public :: ar5_cat_ant, ar5_cat_shp, ar5_cat_air, ar5_cat_bmb
  86. ! CMIP6 aircraft
  87. public :: emis_cmip6_aircraft_tot2voc
  88. public :: emis_cmip6_aircraft_tl_tot2voc
  89. ! CMIP6BMB
  90. public :: emis_cmip6bmb_voc2cbm5
  91. public :: emis_cmip6bmb_voc_name, emis_cmip6bmb_nvoc
  92. ! MACC
  93. public :: emis_macc_voc2cbm5_default
  94. public :: emis_macc_voc2cbm5_biogenic
  95. public :: emis_macc_voc2cbm5_biomassb
  96. public :: emis_macc_voc_name, emis_macc_nvoc
  97. ! MEGAN
  98. public :: emis_megan_voc2cbm5_biogenic
  99. public :: emis_megan_nvoc, emis_megan_voc_name
  100. public :: emis_gfed_voc_name, emis_gfed_nvoc
  101. public :: emis_voc2cbm5_gfed
  102. public :: emis_retro_voc_name
  103. public :: sector_type, provider_type
  104. ! EDGAR 4.2
  105. public :: ed42_nsect_co, ed42_nsect_ch4
  106. public :: ed42_nsect_nox, ed42_nsect_hc
  107. public :: ed42_nsect_nh3, ed42_nsect_so2
  108. public :: ed42_co_sectors, ed42_ch4_sectors
  109. public :: ed42_nox_sectors, ed42_hc_sectors
  110. public :: ed42_nh3_sectors, ed42_so2_sectors
  111. !
  112. ! !PRIVATE DATA MEMBERS:
  113. !
  114. character(len=*), parameter :: mname = 'emission_read'
  115. ! ------------------------------
  116. ! global characteristics
  117. ! ------------------------------
  118. integer, parameter :: nlat360 = 360 ! number of latitudes for CMIP6, AR5, MACC, EDGAR, GFED, RETRO data (0.5deg)
  119. integer, parameter :: nlon720 = 720 ! number of longitudes for CMIP6, AR5, MACC, EDGAR, GFED, RETRO data (0.5deg)
  120. integer, parameter :: nlat720 = 720 ! number of latitudes for CMIP6BMB (0.25deg)
  121. integer, parameter :: nlon1440 = 1440 ! number of longitudes for CMIP6BMB (0.25deg)
  122. integer, parameter :: lpj_dim_nlat = 150 ! number of latitudes (1deg), no emissions 60S-90S
  123. integer, parameter :: lpj_dim_nlon = 360 ! number of longitudes (1deg)
  124. integer, parameter :: sector_name_len = 18 ! length of sector descriptor
  125. integer, parameter :: categ_name_len = 14 ! length of category descriptor
  126. integer, parameter :: numb_sectors = 82 ! number of sectors (All providers!)
  127. integer, parameter :: numb_2dsec = 67 ! number of 2d sectors (all except aircraft)
  128. integer, parameter :: numb_3dsec = 2 ! number of 3d sectors (aircraft)
  129. ! In contrast to AR5, CMIP6 and CMIP6BMB are counted as separate providers
  130. integer, parameter :: numb_providers = 11 ! CMIP6, CMIP6BMB, AR5, MACC, ED41, ED42, LPJ, HYMN, GFEDv3, RETRO, MEGAN
  131. ! Since CMIP6 emissions from aviation are provided on the same vertical grid
  132. ! as for AR5, this variable is also used for CMIP6:
  133. integer, parameter :: ar5_dim_3ddata = 25 ! number of layers for aircraft data
  134. ! full list of providers
  135. character(10), dimension(numb_providers), parameter :: all_providers = &
  136. & (/ 'CMIP6 ', 'CMIP6BMB ', 'RETRO ', 'AR5 ', 'MACC ', &
  137. 'ED41 ', 'ED42 ', 'LPJ ', 'HYMN ', 'GFEDv3 ','MEGAN '/)
  138. ! List of providers effectively used
  139. character(10), PUBLIC, allocatable :: used_providers(:) ! general: CO, NMVOC, NOX, SOx, NH3
  140. character(10), PUBLIC, allocatable :: used_providers_isop(:) ! ISOP
  141. character(10), PUBLIC, allocatable :: used_providers_terp(:) ! TERP
  142. character(10), PUBLIC, allocatable :: used_providers_ch4(:) ! CH4
  143. character(10), PUBLIC, allocatable :: used_providers_aer(:) ! BC and POM
  144. ! flag for degenerated cases
  145. logical, PUBLIC :: has_aer_emis = .true.
  146. logical, PUBLIC :: has_ch4_emis = .true.
  147. logical, PUBLIC :: has_isop_emis = .true.
  148. logical, PUBLIC :: has_terp_emis = .true.
  149. logical, PUBLIC :: has_emis = .true.
  150. ! extra params EDGAR 4.2: sectors used per species (here we already take out BMB and transport)
  151. integer, parameter :: ed42_nsect_co = 8 ! (all=11) number of sectors for CO
  152. integer, parameter :: ed42_nsect_ch4 = 13 ! (all=16) number of sectors for CH4
  153. integer, parameter :: ed42_nsect_nox = 10 ! (all=13) number of sectors for NOx
  154. integer, parameter :: ed42_nsect_hc = 9 ! (all=12) number of sectors for NMVOC
  155. integer, parameter :: ed42_nsect_nh3 = 9 ! (all=11) number of sectors for NH3
  156. integer, parameter :: ed42_nsect_so2 = 8 ! (all=11) number of sectors for SO2
  157. character(len=sector_name_len), dimension(ed42_nsect_co) :: ed42_co_sectors ! CO sectors in EDGAR 4.2
  158. character(len=sector_name_len), dimension(ed42_nsect_ch4) :: ed42_ch4_sectors ! CH4 sectors in EDGAR 4.2
  159. character(len=sector_name_len), dimension(ed42_nsect_nox) :: ed42_nox_sectors ! NOx sectors in EDGAR 4.2
  160. character(len=sector_name_len), dimension(ed42_nsect_hc) :: ed42_hc_sectors ! NMVOC sectors in EDGAR 4.2
  161. character(len=sector_name_len), dimension(ed42_nsect_nh3) :: ed42_nh3_sectors ! NH3 sectors in EDGAR 4.2
  162. character(len=sector_name_len), dimension(ed42_nsect_so2) :: ed42_so2_sectors ! SO2 sectors in EDGAR 4.2
  163. ! ------------------------------
  164. ! data used to construct filenames
  165. ! ------------------------------
  166. character(len=15), parameter :: filestr_common_pre = 'IPCC_emissions'
  167. character(len=25), parameter :: filestr_common_post = '0.5x0.5.nc'
  168. ! ------------------------------
  169. ! identifier of RCPs (RCP26, RCP45,...)
  170. ! ------------------------------
  171. character(len=5) :: filestr_rcpiden
  172. !------------------------------
  173. ! SSP scenario name
  174. !------------------------------
  175. character(len=14) :: ssp_name
  176. logical :: LSSP370_LowNTCF, LSSP370_LowAer, LSSP370_LowO3
  177. logical :: LSSP370_LowBC, LSSP370_LowOC, LSSP370_LowSOx, LSSP370_LowNH3
  178. logical :: LSSP370_LowNOx, LSSP370_LowCO, LSSP370_LowNMVOC
  179. logical :: LSSP370_LowCH4
  180. ! ------------------------------
  181. ! available years and related parameters/variables
  182. ! ------------------------------
  183. ! availability (min, max years) - Limit MACC and MEGAN to one year for EC-Earth
  184. integer, dimension(2), parameter :: cmip6_avail = (/1850, 2100/)
  185. integer, dimension(2), parameter :: retro_avail = (/1960, 2000/)
  186. integer, dimension(2), parameter :: ar5_avail = (/1850, 2100/)
  187. integer, dimension(2), parameter :: macc_avail = (/1998, 1998/)
  188. integer, dimension(2), parameter :: ed41_avail = (/2005, 2005/)
  189. integer, dimension(2), parameter :: ed42_avail = (/1970, 2008/)
  190. integer, dimension(2), parameter :: lpj_avail = (/1990, 2008/)
  191. integer, dimension(2), parameter :: hymn_avail = (/ 999, 999/) ! not used
  192. integer, dimension(2), parameter :: gfed3_avail = (/1997, 2010/)
  193. integer, dimension(2), parameter :: megan_avail = (/2000, 2000/)
  194. integer, parameter :: ar5_nr_avail_yrs = 27
  195. integer, dimension(ar5_nr_avail_yrs), parameter :: &
  196. ar5_avail_yrs = (/ 1850, 1860, 1870, 1880, 1890, 1900, &
  197. 1910, 1920, 1930, 1940, 1950, 1960, &
  198. 1970, 1980, 1990, &
  199. 2000, 2005, 2010, 2020, 2030, 2040, &
  200. 2050, 2060, 2070, 2080, 2090, 2100 /)
  201. integer, parameter :: ed41_nr_avail_yrs = 12
  202. integer, dimension(ed41_nr_avail_yrs), parameter :: &
  203. ed41_avail_yrs = (/ 1970, 1975, 1980, 1985, 1990, 1995, 2000, &
  204. 2001, 2002, 2003, 2004, 2005 /)
  205. logical, dimension(:), allocatable :: ltimeind
  206. logical, save :: lpj_fractions_found
  207. real, dimension(:,:,:), allocatable :: lpj_frac_wetlands
  208. real, dimension(:,:,:), allocatable :: lpj_frac_rice
  209. real, dimension(:,:), allocatable :: lpj_frac_peatlands
  210. character(len=7) :: ar5_coverage = 'monthly'
  211. character(len=7) :: ed4_coverage = 'yearly '
  212. character(len=7) :: lpj_coverage = 'monthly'
  213. ! AR5 list of species available for each category
  214. character(len=26), target, dimension(31) :: ar5_cat_ant=(/ &
  215. 'Acids ', 'alcohols ', 'BC ', &
  216. 'benzene ', 'butanes ', 'CH4 ', &
  217. 'chlorinated_HC ', 'CO ', 'esters ', &
  218. 'ethane ', 'ethene ', 'ethers ', &
  219. 'ethyne ', 'formaldehyde ', 'hexanes_and_higher_alkanes', &
  220. 'ketones ', 'NH3 ', 'NMVOC ', &
  221. 'NO ', 'OC ', 'other_alkanals ', &
  222. 'other_alkenes_and_alkynes ', 'other_aromatics ', 'other_VOC ', &
  223. 'pentanes ', 'propane ', 'propene ', &
  224. 'SO2 ', 'toluene ', 'trimethyl_benzenes ', &
  225. 'xylene '/)
  226. character(len=26), target, dimension(3) :: ar5_cat_air=(/ &
  227. 'BC ', 'NO2 ', 'NO '/)
  228. character(len=26), target, dimension(22) :: ar5_cat_shp=(/ &
  229. 'BC ', 'benzene ', 'butanes ', &
  230. 'CH4 ', 'CO ', 'ethane ', &
  231. 'ethene ', 'ethyne ', 'hexanes_and_higher_alkanes', &
  232. 'NH3 ', 'NMVOC ', 'NO ', &
  233. 'OC ', 'other_alkenes_and_alkynes ', 'other_aromatics ', &
  234. 'pentanes ', 'propane ', 'propene ', &
  235. 'SO2 ', 'toluene ', 'trimethyl_benzenes ', &
  236. 'xylene '/)
  237. character(len=26), target, dimension(31) :: ar5_cat_bmb=(/ &
  238. 'acids ', 'alcohols ', 'BC ', &
  239. 'benzene ', 'butanes ', 'CH4 ', &
  240. 'chlorinated_HC ', 'CO ', 'ethane ', &
  241. 'ethene ', 'ethers ', 'ethyne ', &
  242. 'formaldehyde ', 'hexanes_and_higher_alkanes', 'isoprene ', &
  243. 'ketones ', 'NH3 ', 'NMVOC ', &
  244. 'NO ', 'OC ', 'other_alkanals ', &
  245. 'other_alkenes_and_alkynes ', 'other_aromatics ', 'other_VOC ', &
  246. 'pentanes ', 'propane ', 'propene ', &
  247. 'SO2 ', 'terpenes ', 'toluene ', &
  248. 'xylene '/)
  249. ! and number of sectors in each category
  250. integer, public :: n_ar5_ant_sec, n_ar5_shp_sec, n_ar5_air_sec, n_ar5_bmb_sec
  251. ! reduced ar5 species available per anthro-sector (to screen out unavailable VOC)
  252. character(len=26), target, dimension(28) :: ar5_cat_ant_ene_ind=(/ &
  253. 'acids ', 'alcohols ', 'BC ', &
  254. 'benzene ', 'butanes ', 'CH4 ', &
  255. 'CO ', 'ethane ', 'ethene ', &
  256. 'ethyne ', 'formaldehyde ', 'hexanes_and_higher_alkanes', &
  257. 'ketones ', 'NH3 ', 'NMVOC ', &
  258. 'NO ', 'OC ', 'other_alkanals ', &
  259. 'other_alkenes_and_alkynes ', 'other_aromatics ', 'other_VOC ', &
  260. 'pentanes ', 'propane ', 'propene ', &
  261. 'SO2 ', 'toluene ', 'trimethyl_benzenes ', &
  262. 'xylene '/)
  263. character(len=26), target, dimension(29) :: ar5_cat_ant_dom=(/&
  264. 'acids ', 'alcohols ', 'BC ', &
  265. 'benzene ', 'butanes ', 'CH4 ', &
  266. 'CO ', 'ethane ', 'ethene ', &
  267. 'ethers ', 'ethyne ', 'formaldehyde ', &
  268. 'hexanes_and_higher_alkanes', 'ketones ', 'NH3 ', &
  269. 'NMVOC ', 'NO ', 'OC ', &
  270. 'other_alkanals ', 'other_alkenes_and_alkynes ', 'other_aromatics ', &
  271. 'other_VOC ', 'pentanes ', 'propane ', &
  272. 'propene ', 'SO2 ', 'toluene ', &
  273. 'trimethyl_benzenes ', 'xylene '/)
  274. character(len=26), target, dimension(27) :: ar5_cat_ant_agr=(/ &
  275. 'acids ', 'alcohols ', 'BC ', &
  276. 'benzene ', 'butanes ', 'CH4 ', &
  277. 'CO ', 'ethane ', 'ethene ', &
  278. 'ethers ', 'ethyne ', 'formaldehyde ', &
  279. 'hexanes_and_higher_alkanes', 'ketones ', 'NH3 ', &
  280. 'NMVOC ', 'NO ', 'OC ', &
  281. 'other_alkanals ', 'other_alkenes_and_alkynes ', 'other_aromatics ', &
  282. 'pentanes ', 'propane ', 'propene ', &
  283. 'SO2 ', 'toluene ', 'xylene '/)
  284. character(len=26), target, dimension(25) :: ar5_cat_ant_awb=(/&
  285. 'acids ', 'alcohols ', 'BC ', &
  286. 'benzene ', 'butanes ', 'CH4 ', &
  287. 'CO ', 'ethane ', 'ethene ', &
  288. 'ethyne ', 'formaldehyde ', 'hexanes_and_higher_alkanes', &
  289. 'ketones ', 'NH3 ', 'NMVOC ', &
  290. 'NO ', 'OC ', 'other_alkanals ', &
  291. 'other_alkenes_and_alkynes ', 'pentanes ', 'propane ', &
  292. 'propene ', 'SO2 ', 'toluene ', &
  293. 'xylene '/)
  294. character(len=26), target, dimension(18) :: ar5_cat_ant_slv=(/&
  295. 'alcohols ', 'BC ', 'CH4 ', &
  296. 'chlorinated_HC ', 'CO ', 'esters ', &
  297. 'ethers ', 'hexanes_and_higher_alkanes', 'ketones ', &
  298. 'NH3 ', 'NMVOC ', 'NO ', &
  299. 'OC ', 'other_aromatics ', 'other_VOC ', &
  300. 'SO2 ', 'toluene ', 'xylene '/)
  301. character(len=26), target, dimension(29) :: ar5_cat_ant_tra=(/&
  302. 'BC ', 'benzene ', 'butanes ', &
  303. 'CH4 ', 'chlorinated_HC ', 'CO ', &
  304. 'esters ', 'ethane ', 'ethene ', &
  305. 'ethers ', 'ethyne ', 'formaldehyde ', &
  306. 'hexanes_and_higher_alkanes', 'ketones ', 'NH3 ', &
  307. 'NMVOC ', 'NO ', 'OC ', &
  308. 'other_alkanals ', 'other_alkenes_and_alkynes ', 'other_aromatics ', &
  309. 'other_VOC ', 'pentanes ', 'propane ', &
  310. 'propene ', 'SO2 ', 'toluene ', &
  311. 'trimethyl_benzenes ', 'xylene '/)
  312. ! ------------------------------
  313. ! gridbox area (to be read only once per proc)
  314. ! ------------------------------
  315. character(len=25),parameter :: cmip6_filestr_gridboxarea = 'gridbox_area.nc '
  316. character(len=25),parameter :: ar5_filestr_gridboxarea = 'gridbox_area.nc '
  317. character(len=25),parameter :: ed4_filestr_gridboxarea = 'gridbox_area.nc '
  318. character(len=25),parameter :: lpj_filestr_gridboxarea = 'maps/lpj_gridcell_area.nc'
  319. logical, save :: area_found_025, area_found_05
  320. logical, save :: lpj_area_found
  321. real, dimension(:,:), allocatable :: gridbox_area_025 ! gridbox area on 0.25x0.25 deg - used for MACCBMB
  322. real, dimension(:,:), allocatable :: gridbox_area_05 ! gridbox area on 0.5x0.5 deg - used for AR5, MACC, EDGAR, GFED, RETRO, MEGAN
  323. real, dimension(:,:), allocatable :: lpj_gridbox_area ! stored as double in file
  324. ! -----------------------
  325. ! data type for sectors
  326. ! -----------------------
  327. type sector_type
  328. sequence
  329. character(len=sector_name_len) :: name ! name of sector
  330. character(len=categ_name_len) :: catname ! name of category to be found in
  331. logical :: f3d ! 3d-data y/n
  332. character(len=vd_class_name_len) :: vdisttype ! vertical distribution type (equal to "classes" still to be defined)
  333. character(len=8) :: prov ! provider of information (AR5, MACC, ED4)
  334. character(len=26), dimension(:), pointer :: species ! list of species available for that sector (use for AR5 only)
  335. end type sector_type
  336. type provider_type
  337. character(len=8) :: name
  338. integer :: nsect2d, nsect3d
  339. end type provider_type
  340. type(sector_type), dimension(numb_sectors) :: sectors_def
  341. type(provider_type), dimension(numb_providers) :: providers_def
  342. ! ----------------------------------------------------------------------------------
  343. ! NMVOC settings
  344. ! ----------------------------------------------------------------------------------
  345. ! ----------------------------------------------------------------------------------
  346. ! A R 5 ( following GEMS setup ) - also used for CMIP6 anthropogenic and EDGAR
  347. ! ----------------------------------------------------------------------------------
  348. !
  349. ! Quotation of emission_tools_gems.F90:
  350. ! -------------------------------------
  351. ! Distribution of NMV over the CBM-4 components (kg C/kg NMV) .
  352. ! VOC numbering according to TNO/RETRO speciation.
  353. ! Anthropogenic emissions of isoprene (ivoc=10), monoterpenes(ivoc=11) and others(ivoc=25)
  354. ! are not used (set to zero in voc2c_tno and voc2c_fires) .
  355. ! The speciation is slightly different for biomass burning emissions, where:
  356. ! voc_1 is methanol (which does not contribute) instead of alcohols,
  357. ! voc_23 is acetone instead of ketones and
  358. ! acetaldehyde is given instead of 'other aldehydes' (voc_22)
  359. ! For biomass burning isoprene (ivoc_10) and monoterpene (ivoc_11) are nonzero
  360. ! and need to be included separately.
  361. !
  362. integer, parameter :: emis_ar5_nvoc = 25
  363. !
  364. ! AR5 components TM4-RETRO Available EDGAR41 UNavailable EDGAR42 from ED42_HC_SECTORS
  365. ! Transport sectors (1A3*) (ignoring 1A3* transport, and 5A_C_D_F_4E fires)
  366. ! --------------------------------------------------------------------------------------------------------------------------
  367. ! alcohols 1) alcohols 1A3b_c_e (2005 only) 1A4
  368. ! ethane 2) ethane 1A3b_c_e 1A3d1 1A3d_SHIP = id. 3
  369. ! propane 3) propane id. 3
  370. ! butanes 4) butanes id. 3
  371. ! pentanes 5) pentanes id. 3
  372. ! hexanes and higher alkanes 6) hexanes and higher alkanes id.
  373. ! ethene 7) ethene id. 3
  374. ! propene 8) propene id. 3
  375. ! ethyne 9) ethyne id. 3
  376. ! isoprene 10) isoprene --none-- all
  377. ! terpenes 11) terpenes --none-- all
  378. ! other alkenes and alkynes 12) lumped alkenes id. 3
  379. ! benzene 13) benzene id. 3
  380. ! toluene 14) toluene id.
  381. ! xylene 15) xylene id.
  382. ! trimethyl benzenes 16) trimethylbenzene id. 3; 4F
  383. ! other aromatics 17) other_aromatics id. 4F
  384. ! esters 18) esters 1A3b_c_e 1A1a, 1A1b_c_1B_2C1_2C2, 1A2, 2A_B_D_E_F_G, 4F; 7A
  385. ! ethers 19) ethers 1A3b_c_e 1A1a, 1A1b_c_1B_2C1_2C2, 1A2, 2A_B_D_E_F_G, 4F; 7A
  386. ! chlorinated HC 20) Cl HC 1A3b_c_e 1A1a, 1A1b_c_1B_2C1_2C2, 1A2, 2A_B_D_E_F_G, 4F; 7A
  387. ! formaldehyde 21) formaldehyde 1A3b_c_e 3
  388. ! other alkanal 22) acetaldehyde 1A3b_c_e 3
  389. ! ketones 23) acetone/ketones 1A3b_c_e
  390. ! acids 24) acids 1A3b_c_e (2005 only) 1A4; 3
  391. ! other VOC 25) othervoc 1A3b_c_e 4F
  392. !
  393. character(len=26), parameter :: emis_ar5_voc_name(emis_ar5_nvoc) = (/ &
  394. 'alcohols ', & ! 1
  395. 'ethane ', & ! 2
  396. 'propane ', & ! 3
  397. 'butanes ', & ! 4
  398. 'pentanes ', & ! 5
  399. 'hexanes_and_higher_alkanes', & ! 6
  400. 'ethene ', & ! 7
  401. 'propene ', & ! 8
  402. 'ethyne ', & ! 9
  403. 'isoprene ', & ! 10
  404. 'terpenes ', & ! 11
  405. 'other_alkenes_and_alkynes ', & ! 12
  406. 'benzene ', & ! 13
  407. 'toluene ', & ! 14
  408. 'xylene ', & ! 15
  409. 'trimethyl_benzenes ', & ! 16
  410. 'other_aromatics ', & ! 17
  411. 'esters ', & ! 18
  412. 'ethers ', & ! 19
  413. 'chlorinated_HC ', & ! 20
  414. 'formaldehyde ', & ! 21
  415. 'other_alkanals ', & ! 22
  416. 'ketones ', & ! 23
  417. 'acids ', & ! 24
  418. 'other_VOC ' /) ! 25
  419. ! For CMIP6, use same species as for AR5
  420. ! but with different names
  421. character(len=26), parameter :: emis_cmip6_voc_name(emis_ar5_nvoc) = (/ &
  422. 'VOC01-alcohols ', &
  423. 'VOC02-ethane ', &
  424. 'VOC03-propane ', &
  425. 'VOC04-butanes ', &
  426. 'VOC05-pentanes ', &
  427. 'VOC06-hexanes-pl ', &
  428. 'VOC07-ethene ', &
  429. 'VOC08-propene ', &
  430. 'VOC09-ethyne ', &
  431. 'VOC10-isoprene ', &
  432. 'VOC11-terpenes ', &
  433. 'VOC12-other-alke ', &
  434. 'VOC13-benzene ', &
  435. 'VOC14-toluene ', &
  436. 'VOC15-xylene ', &
  437. 'VOC16-trimethylb ', &
  438. 'VOC17-other-arom ', &
  439. 'VOC18-esters ', &
  440. 'VOC19-ethers ', &
  441. 'VOC20-chlorinate ', &
  442. 'VOC21-methanal ', &
  443. 'VOC22-other-alka ', &
  444. 'VOC23-ketones ', &
  445. 'VOC24-acids ', &
  446. 'VOC25-other-voc ' /)
  447. !
  448. ! voc_to_cbm5: Table to convert kg(nmvoc) to 'kg(cbm5) for variable cbm5
  449. ! JEW: the addition of some components is reassessd for eg butanes/pentanes
  450. ! JEW: see xl file : TAR_VOC_emissions_speciation-TM-2010
  451. ! JEW: for other voc species 20% of total C is assumed to be PAR
  452. real, parameter :: emis_ar5_voc2cbm5_default(emis_ar5_nvoc*ncb5) = (/ &
  453. ! PAR
  454. 0.0 , 0.0 , 0.0 , 8.2685E-01 , 8.3264E-01 , &
  455. 8.4049E-01 , 0.0 , 0.0 , 4.6157E-01 , 0.0 , &
  456. 0.0 , 4.9970E-01 , 1.5386E-01 , 0.0 , 1.2451E-01 , &
  457. 2.0997E-01 , 2.5229E-01 , 3.6635E-01 , 3.8643E-01 , 2.6354E-01 , &
  458. 0.0 , 3.0081E-01 , 0.0 , 0.0 , 1.85E-01 , &
  459. ! ETH
  460. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  461. 0.0 , xmeth/(xmc*2+xmh*4), 0.0 , 0.0 , 0.0 , &
  462. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  463. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  464. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  465. ! OLE
  466. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  467. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  468. 0.0 , 3.5668E-01 , 0.0 , 0.0 , 0.0 , &
  469. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  470. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  471. ! ALD2
  472. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  473. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  474. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  475. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  476. 0.0 , 3.5389E-01 , 0.0 , 0.0 , 0.0 , &
  477. ! MGLY
  478. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  479. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  480. 0.0 , 0.0 , 0.0 , 0.0 , 2.7167E-01 , &
  481. 2.3978E-01 , 2.2409E-01 , 0.0 , 0.0 , 0.0 , &
  482. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  483. ! CH2O
  484. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  485. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  486. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  487. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  488. 1.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  489. !CH3OH (how to attribute alcohols to CH3OH? distribute over CH3OH (90%) and ETHOH (10%))
  490. 0.9 , 0.0 , 0.0 , 0.0 , 0.0 , &
  491. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  492. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  493. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  494. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  495. !HCOOH
  496. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  497. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  498. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  499. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  500. 0.0 , 0.0 , 0.0 , 0.5 , 0.0 , &
  501. !MCOOH
  502. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  503. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  504. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  505. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  506. 0.0 , 0.0 , 0.0 , 0.5 , 0.0 , &
  507. !C2H6
  508. 0.0 , 1.0 , 0.0 , 0.0 , 0.0 , &
  509. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  510. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  511. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  512. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  513. !ETHOH (attribute 10% alcohol emisions to ETHOH! )
  514. 0.1 , 0.0 , 0.0 , 0.0 , 0.0 , &
  515. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  516. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  517. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  518. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  519. !C3H8
  520. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  521. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  522. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  523. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  524. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  525. !C3H6
  526. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  527. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  528. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  529. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  530. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  531. ! Acetone
  532. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  533. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  534. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  535. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  536. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 /)
  537. !
  538. ! The table below is used for the RETRO FIRES inventory only.
  539. ! It differs from the default AR5 table above in that
  540. ! methanol and acetaldehyde are provided directly.
  541. ! Remaining differences are either small or
  542. ! occur for species that are not provided.
  543. real, parameter :: emis_ar5_voc2cbm5_biomassb(emis_ar5_nvoc*ncb5) = (/ &
  544. ! PAR
  545. 0.0 , 0.0 , 0.0 , 8.2685E-01 , 8.3264E-01 , &
  546. 8.4049E-01 , 0.0 , 0.0 , 4.6157E-01 , 0.0 , &
  547. 0.0 , 4.9970E-01 , 1.5386E-01 , 0.0 , 1.2451E-01 , &
  548. 2.0997E-01 , 2.5229E-01 , 3.6635E-01 , 3.8643E-01 , 2.6354E-01 , &
  549. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  550. ! ETH
  551. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  552. 0.0 , 8.5663E-01 , 0.0 , 0.0 , 0.0 , &
  553. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  554. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  555. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  556. ! OLE
  557. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  558. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  559. 0.0 , 3.5693E-01 , 0.0 , 0.0 , 0.0 , &
  560. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  561. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  562. ! ALD2 (RETRO FIRES inventory provides acetaldehyde directly)
  563. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  564. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  565. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  566. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  567. 0.0 , 5.4541E-01 , 0.0 , 0.0 , 0.0 , &
  568. ! MGLY
  569. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  570. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  571. 0.0 , 0.0 , 0.0 , 0.0 , 2.7167E-01 , &
  572. 2.3996E-01 , 2.2426E-01 , 0.0 , 0.0 , 0.0 , &
  573. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  574. ! CH2O
  575. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  576. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  577. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  578. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  579. 1.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  580. ! CH3OH (RETRO FIRES inventory provides methanol directly)
  581. 1.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  582. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  583. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  584. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  585. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  586. ! HCOOH
  587. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  588. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  589. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  590. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  591. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  592. ! MCOOH
  593. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  594. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  595. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  596. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  597. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  598. ! C2H6
  599. 0.0 , 1.0 , 0.0 , 0.0 , 0.0 , &
  600. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  601. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  602. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  603. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  604. ! ETHOH
  605. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  606. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  607. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  608. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  609. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  610. ! C3H8
  611. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  612. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  613. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  614. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  615. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  616. ! C3H6
  617. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  618. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  619. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  620. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  621. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  622. ! Acetone
  623. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  624. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  625. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  626. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  627. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 /)
  628. ! voc_to_cbm5: Table to convert kg(nmvoc) to kg(cbm5) for variable cbm5
  629. ! specific for biogenic emissions
  630. ! For alcohols methanol is used to account for ethanol. Therefore
  631. ! use 0.1 scaling factor. For other species the ratio of xmpar/xmspecies is adopted,
  632. ! using molecular weights for each species given in Schultz and Stein (2004)
  633. ! For species that have no biogenic contribution we adopt a value of 0.
  634. real, parameter :: emis_ar5_voc2cbm5_biogenic(emis_ar5_nvoc*ncb5) = (/ &
  635. ! PAR
  636. 0.0 , 0.0 , 0.0 , 0.206897 , 8.3264E-01 , &
  637. 8.4049E-01 , 0.0 , 0.0 , 0.0 , 0.0 , &
  638. 0.0 , 4.9970E-01 , 0.0 , 0.0 , 0.0 , &
  639. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  640. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  641. ! ETH
  642. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  643. 0.0 , xmeth/(xmc*2+xmh*4), 0.0 , 0.0 , 0.0 , &
  644. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  645. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  646. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  647. ! OLE
  648. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  649. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  650. 0.0 , 3.5668E-01 , 0.0 , 0.0 , 0.0 , &
  651. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  652. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  653. ! ALD2
  654. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  655. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  656. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  657. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  658. 0.0 , 5.4541E-01 , 0.0 , 0.0 , 0.0 , &
  659. ! MGLY
  660. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  661. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  662. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  663. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  664. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  665. ! CH2O
  666. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  667. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  668. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  669. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  670. 1.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  671. ! CH3OH (how to attribute alcohols to CH3OH? distribute over CH3OH (90%) and ETHOH (10%))
  672. 0.9 , 0.0 , 0.0 , 0.0 , 0.0 , &
  673. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  674. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  675. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  676. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  677. ! HCOOH
  678. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  679. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  680. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  681. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  682. 0.0 , 0.0 , 0.0 , 1.0 , 0.0 , &
  683. ! MCOOH
  684. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  685. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  686. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  687. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  688. 0.0 , 0.0 , 0.0 , 1.0 , 0.0 , &
  689. ! C2H6
  690. 0.0 , 1.0 , 0.0 , 0.0 , 0.0 , &
  691. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  692. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  693. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  694. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  695. ! ETHOH (attribute 10% alcohol emisions to ETHOH! )
  696. 0.1 , 0.0 , 0.0 , 0.0 , 0.0 , &
  697. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  698. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  699. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  700. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  701. ! C3H8
  702. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  703. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  704. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  705. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  706. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  707. ! C3H6
  708. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  709. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  710. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  711. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  712. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  713. ! Acetone
  714. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  715. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  716. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  717. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  718. 0.0 , 0.0 , 1.0 , 0.0 , 0.0/)
  719. ! -------------------------------------------------------------------
  720. ! M A C C
  721. ! -------------------------------------------------------------------
  722. !
  723. ! Distribution of NMV over the CBM-4 components (kg C/kg NMV) .
  724. ! VOC numbering according to TNO/RETRO speciation.
  725. ! Anthropogenic emissions of isoprene (ivoc=10), monoterpenes(ivoc=11) and others(ivoc=25)
  726. ! are not used (set to zero in voc2c_tno and voc2c_fires) .
  727. ! The speciation is slightly different for biomass burning emissions, where:
  728. ! voc_1 is methanol (which does not contribute) instead of alcohols,
  729. ! voc_23 is acetone instead of ketones and
  730. ! acetaldehyde is given instead of 'other aldehydes' (voc_22)
  731. ! For biomass burning isoprene (ivoc_10) and monoterpene (ivoc_11) are nonzero
  732. ! and need to be included separately.
  733. !
  734. integer, parameter :: emis_macc_nvoc = 15
  735. !
  736. ! TM4-RETRO names MACC/grg names
  737. ! ---------------------------------- ------------------------
  738. ! 2.1 CO
  739. ! 2.2 NO
  740. ! 1 alcohols 2.x CH3OH <- no C-C bond: not included TM5
  741. ! 2.4 C2H5OH <-1 PAR
  742. ! 2 ethane 2.5 C2H6
  743. ! 3 propane 2.6 C3H8
  744. ! 2.7 BIGALK: lumped_alkanes: (58 g/mole = butane)
  745. ! 4 butanes incl- c4h10
  746. ! 5 pentanes
  747. ! 6 hexanes_plus_higher_alkanes
  748. ! 7 ethene 2.8 C2H4
  749. ! 8 propene 2.9 C3H6
  750. ! 9
  751. ! 10 2.10 ISOPRENE
  752. ! 11 2.11 TERPENES
  753. ! 12 other_alkenes_and_alkynes 2.12 BIKENE: lumped_alkenes (56 g/mole -> CBM-5 speciation gives one OLE. (1 double bond)
  754. ! 2.13 TOLUENE: lumped_aromatics:
  755. ! 13 incl?- benzene
  756. ! 14 - toluene
  757. ! 15 xylene - xylene
  758. ! 16 trimethylbenzenes
  759. ! 17 other_aromatics
  760. ! 18 esters
  761. ! 19 ethers
  762. ! 20 chlorinated_hydrocarbons
  763. ! 21 methanal 2.14 CH2O (formaldehyde,methanal)
  764. ! 22 alkanals 2.15 CH3CHO (acetaldehyde,acetal)
  765. ! 23 ketones 2.16 CH3COCH3: acetone
  766. ! 24 acids
  767. ! 2.17 h2
  768. !
  769. ! vh. According to Angelika Heil (FZ Juelich) the mol. weights for lumped species in biomass burning are
  770. ! vh different from the anthropogenic emissions, as follows:
  771. ! vh Ankelika Heil:
  772. ! We updated these molecular weights for biomass burning for the MOZART
  773. ! lumped groups as follows:
  774. ! Higher_Alkanes: 58 g/mole ==> 78.8 g/mole
  775. ! Higher_Alkenes: 56 g/mole ==> 64.0 g/mole
  776. ! Toluene_lump: 92 g/mole ==> 85.7 g/mole
  777. ! The MOZART lumped groups were formed as follows:
  778. ! Toluene_lump (C7H8+ C6H6 + C8H10): MOZART lumped toluene species,
  779. ! incorporating benzene, toluene, xylene
  780. ! Higher Alkenes (CnH2n, C>=4): all alkenes (C>=4) specified in Andreae
  781. ! and Merlet (2001) which are not contained in the Toluene_lump group.
  782. ! These are: Butenes (1-butene + i-butene + tr-2-butene + cis-2-butene)
  783. ! (C4H8), Pentenes (1-pentene + 2-pentene) (C5H10), Hexene (C6H12),
  784. ! Octene (C8H16)
  785. ! Higher Alkanes (CnH2n+2, C>=4): all alkanes (C>=4) specified in Andreae
  786. ! and Merlet (2001). These are: Butanes (n-butane + i-butane) (C4H10),
  787. ! Pentanes (n-pentane + i-pentane) (C5H12), Hexane (n-hexane + i-hexane)
  788. ! (C6H14), Heptane (C7H16)
  789. ! We calculated the molecular weight of these lumped groups from weighting
  790. ! the molecular mass of the individual species with their relative mass
  791. ! contribution to the total fire emissions of each group during 2001-2006
  792. ! (calculated from GFEDv2 data).
  793. ! JEW: looking at the decomposition of TOL reveals ther is a product yield of 0.2MGLY
  794. ! which should be added analogous to the xylene > MGLY link in Houweling et al. (1998)
  795. character(len=26), parameter :: emis_macc_voc_name(emis_macc_nvoc) = (/ &
  796. 'C2H5OH ', & ! 1
  797. 'C2H6 ', & ! 2
  798. 'C3H8 ', & ! 3
  799. 'BIGALK ', & ! 4
  800. 'C2H4 ', & ! 5
  801. 'C3H6 ', & ! 6
  802. 'ISOPRENE ', & ! 7
  803. 'TERPENES ', & ! 8
  804. 'BIGENE ', & ! 9
  805. 'TOLUENE ', & ! 10
  806. 'CH2O ', & ! 11
  807. 'CH3CHO ', & ! 12
  808. 'CH3COCH3 ', & ! 13
  809. 'MEK ', & ! 14
  810. 'CH3OH '/) ! 15
  811. ! voc_to_cbm5: Table to convert kg(nmvoc) to 'kg(cbm5) for variable cbm5
  812. real, parameter :: emis_macc_voc2cbm5_default(emis_macc_nvoc*ncb5) = (/ &
  813. ! PAR
  814. 0.0 , 0.0 , 0.0 , 4.0*xmpar/(4*xmc+10*xmh), &
  815. 0.0 , 0.0 , 0.0 , 0.0 , &
  816. 2*xmpar/(4*xmc+8*xmh) , xmpar/92. , 0.0 , 0.0 , &
  817. 0.0 , 4*xmpar/72. , 0.0 , &
  818. ! ETH
  819. 0.0 , 0.0 , 0.0 , 0.0 , &
  820. xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , &
  821. 0.0 , 0.0 , 0.0 , 0.0 , &
  822. 0.0 , 0.0 , 0.0 , &
  823. ! OLE
  824. 0.0 , 0.0 , 0.0 , 0.0 , &
  825. 0.0 , 0.0 , 0.0 , 0.0 , &
  826. xmole/(4*xmc+8*xmh) , 0.0 , 0.0 , 0.0 , &
  827. 0.0 , 0.0 , 0.0 , &
  828. ! ALD2
  829. 0.0 , 0.0 , 0.0 , 0.0 , &
  830. 0.0 , 0.0 , 0.0 , 0.0 , &
  831. 0.0 , 0.0 , 0.0 , xmald2/44. , &
  832. 0.0 , 0.0 , 0.0 , &
  833. ! MGLY
  834. 0.0 , 0.0 , 0.0 , 0.0 , &
  835. 0.0 , 0.0 , 0.0 , 0.0 , &
  836. 0.0 , 0.2*xmgly/(92.0) , 0.0 , 0.0 , &
  837. 0.0 , 0.0 , 0.0 , &
  838. ! CH2O
  839. 0.0 , 0.0 , 0.0 , 0.0 , &
  840. 0.0 , 0.0 , 0.0 , 0.0 , &
  841. 0.0 , 0.0 , 1.0 , 0.0 , &
  842. 0.0 , 0.0 , 0.0 , &
  843. ! CH3OH
  844. 0.0 , 0.0 , 0.0 , 0.0 , &
  845. 0.0 , 0.0 , 0.0 , 0.0 , &
  846. 0.0 , 0.0 , 0.0 , 0.0 , &
  847. 0.0 , 0.0 , 1.0 , &
  848. ! HCOOH
  849. 0.0 , 0.0 , 0.0 , 0.0 , &
  850. 0.0 , 0.0 , 0.0 , 0.0 , &
  851. 0.0 , 0.0 , 0.0 , 0.0 , &
  852. 0.0 , 0.0 , 0.0 , &
  853. ! MCOOH
  854. 0.0 , 0.0 , 0.0 , 0.0 , &
  855. 0.0 , 0.0 , 0.0 , 0.0 , &
  856. 0.0 , 0.0 , 0.0 , 0.0 , &
  857. 0.0 , 0.0 , 0.0 , &
  858. !C2H6
  859. 0.0 , 1.0 , 0.0 , 0.0 , &
  860. 0.0 , 0.0 , 0.0 , 0.0 , &
  861. 0.0 , 0.0 , 0.0 , 0.0 , &
  862. 0.0 , 0.0 , 0.0 , &
  863. !ETHOH
  864. 1.0 , 0.0 , 0.0 , 0.0 , &
  865. 0.0 , 0.0 , 0.0 , 0.0 , &
  866. 0.0 , 0.0 , 0.0 , 0.0 , &
  867. 0.0 , 0.0 , 0.0 , &
  868. !C3H8
  869. 0.0 , 0.0 , 1.0 , 0.0 , &
  870. 0.0 , 0.0 , 0.0 , 0.0 , &
  871. 0.0 , 0.0 , 0.0 , 0.0 , &
  872. 0.0 , 0.0 , 0.0 , &
  873. !C3H6
  874. 0.0 , 0.0 , 0.0 , 0.0 , &
  875. 0.0 , 1.0 , 0.0 , 0.0 , &
  876. 0.0 , 0.0 , 0.0 , 0.0 , &
  877. 0.0 , 0.0 , 0.0 , &
  878. ! Acetone
  879. 0.0 , 0.0 , 0.0 , 0.0 , &
  880. 0.0 , 0.0 , 0.0 , 0.0 , &
  881. 0.0 , 0.0 , 0.0 , 0.0 , &
  882. 1.0 , 0.0 , 0.0/)
  883. ! For Biomass burning, use a the same table
  884. real, parameter :: emis_macc_voc2cbm5_biomassb(emis_macc_nvoc*ncb5) = (/ &
  885. ! PAR
  886. 0.0 , 0.0 , 0.0 , 4.0*xmpar/(4*xmc+10*xmh) , &
  887. 0.0 , 0.0 , 0.0 , 0.0 , &
  888. 2*xmpar/(4*xmc+8*xmh) , xmpar/92. , 0.0 , 0.0 , &
  889. 0.0 , 4*xmpar/72. , 0.0 , &
  890. ! ETH
  891. 0.0 , 0.0 , 0.0 , 0.0 , &
  892. xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , &
  893. 0.0 , 0.0 , 0.0 , 0.0 , &
  894. 0.0 , 0.0 , 0.0 , &
  895. ! OLE
  896. 0.0 , 0.0 , 0.0 , 0.0 , &
  897. 0.0 , 0.0 , 0.0 , 0.0 , &
  898. xmole/(4*xmc+8*xmh) , 0.0 , 0.0 , 0.0 , &
  899. 0.0 , 0.0 , 0.0 , &
  900. ! ALD2
  901. 0.0 , 0.0 , 0.0 , 0.0 , &
  902. 0.0 , 0.0 , 0.0 , 0.0 , &
  903. 0.0 , 0.0 , 0.0 , xmald2/44. , &
  904. 0.0 , 0.0 , 0.0 , &
  905. ! MGLY
  906. 0.0 , 0.0 , 0.0 , 0.0 , &
  907. 0.0 , 0.0 , 0.0 , 0.0 , &
  908. 0.0 , 0.2*xmgly/(92.0) , 0.0 , 0.0 , &
  909. 0.0 , 0.0 , 0.0 , &
  910. ! CH2O
  911. 0.0 , 0.0 , 0.0 , 0.0 , &
  912. 0.0 , 0.0 , 0.0 , 0.0 , &
  913. 0.0 , 0.0 , 1.0 , 0.0 , &
  914. 0.0 , 0.0 , 0.0 , &
  915. ! CH3OH
  916. 0.0 , 0.0 , 0.0 , 0.0 , &
  917. 0.0 , 0.0 , 0.0 , 0.0 , &
  918. 0.0 , 0.0 , 0.0 , 0.0 , &
  919. 0.0 , 0.0 , 1.0 , &
  920. ! HCOOH
  921. 0.0 , 0.0 , 0.0 , 0.0 , &
  922. 0.0 , 0.0 , 0.0 , 0.0 , &
  923. 0.0 , 0.0 , 0.0 , 0.0 , &
  924. 0.0 , 0.0 , 0.0 , &
  925. ! MCOOH
  926. 0.0 , 0.0 , 0.0 , 0.0 , &
  927. 0.0 , 0.0 , 0.0 , 0.0 , &
  928. 0.0 , 0.0 , 0.0 , 0.0 , &
  929. 0.0 , 0.0 , 0.0 , &
  930. !C2H6
  931. 0.0 , 1.0 , 0.0 , 0.0 , &
  932. 0.0 , 0.0 , 0.0 , 0.0 , &
  933. 0.0 , 0.0 , 0.0 , 0.0 , &
  934. 0.0 , 0.0 , 0.0 , &
  935. !ETHOH
  936. 1.0 , 0.0 , 0.0 , 0.0 , &
  937. 0.0 , 0.0 , 0.0 , 0.0 , &
  938. 0.0 , 0.0 , 0.0 , 0.0 , &
  939. 0.0 , 0.0 , 0.0 , &
  940. !C3H8
  941. 0.0 , 0.0 , 1.0 , 0.0 , &
  942. 0.0 , 0.0 , 0.0 , 0.0 , &
  943. 0.0 , 0.0 , 0.0 , 0.0 , &
  944. 0.0 , 0.0 , 0.0 , &
  945. !C3H6
  946. 0.0 , 0.0 , 0.0 , 0.0 , &
  947. 0.0 , 1.0 , 0.0 , 0.0 , &
  948. 0.0 , 0.0 , 0.0 , 0.0 , &
  949. 0.0 , 0.0 , 0.0 , &
  950. ! Acetone
  951. 0.0 , 0.0 , 0.0 , 0.0 , &
  952. 0.0 , 0.0 , 0.0 , 0.0 , &
  953. 0.0 , 0.0 , 0.0 , 0.0 , &
  954. 1.0 , 0.0 , 0.0/)
  955. ! specific for biogenic emissions
  956. real, parameter :: emis_macc_voc2cbm5_biogenic(emis_macc_nvoc*ncb5) = (/ &
  957. ! PAR
  958. 0.0 , 0.0 , 0.0 , 4.0*xmpar/(4*xmc+10*xmh), &
  959. 0.0 , 0.0 , 0.0 , 0.0 , &
  960. 2*xmpar/(4*xmc+8*xmh) , xmpar/92. , 0.0 , 0.0 , &
  961. 0.0 , 4*xmpar/72. , 0.0 , &
  962. ! ETH
  963. 0.0 , 0.0 , 0.0 , 0.0 , &
  964. xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , &
  965. 0.0 , 0.0 , 0.0 , 0.0 , &
  966. 0.0 , 0.0 , 0.0 , &
  967. ! OLE
  968. 0.0 , 0.0 , 0.0 , 0.0 , &
  969. 0.0 , 0.0 , 0.0 , 0.0 , &
  970. xmole/(4*xmc+8*xmh) , 0.0 , 0.0 , 0.0 , &
  971. 0.0 , 0.0 , 0.0 , &
  972. ! ALD2
  973. 0.0 , 0.0 , 0.0 , 0.0 , &
  974. 0.0 , 0.0 , 0.0 , 0.0 , &
  975. 0.0 , 0.0 , 0.0 , xmald2/44. , &
  976. 0.0 , 0.0 , 0.0 , &
  977. ! MGLY
  978. 0.0 , 0.0 , 0.0 , 0.0 , &
  979. 0.0 , 0.0 , 0.0 , 0.0 , &
  980. 0.0 , 0.2*xmgly/(92.0) , 0.0 , 0.0 , &
  981. 0.0 , 0.0 , 0.0 , &
  982. ! CH2O
  983. 0.0 , 0.0 , 0.0 , 0.0 , &
  984. 0.0 , 0.0 , 0.0 , 0.0 , &
  985. 0.0 , 0.0 , 1.0 , 0.0 , &
  986. 0.0 , 0.0 , 0.0 , &
  987. ! CH3OH
  988. 0.0 , 0.0 , 0.0 , 0.0 , &
  989. 0.0 , 0.0 , 0.0 , 0.0 , &
  990. 0.0 , 0.0 , 0.0 , 0.0 , &
  991. 0.0 , 0.0 , 1.0 , &
  992. ! HCOOH
  993. 0.0 , 0.0 , 0.0 , 0.0 , &
  994. 0.0 , 0.0 , 0.0 , 0.0 , &
  995. 0.0 , 0.0 , 0.0 , 0.0 , &
  996. 0.0 , 0.0 , 0.0 , &
  997. ! MCOOH
  998. 0.0 , 0.0 , 0.0 , 0.0 , &
  999. 0.0 , 0.0 , 0.0 , 0.0 , &
  1000. 0.0 , 0.0 , 0.0 , 0.0 , &
  1001. 0.0 , 0.0 , 0.0 , &
  1002. !C2H6
  1003. 0.0 , 1.0 , 0.0 , 0.0 , &
  1004. 0.0 , 0.0 , 0.0 , 0.0 , &
  1005. 0.0 , 0.0 , 0.0 , 0.0 , &
  1006. 0.0 , 0.0 , 0.0 , &
  1007. !ETHOH
  1008. 1.0 , 0.0 , 0.0 , 0.0 , &
  1009. 0.0 , 0.0 , 0.0 , 0.0 , &
  1010. 0.0 , 0.0 , 0.0 , 0.0 , &
  1011. 0.0 , 0.0 , 0.0 , &
  1012. !C3H8
  1013. 0.0 , 0.0 , 1.0 , 0.0 , &
  1014. 0.0 , 0.0 , 0.0 , 0.0 , &
  1015. 0.0 , 0.0 , 0.0 , 0.0 , &
  1016. 0.0 , 0.0 , 0.0 , &
  1017. !C3H6
  1018. 0.0 , 0.0 , 0.0 , 0.0 , &
  1019. 0.0 , 1.0 , 0.0 , 0.0 , &
  1020. 0.0 , 0.0 , 0.0 , 0.0 , &
  1021. 0.0 , 0.0 , 0.0 , &
  1022. ! Acetone
  1023. 0.0 , 0.0 , 0.0 , 0.0 , &
  1024. 0.0 , 0.0 , 0.0 , 0.0 , &
  1025. 0.0 , 0.0 , 0.0 , 0.0 , &
  1026. 1.0 , 0.0 , 0.0/)
  1027. ! -------------------------------------------------------------------
  1028. ! M A C C - M E G A N
  1029. ! -------------------------------------------------------------------
  1030. !
  1031. ! Distribution of NMV over the CBM-4 components (kg C/kg NMV) .
  1032. ! VOC numbering according to TNO/RETRO speciation.
  1033. ! The speciation is slightly different for biomass burning emissions, where:
  1034. ! voc_1 is methanol (which does not contribute) instead of alcohols,
  1035. ! voc_23 is acetone instead of ketones and
  1036. ! acetaldehyde is given instead of 'other aldehydes' (voc_22)
  1037. ! For biomass burning isoprene (ivoc_10) and monoterpene (ivoc_11) are nonzero
  1038. ! and need to be included separately.
  1039. !
  1040. !
  1041. ! TM4-RETRO names MEGAN/grg names
  1042. ! ---------------------------------- ------------------------
  1043. ! 2.1 CO
  1044. ! 1 alcohols 2.2 methanol <- no C-C bond: not included TM5
  1045. ! 2.3 ethanol <-1 PAR
  1046. ! 2 ethane 2.4 ethane
  1047. ! 3 propane 2.5 propane
  1048. ! 4 butanes 2.6 butanes_and_higher_alkanes (58 g/mole = butane)
  1049. ! incl- c4h10
  1050. ! 5 pentanes
  1051. ! 6 hexanes_plus_higher_alkanes
  1052. ! 7 ethene 2.7 ethene
  1053. ! 8 propene 2.8 propene
  1054. ! 9
  1055. ! 10 2.10 ISOPRENE
  1056. ! 11 2.11 monoterpenes
  1057. ! 12 other_alkenes_and_alkynes 2.12 butenes_and_higher_alkenes -> (56g/mole = butene)
  1058. ! 13 2.13 toluene (92g/mole=toluene) <- 0.2 MGLY
  1059. ! 14
  1060. ! 15 xylene
  1061. ! 16 trimethylbenzenes
  1062. ! 17 other_aromatics
  1063. ! 18 esters
  1064. ! 19 ethers
  1065. ! 20 chlorinated_hydrocarbons
  1066. ! 21 methanal 2.14 formaldehyde
  1067. ! 22 alkanals 2.15 acetaldehyde
  1068. ! 2.16 other_aldehydes (44g/mole=C2 and above aldehydes): ignore other double count
  1069. ! 23 ketones 2.17 acetone
  1070. ! 2.18 other_ketones (72g/mole=other ketones except acetone): <-4*PAR as lower limit
  1071. ! 24 acids 2.19 formic acid <- no C-C bond: not included TM5
  1072. ! 2.20 acetic acid <-1 PAR
  1073. !
  1074. integer, parameter :: emis_megan_nvoc = 18
  1075. ! the same as MACC, except no MEK
  1076. character(len=26), parameter :: emis_megan_voc_name(emis_megan_nvoc) = (/ &
  1077. 'methanol ', & ! 1
  1078. 'ethanol ', & ! 2
  1079. 'ethane ', & ! 3
  1080. 'propane ', & ! 4
  1081. 'butanes_and_higher_alkanes', & ! 5
  1082. 'ethene ', & ! 6
  1083. 'propene ', & ! 7
  1084. 'isoprene ', & ! 8
  1085. 'monoterpenes ', & ! 9
  1086. 'butenes_and_higher_alkenes', & ! 10
  1087. 'toluene ', & ! 11
  1088. 'formaldehyde ', & ! 12
  1089. 'acetaldehyde ', & ! 13
  1090. 'other_aldehydes ', & ! 14
  1091. 'acetone ', & ! 15
  1092. 'other_ketones ', & ! 16
  1093. 'formic_acid ', & ! 17
  1094. 'acetic_acid '/) ! 18
  1095. ! specific for MEGAN biogenic emissions
  1096. real, parameter :: emis_megan_voc2cbm5_biogenic(emis_megan_nvoc*ncb5) = (/ &
  1097. ! PAR
  1098. 0.0 , 0.0 , 0.0 , 0.0 , &
  1099. 4.0*xmpar/(4*xmc+10*xmh), 0.0 , 0.0 , 0.0 , 0.0 , &
  1100. 2*xmpar/(4*xmc+8*xmh) , xmpar/(92.0) , 0.0 , 0.0 , 0.0 , &
  1101. 0.0 , 4.0*xmpar/(72.0) , 0.0 , 0.0 , &
  1102. ! ETH
  1103. 0.0 , 0.0 , 0.0 , 0.0 , &
  1104. 0.0 , xmeth/(2*xmc+4*xmh) , 0.0 , 0.0 , 0.0 , &
  1105. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1106. 0.0 , 0.0 , 0.0 , 0.0 , &
  1107. ! OLE
  1108. 0.0 , 0.0 , 0.0 , 0.0 , &
  1109. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1110. xmole/(4*xmc+8*xmh) , 0.0 , 0.0 , 0.0 , 0.0 , &
  1111. 0.0 , 0.0 , 0.0 , 0.0 , &
  1112. ! ALD2
  1113. 0.0 , 0.0 , 0.0 , 0.0 , &
  1114. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1115. 0.0 , 0.0 , 0.0 , xmald2/44. , 0.0 , &
  1116. 0.0 , 0.0 , 0.0 , 0.0 , &
  1117. ! MGLY
  1118. 0.0 , 0.0 , 0.0 , 0.0 , &
  1119. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1120. 0.0 , 0.2*xmgly/(92.0) , 0.0 , 0.0 , 0.0 , &
  1121. 0.0 , 0.0 , 0.0 , 0.0 , &
  1122. ! CH2O
  1123. 0.0 , 0.0 , 0.0 , 0.0 , &
  1124. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1125. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  1126. 0.0 , 0.0 , 0.0 , 0.0 , &
  1127. ! CH3OH
  1128. 1.0 , 0.0 , 0.0 , 0.0 , &
  1129. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1130. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1131. 0.0 , 0.0 , 0.0 , 0.0 , &
  1132. ! HCOOH
  1133. 0.0 , 0.0 , 0.0 , 0.0 , &
  1134. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1135. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1136. 0.0 , 0.0 , 1.0 , 0.0 , &
  1137. ! MCOOH
  1138. 0.0 , 0.0 , 0.0 , 0.0 , &
  1139. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1140. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1141. 0.0 , 0.0 , 0.0 , 1.0 , &
  1142. !C2H6
  1143. 0.0 , 0.0 , 1.0 , 0.0 , &
  1144. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1145. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1146. 0.0 , 0.0 , 0.0 , 0.0 , &
  1147. !ETHOH
  1148. 0.0 , 1.0 , 0.0 , 0.0 , &
  1149. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1150. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1151. 0.0 , 0.0 , 0.0 , 0.0 , &
  1152. !C3H8
  1153. 0.0 , 0.0 , 0.0 , 1.0 , &
  1154. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1155. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1156. 0.0 , 0.0 , 0.0 , 0.0 , &
  1157. !C3H6
  1158. 0.0 , 0.0 , 0.0 , 0.0 , &
  1159. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  1160. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1161. 0.0 , 0.0 , 0.0 , 0.0 , &
  1162. ! Acetone
  1163. 0.0 , 0.0 , 0.0 , 0.0 , &
  1164. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1165. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1166. 1.0 , 0.0 , 0.0 , 0.0/)
  1167. !--------------------------------------------------------------------
  1168. ! CMIP6 - Aircraft emissions
  1169. !--------------------------------------------------------------------
  1170. ! For the aviation sector only the total NMVOC emissions are provided
  1171. ! due to the relatively low rate of emissions
  1172. ! and the large size of the files that would result
  1173. ! in case speciated emissions were provided.
  1174. ! In order to include these, we follow the recommendations
  1175. ! from README-CEDS-VOC-speciation_06_30_2016.txt:
  1176. ! "A suggested speciation for aircraft emissions is provided below
  1177. ! as used in EDGAR (thanks to Greet Maenhout).
  1178. ! Two profiles are provided, Takeoff_landing, and Aircraft_Exhaust.
  1179. ! We suggest, for simplicity, applying the Takeoff_landing profile
  1180. ! to the lowest two layers (0.305 km and 0.915 km) in the aircraft emissions file."
  1181. ! It is assumed here that the species in the profiles given below
  1182. ! have a one-to-one correspondence with the species
  1183. ! used for the other anthropogenic sectors for AR5/CMIP6.
  1184. ! Profiles for aircraft emissions
  1185. ! data source: USEPA SPECIATE 4.4 database
  1186. ! http://cfpub.epa.gov/si/speciate/
  1187. ! This profile can be used for aircraft exhausts
  1188. ! VOC_species weight (%)
  1189. ! Pentanes 0.19801
  1190. ! Trimethylbenzenes 0.510026
  1191. ! Methylbenzene 0.642032
  1192. ! Ethane 0.521026
  1193. ! Dimethylbenzenes 0.448022
  1194. ! Benzene 1.681084
  1195. ! Alkanones 0.369018
  1196. ! Alkanols 1.80509
  1197. ! Other alk(adi)enes/alkynes 13.35667
  1198. ! Other alkanals 21.9461
  1199. ! Ethene 15.46177
  1200. ! Propane 0.078004
  1201. ! Propene 4.534227
  1202. ! Ethyne 3.939197
  1203. ! Hexanes and higher 18.11991
  1204. ! Other aromatics 4.079204
  1205. ! Methanal 12.31062
  1206. real, parameter :: emis_cmip6_aircraft_tot2voc(emis_ar5_nvoc) = (/ &
  1207. 1.80509 , 0.521026 , 0.078004 , 0.0 , 0.19801 , &
  1208. 18.11991 , 15.46177 , 4.534227 , 3.939197 , 0.0 , &
  1209. 0.0 , 13.35667 , 1.681084 , 0.642032 , 0.448022 , &
  1210. 0.510026 , 4.079204 , 0.0 , 0.0 , 0.0 , &
  1211. 12.31062 , 21.9461 , 0.369018 , 0.0 , 0.0/) / 100.
  1212. ! This profile can be used for Aircraft Landing/Takeoff
  1213. ! VOC_species weight (%)
  1214. ! Methanal 15.87872
  1215. ! Methylbenzene 0.550253
  1216. ! Propene 5.154408
  1217. ! Propane 0.224593
  1218. ! Pentanes 0.213363
  1219. ! Other aromatics 2.930938
  1220. ! Other alkanals 12.5772
  1221. ! Ethyne 4.143739
  1222. ! Other 13.21729
  1223. ! Ethane 1.033127
  1224. ! Hexanes and higher 10.66816
  1225. ! Ethene 17.40595
  1226. ! Dimethylbenzenes 0.494104
  1227. ! Alkanones 3.290286
  1228. ! Alkanols 2.032566
  1229. ! Other alk(adi)enes/alkynes 8.175182
  1230. ! Benzene 2.010107
  1231. real, parameter :: emis_cmip6_aircraft_tl_tot2voc(emis_ar5_nvoc) = (/ &
  1232. 2.032566 , 1.033127 , 0.224593 , 0.0 , 0.213363 , &
  1233. 10.66816 , 17.40595 , 5.154408 , 4.143739 , 0.0 , &
  1234. 0.0 , 8.175182 , 2.010107 , 0.550253 , 0.494104 , &
  1235. 0.0 , 2.930938 , 0.0 , 0.0 , 0.0 , &
  1236. 15.87872 , 12.5772 , 3.290286 , 0.0 , 13.21729/) / 100.
  1237. !--------------------------------------------------------------------
  1238. ! CMIP6 - Biomass Burning
  1239. ! -------------------------------------------------------------------
  1240. ! Copied from MACC-MEGAN VOC split, but with some modifications:
  1241. ! - Ketones replaced by MEK with contribution factor from MACC (same as for ketones).
  1242. ! - Lumped toluene replaced by benzene (C6H6), toluene (C7H8) and xylene (C8H10)
  1243. ! with contribution factors from AR5.
  1244. ! - CH3COCHO (MGLY) added
  1245. ! - 'other_aldehydes' doesn't contribute and is not provided,
  1246. ! therefore replaced by 'not provided'
  1247. ! - Molar mass of higher alkanes and higher alkenes is 12 g/mol.
  1248. !
  1249. ! Also provided are ethyne (C2H2), hydroxyacetaldehyde (HOCH2CHO),
  1250. ! and hydrogen cyanide (HCN):
  1251. ! but these are not included:
  1252. ! - C2H2 assumed not to contribute (in contrast to split applied to AR5)
  1253. ! - HOCH2CHO assumed not to contribute (like 'other_aldehydes')
  1254. ! - HCN assumed not to contribute
  1255. integer, parameter :: emis_cmip6bmb_nvoc = 21
  1256. character(len=26), parameter :: emis_cmip6bmb_voc_name(emis_cmip6bmb_nvoc) = (/ &
  1257. 'CH3OH ', & ! 1
  1258. 'C2H5OH ', & ! 2
  1259. 'C2H6 ', & ! 3
  1260. 'C3H8 ', & ! 4
  1261. 'Higher-Alkanes ', & ! 5
  1262. 'C2H4 ', & ! 6
  1263. 'C3H6 ', & ! 7
  1264. 'C5H8 ', & ! 8
  1265. 'C10H16 ', & ! 9
  1266. 'Higher-Alkenes ', & ! 10
  1267. 'C6H6 ', & ! 11
  1268. 'C7H8 ', & ! 12
  1269. 'C8H10 ', & ! 13
  1270. 'CH2O ', & ! 14
  1271. 'C2H4O ', & ! 15
  1272. 'not provided ', & ! 16
  1273. 'C3H6O ', & ! 17
  1274. 'MEK ', & ! 18
  1275. 'HCOOH ', & ! 19
  1276. 'CH3COOH ', & ! 20
  1277. 'CH3COCHO '/) ! 21
  1278. real, parameter :: emis_cmip6bmb_voc2cbm5(emis_cmip6bmb_nvoc*ncb5) = (/ &
  1279. ! PAR
  1280. 0.0 , 0.0 , 0.0 , 0.0 , 4.0*xmpar/(4*xmc), &
  1281. 0.0 , 0.0 , 0.0 , 0.0 , 2.*xmpar/(4*xmc), &
  1282. 1.5386E-01 , 0.0 , 1.2451E-01 , 0.0 , 0.0 , &
  1283. 0.0 , 0.0 , 4.0*xmpar/(72.0) , 0.0 , 0.0 , &
  1284. 0.0 , &
  1285. ! ETH
  1286. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1287. xmeth/(xmc*2+xmh*4) , 0.0 , 0.0 , 0.0 , 0.0 , &
  1288. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1289. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1290. 0.0 , &
  1291. ! OLE
  1292. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1293. 0.0 , 0.0 , 0.0 , 0.0 , xmole/(4*xmc) , &
  1294. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1295. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1296. 0.0 , &
  1297. ! ALD2
  1298. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1299. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1300. 0.0 , 0.0 , 0.0 , 0.0 , xmald2/44. , &
  1301. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1302. 0.0 , &
  1303. ! MGLY
  1304. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1305. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1306. 0.0 , 0.0 , 2.7167E-01 , 0.0 , 0.0 , &
  1307. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1308. 1.0 , &
  1309. ! CH2O
  1310. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1311. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1312. 0.0 , 0.0 , 0.0 , 1.0 , 0.0 , &
  1313. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1314. 0.0 , &
  1315. ! CH3OH
  1316. 1.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1317. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1318. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1319. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1320. 0.0 , &
  1321. ! HCOOH
  1322. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1323. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1324. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1325. 0.0 , 0.0 , 0.0 , 1.0 , 0.0 , &
  1326. 0.0 , &
  1327. ! MCOOH
  1328. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1329. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1330. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1331. 0.0 , 0.0 , 0.0 , 0.0 , 1.0 , &
  1332. 0.0 , &
  1333. !C2H6
  1334. 0.0 , 0.0 , 1.0 , 0.0 , 0.0 , &
  1335. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1336. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1337. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1338. 0.0 , &
  1339. !ETHOH
  1340. 0.0 , 1.0 , 0.0 , 0.0 , 0.0 , &
  1341. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1342. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1343. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1344. 0.0 , &
  1345. !C3H8
  1346. 0.0 , 0.0 , 0.0 , 1.0 , 0.0 , &
  1347. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1348. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1349. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1350. 0.0 , &
  1351. !C3H6
  1352. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1353. 0.0 , 1.0 , 0.0 , 0.0 , 0.0 , &
  1354. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1355. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1356. 0.0 , &
  1357. ! Acetone
  1358. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1359. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1360. 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , &
  1361. 0.0 , 1.0 , 0.0 , 0.0 , 0.0 , &
  1362. 0.0/)
  1363. ! -------------------------------------------------------------------
  1364. ! GFED biomass burning
  1365. ! -------------------------------------------------------------------
  1366. integer, parameter :: emis_gfed_nvoc = 13
  1367. ! the same as MACC, except CH3CHO, CH3COCH3, and MEK !
  1368. character(len=26), parameter :: emis_gfed_voc_name(emis_gfed_nvoc) = (/ &
  1369. 'ch3oh ', & ! 1
  1370. 'c2h5oh ', & ! 2
  1371. 'c2h6 ', & ! 3
  1372. 'c3h8 ', & ! 4
  1373. 'higher_alkanes ', & ! 5
  1374. 'c2h4 ', & ! 6
  1375. 'c3h6 ', & ! 7
  1376. 'isoprene ', & ! 8
  1377. 'terpenes ', & ! 9
  1378. 'higher_alkenes ', & ! 10
  1379. 'toluenes ', & ! 11
  1380. 'ch2o ', & ! 12
  1381. 'nmhc '/) ! 13
  1382. ! For Biomass burning, use a the same table
  1383. ! The conversion to CBM5 species is defined using the speciation given in Hoor et al, ACP, 2009
  1384. ! species explicily accounted for : CH3OH, CH2O, C2H4, C2H6, C2H5OH, C3H8 and C3H6
  1385. ! MGLY is released from BB for toluene
  1386. ! In Hoor et al. there is a 13% fraction of any organics from burning which are unspeciated (i.e.) lost
  1387. ! species accounted for : HCOOH (4.04954E-2), CH3CHO(4.83586E-2), CH3COOH(1.13623E-01) and Acetone (5.1278E-02)
  1388. ! JEW 2014 : Assume the higher alkanes are butanes, higher alkenes are iso-butene (1 CH2O, 1OLE)
  1389. !
  1390. real, parameter :: emis_voc2cbm5_gfed(emis_gfed_nvoc*ncb5) = (/ &
  1391. ! PAR
  1392. 0.0 , 0.0 , 0.0 , 0.0 , &
  1393. 4.0*xmpar/(xmc*4+xmh*10), 0.0 , 0.0 , 0.0 , &
  1394. 0.0 , 2.0*xmpar/(xmc*4+xmh*8), xmc/92. , 0.0 , &
  1395. 0.0 , &
  1396. ! ETH
  1397. 0.0 , 0.0 , 0.0 , 0.0 , &
  1398. 0.0 , 0.0 , xmeth/(xmc*2+xmh*4) , 0.0 , &
  1399. 0.0 , 0.0 , 0.0 , 0.0 , &
  1400. 0.0 , &
  1401. ! OLE
  1402. 0.0 , 0.0 , 0.0 , 0.0 , &
  1403. 0.0 , 0.0 , 0.0 , 0.0 , &
  1404. 0.0 , xmole/(xmc*4+xmh*8) , 0.0 , 0.0 , &
  1405. 0.0 , &
  1406. ! ALD
  1407. 0.0 , 0.0 , 0.0 , 0.0 , &
  1408. 0.0 , 0.0 , 0.0 , 0.0 , &
  1409. 0.0 , 0.0 , 0.0 , 0.0 , &
  1410. (xmald2/xmc)*4.83586E-2 , &
  1411. ! MGLY
  1412. 0.0 , 0.0 , 0.0 , 0.0 , &
  1413. 0.0 , 0.0 , 0.0 , 0.0 , &
  1414. 0.0 , 0.0 , 0.2*xmgly/(92.0) , 0.0 , &
  1415. 0.0 , &
  1416. ! CH2O
  1417. 0.0 , 0.0 , 0.0 , 0.0 , &
  1418. 0.0 , 0.0 , 0.0 , 0.0 , &
  1419. 0.0 , 0.0 , 0.0 , 1.0 , &
  1420. 0.0 , &
  1421. ! CH3OH
  1422. 1.0 , 0.0 , 0.0 , 0.0 , &
  1423. 0.0 , 0.0 , 0.0 , 0.0 , &
  1424. 0.0 , 0.0 , 0.0 , 0.0 , &
  1425. 0.0 , &
  1426. ! HCOOH
  1427. 0.0 , 0.0 , 0.0 , 0.0 , &
  1428. 0.0 , 0.0 , 0.0 , 0.0 , &
  1429. 0.0 , 0.0 , 0.0 , 0.0 , &
  1430. (xmhcooh/xmc)*4.04954E-2, &
  1431. ! MCOOH
  1432. 0.0 , 0.0 , 0.0 , 0.0 , &
  1433. 0.0 , 0.0 , 0.0 , 0.0 , &
  1434. 0.0 , 0.0 , 0.0 , 0.0 , &
  1435. (xmmcooh/xmc)*1.13623E-01, &
  1436. ! C2H6
  1437. 0.0 , 0.0 , 1.0 , 0.0 , &
  1438. 0.0 , 0.0 , 0.0 , 0.0 , &
  1439. 0.0 , 0.0 , 0.0 , 0.0 , &
  1440. 0.0 , &
  1441. ! ETHOH
  1442. 0.0 , 1.0 , 0.0 , 0.0 , &
  1443. 0.0 , 0.0 , 0.0 , 0.0 , &
  1444. 0.0 , 0.0 , 0.0 , 0.0 , &
  1445. 0.0 , &
  1446. ! C3H8
  1447. 0.0 , 0.0 , 0.0 , 1.0 , &
  1448. 0.0 , 0.0 , 0.0 , 0.0 , &
  1449. 0.0 , 0.0 , 0.0 , 0.0 , &
  1450. 0.0 , &
  1451. ! C3H6
  1452. 0.0 , 0.0 , 0.0 , 0.0 , &
  1453. 0.0 , 0.0 , 1.0 , 0.0 , &
  1454. 0.0 , 0.0 , 0.0 , 0.0 , &
  1455. 0.0 , &
  1456. ! Acetone
  1457. 0.0 , 0.0 , 0.0 , 0.0 , &
  1458. 0.0 , 0.0 , 0.0 , 0.0 , &
  1459. 0.0 , 0.0 , 0.0 , 0.0 , &
  1460. (xmacet/xmc)*5.01278E-2 /)
  1461. ! NB: base the RETRO voc speciation on AR5 (retro species are a subset of AR5)
  1462. character(len=26), parameter :: emis_retro_voc_name(emis_ar5_nvoc) = (/ &
  1463. 'CH3OH ', & ! 1 ! only methanol provided, we do not include it
  1464. 'ETHANE ', & ! 2
  1465. 'PROPANE ', & ! 3
  1466. 'not provided ', & ! 4
  1467. 'not provided ', & ! 5
  1468. 'not provided ', & ! 6
  1469. 'ETHENE ', & ! 7
  1470. 'PROPENE ', & ! 8
  1471. 'ETHYNE ', & ! 9
  1472. 'ISOPRENE ', & ! 10
  1473. 'MONOTERPENES ', & ! 11
  1474. 'not provided ', & ! 12
  1475. 'BENZENE ', & ! 13
  1476. 'TOLUENE ', & ! 14
  1477. 'XYLENE ', & ! 15
  1478. 'not provided ', & ! 16
  1479. 'not provided ', & ! 17
  1480. 'not provided ', & ! 18
  1481. 'not provided ', & ! 19
  1482. 'not provided ', & ! 20
  1483. 'CH2O ', & ! 21
  1484. 'CH3CHO ', & ! 22
  1485. 'ACETONE ', & ! 23
  1486. 'not provided ', & ! 24
  1487. 'not provided ' /) ! 25
  1488. !
  1489. ! !REVISION HISTORY:
  1490. ! 1 Oct 2010 - Achim Strunk - v0 for AR5, MACC
  1491. ! 1 Dec 2011 - Narcisa Banda - added EDGAR 4.1 and 4.2
  1492. ! 19 Jun 2012 - P. Le Sager - cosmetic for lon-lat MPI domain decomposition
  1493. ! (all reading/regridding on root for now)
  1494. ! 20 Nov 2012 - Ph. Le Sager - defined and build lists of used providers
  1495. ! - deal with inventories years availability
  1496. ! - switch to MDF interface to read data
  1497. !
  1498. ! !TODO:
  1499. ! - should be renamed something like "emission_inventories" or "emiss_providers"
  1500. ! - and need to get a **SEPARATE** module for each inventories, before it
  1501. ! becomes unmanageable again
  1502. !
  1503. !EOP
  1504. !------------------------------------------------------------------------
  1505. CONTAINS
  1506. !--------------------------------------------------------------------------
  1507. ! TM5 !
  1508. !--------------------------------------------------------------------------
  1509. !BOP
  1510. !
  1511. ! !IROUTINE: EMISSION_READ_INIT
  1512. !
  1513. ! !DESCRIPTION: Initialise reading related parameters and
  1514. ! allocate needed arrays
  1515. !
  1516. !\\
  1517. ! !INTERFACE:
  1518. !
  1519. SUBROUTINE EMISSION_READ_INIT( rcF, status )
  1520. !
  1521. ! !USES:
  1522. !
  1523. use GO, only : TrcFile, ReadRc
  1524. use partools, only : isRoot
  1525. use emission_data, only : LCMIP6, LCMIP6BMB
  1526. use emission_data, only : LAR5, LEDGAR4, LRETROF, LGFED3, LMACC, LLPJ, LHYMN, LAR5BMB, LMACCITY, LMEGAN
  1527. use meteodata, only : set, gph_dat
  1528. use dims, only : im, jm, lm, nregions
  1529. !
  1530. ! !INPUT PARAMETERS:
  1531. !
  1532. type(TrcFile) :: rcF
  1533. !
  1534. ! !OUTPUT PARAMETERS:
  1535. !
  1536. integer, intent(out) :: status
  1537. !
  1538. ! !REVISION HISTORY:
  1539. ! 1 Oct 2010 - Achim Strunk - v0 for AR5
  1540. ! 1 Dec 2011 - Narcisa Banda - added EDGAR 4.1 and 4.2
  1541. ! 20 Nov 2012 - Ph. Le Sager - build lists of used providers
  1542. ! 29 Nov 2014 - Jason Williams - Introduced yearly specific biogenic emissions
  1543. !
  1544. ! !REMARKS:
  1545. !
  1546. !EOP
  1547. !------------------------------------------------------------------------
  1548. !BOC
  1549. character(len=*), parameter :: rname=mname//'/emission_read_init'
  1550. integer :: isect, iprov, nused, region
  1551. logical :: mask(numb_providers), LEDGARCH4
  1552. ! --- begin --------------------------------------
  1553. if (LCMIP6) then
  1554. ! The SSP scenario data are provided for the years 2015-2100.
  1555. ! However, when running December 2014,
  1556. ! the zonal mean surface methane field for January 2015 is already needed.
  1557. ! For that reason, we set the default to 'SSP3-7.0'
  1558. ! when the scenario name is not provided.
  1559. ! This is consistent with the treatment for ozone,
  1560. ! for which the last entry of the 2014 input file
  1561. ! also corresponds to SSP3-7.0.
  1562. ! Note however that the difference in ozone and methane
  1563. ! between SSP3-7.0 and SSP3-lowNTCF in January 2015
  1564. ! are negligibly small.
  1565. call ReadRc( rcF, 'input.CMIP6.SSP', ssp_name, status, default = 'SSP3-7.0' )
  1566. IF_ERROR_RETURN(status=1)
  1567. if (trim(ssp_name) == 'SSP3-lowNTCF') then
  1568. write(gol,*) 'ERROR - SSP3-lowNTCF is not part of AerChemMIP. You should use the' ; call goPr
  1569. write(gol,*) 'ERROR - input.CMIP6.SSP370_LowNTCF.* keys to activate AerChemMIP' ; call goPr
  1570. write(gol,*) 'ERROR - lowNTCF experiments.' ; call goPr
  1571. write(gol,*) 'ERROR - Uncomment this trap if you really want to use the general' ; call goPr
  1572. write(gol,*) 'ERROR - SSP3-lowNTCF scenario' ; call goPr
  1573. write(gol,*) 'Returning...' ; call goErr
  1574. status=1; TRACEBACK; return
  1575. endif
  1576. write(gol,'("SSP CMIP6 future scenario for emissions: ",a)') trim(ssp_name); call goPr
  1577. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.ntcf', LSSP370_LowNTCF, status, default=.FALSE. )
  1578. IF_ERROR_RETURN(status=1)
  1579. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.aer', LSSP370_LowAer, status, default=LSSP370_LowNTCF )
  1580. IF_ERROR_RETURN(status=1)
  1581. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.bc', LSSP370_LowBC, status, default=LSSP370_LowAer )
  1582. IF_ERROR_RETURN(status=1)
  1583. IF (LSSP370_LowBC) THEN
  1584. write(gol,'("... with SSP370-lowNTCF emissions for BC")'); call goPr
  1585. ENDIF
  1586. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.oc', LSSP370_LowOC, status, default=LSSP370_LowAer )
  1587. IF_ERROR_RETURN(status=1)
  1588. IF (LSSP370_LowOC) THEN
  1589. write(gol,'("... with SSP370-lowNTCF emissions for OC")'); call goPr
  1590. ENDIF
  1591. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.sox', LSSP370_LowSOx, status, default=LSSP370_LowAer )
  1592. IF_ERROR_RETURN(status=1)
  1593. IF (LSSP370_LowSOx) THEN
  1594. write(gol,'("... with SSP370-lowNTCF emissions for SOx")'); call goPr
  1595. ENDIF
  1596. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.nh3', LSSP370_LowNH3, status, default=LSSP370_LowAer )
  1597. IF_ERROR_RETURN(status=1)
  1598. IF (LSSP370_LowNH3) THEN
  1599. write(gol,'("... with SSP370-lowNTCF emissions for NH3")'); call goPr
  1600. ENDIF
  1601. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.o3', LSSP370_LowO3, status, default=LSSP370_LowNTCF )
  1602. IF_ERROR_RETURN(status=1)
  1603. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.nox', LSSP370_LowNOx, status, default=LSSP370_LowO3 )
  1604. IF_ERROR_RETURN(status=1)
  1605. IF (LSSP370_LowNOx) THEN
  1606. write(gol,'("... with SSP370-lowNTCF emissions for NOx")'); call goPr
  1607. ENDIF
  1608. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.co', LSSP370_LowCO, status, default=LSSP370_LowO3 )
  1609. IF_ERROR_RETURN(status=1)
  1610. IF (LSSP370_LowCO) THEN
  1611. write(gol,'("... with SSP370-lowNTCF emissions for CO")'); call goPr
  1612. ENDIF
  1613. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.nmvoc', LSSP370_LowNMVOC, status, default=LSSP370_LowO3 )
  1614. IF_ERROR_RETURN(status=1)
  1615. IF (LSSP370_LowNMVOC) THEN
  1616. write(gol,'("... with SSP370-lowNTCF emissions for NMVOCs")'); call goPr
  1617. ENDIF
  1618. call ReadRc( rcF, 'input.CMIP6.SSP370_LowNTCF.ch4', LSSP370_LowCH4, status, default=.FALSE. )
  1619. IF_ERROR_RETURN(status=1)
  1620. IF (LSSP370_LowCH4) THEN
  1621. write(gol,'("... with SSP370-lowNTCF emissions for CH4")'); call goPr
  1622. ENDIF
  1623. else if (LAR5) then
  1624. call ReadRc( rcF, 'input.emis.AR5.RCP', filestr_rcpiden, status )
  1625. IF_ERROR_RETURN(status=1)
  1626. endif
  1627. ! ------------------
  1628. ! build list of used providers
  1629. ! ------------------
  1630. ! LMACCITY does not provide anthropogenic CH4, then use EDGAR instead
  1631. if (LMACCITY) then
  1632. LEDGARCH4=.true.
  1633. else
  1634. LEDGARCH4=LEDGAR4
  1635. end if
  1636. ! CH4 (any inventory, but skip MACC and MEGAN since they have no CH4)
  1637. mask = (/ LCMIP6, LCMIP6BMB, LRETROF, LAR5, .false., LEDGARCH4, LEDGARCH4, LLPJ, LHYMN, LGFED3, .false. /)
  1638. nused = count(mask)
  1639. if (nused /= 0) then
  1640. allocate( used_providers_ch4(nused) )
  1641. used_providers_ch4 = pack( all_providers, mask)
  1642. else
  1643. has_ch4_emis = .false.
  1644. end if
  1645. ! ISOPRENE/TERPENES (anything except EDGAR, LPJ and HYMN; CMIP6/AR5 : only if fires requested)
  1646. mask = (/ .false., LCMIP6BMB, LRETROF, LAR5BMB, LMACC, .false., .false., .false., .false., LGFED3, LMEGAN /)
  1647. nused = count(mask)
  1648. if (nused /= 0) then
  1649. allocate( used_providers_isop(nused) )
  1650. used_providers_isop = pack( all_providers, mask)
  1651. allocate( used_providers_terp(nused) )
  1652. used_providers_terp = pack( all_providers, mask)
  1653. else
  1654. has_isop_emis = .false.
  1655. has_terp_emis = .false.
  1656. end if
  1657. ! Others gases (anything except LPJ and HYMN)
  1658. mask = (/ LCMIP6, LCMIP6BMB, LRETROF, LAR5, LMACC, LEDGAR4, LEDGAR4, .false., .false., LGFED3, LMEGAN /)
  1659. nused = count(mask)
  1660. if (nused /= 0) then
  1661. allocate( used_providers(nused) )
  1662. used_providers = pack( all_providers, mask)
  1663. else
  1664. has_emis = .false.
  1665. end if
  1666. ! BC and POM (anything except EDGAR, LPJ, HYMN and MEGAN)
  1667. mask = (/ LCMIP6, LCMIP6BMB, LRETROF, LAR5, LMACC, .false., .false., .false., .false., LGFED3, .false. /)
  1668. nused = count(mask)
  1669. if (nused /= 0) then
  1670. allocate( used_providers_aer(nused) )
  1671. used_providers_aer = pack( all_providers, mask)
  1672. else
  1673. has_aer_emis = .false.
  1674. end if
  1675. ! info
  1676. if (has_isop_emis) then
  1677. write(gol,*) 'EMISS-INFO - Emissions providers used for ISOP : ', used_providers_isop ; call goPr
  1678. else
  1679. write(gol,*) 'EMISS-INFO - Emissions providers used for ISOP : NONE' ; call goPr
  1680. end if
  1681. if (has_terp_emis) then
  1682. write(gol,*) 'EMISS-INFO - Emissions providers used for TERP : ', used_providers_terp ; call goPr
  1683. else
  1684. write(gol,*) 'EMISS-INFO - Emissions providers used for TERP : NONE' ; call goPr
  1685. end if
  1686. if ( has_ch4_emis ) then
  1687. write(gol,*) 'EMISS-INFO - Emissions providers used for CH4 : ', used_providers_ch4 ; call goPr
  1688. else
  1689. write(gol,*) 'EMISS-INFO - Emissions providers used for CH4 : NONE' ; call goPr
  1690. end if
  1691. if ( has_aer_emis ) then
  1692. write(gol,*) 'EMISS-INFO - Emissions providers used for BC/POM : ', used_providers_aer ; call goPr
  1693. else
  1694. write(gol,*) 'EMISS-INFO - Emissions providers used for BC/POM : NONE' ; call goPr
  1695. end if
  1696. if ( has_emis ) then
  1697. write(gol,*) 'EMISS-INFO - Emissions providers used for others : ', used_providers ; call goPr
  1698. else
  1699. write(gol,*) 'EMISS-INFO - Emissions providers used for others : NONE' ; call goPr
  1700. end if
  1701. ! ------------------
  1702. ! initialise sectors
  1703. ! ------------------
  1704. ! Type sequence is (name, category, is_3D_data, vdisttype, providers)
  1705. sectors_def( 1) = sector_type('emiss_ene ', 'anthropogenic ', .false., 'combenergy ', 'AR5 ', NULL() ) ! Energy production & distribution
  1706. sectors_def( 2) = sector_type('emiss_dom ', 'anthropogenic ', .false., 'combrescom ', 'AR5 ', NULL() ) ! Residential and commercial combustion
  1707. sectors_def( 3) = sector_type('emiss_ind ', 'anthropogenic ', .false., 'industry ', 'AR5 ', NULL() ) ! Industrial processes and combustion
  1708. sectors_def( 4) = sector_type('emiss_wst ', 'anthropogenic ', .false., 'waste ', 'AR5 ', NULL() ) ! Waste treatment and disposal
  1709. sectors_def( 5) = sector_type('emiss_agr ', 'anthropogenic ', .false., 'surface ', 'AR5 ', NULL() ) ! Agriculture
  1710. sectors_def( 6) = sector_type('emiss_awb ', 'anthropogenic ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Agricultural waste burning
  1711. sectors_def( 7) = sector_type('emiss_slv ', 'anthropogenic ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Solvent production and use
  1712. sectors_def( 8) = sector_type('emiss_tra ', 'anthropogenic ', .false., 'surface ', 'AR5 ', NULL() ) ! Land transport
  1713. sectors_def( 9) = sector_type('emiss_shp ', 'ships ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Ships
  1714. sectors_def(10) = sector_type('emiss_air ', 'aircraft ', .true. , 'aircraft ', 'AR5 ', NULL() ) ! Aircraft
  1715. sectors_def(11) = sector_type('grassfire ', 'biomassburning', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Grassland Fire
  1716. sectors_def(12) = sector_type('forestfire', 'biomassburning', .false., 'forestfire ', 'AR5 ', NULL() ) ! Forest Fire
  1717. ! macc sectors (-> natural, missing in AR5 and EDGAR )
  1718. sectors_def(13) = sector_type('emiss_soil', 'natural ', .false., 'surface ', 'MACC ', NULL() ) ! Natural sources (soil) - only for NO and NH3
  1719. sectors_def(14) = sector_type('emiss_oc ', 'natural ', .false., 'surface ', 'MACC ', NULL() ) ! Natural sources (ocean)
  1720. sectors_def(15) = sector_type('emiss_bio ', 'natural ', .false., 'surface ', 'MACC ', NULL() ) ! Natural sources (biogenic)
  1721. sectors_def(16) = sector_type('emiss_nat ', 'natural ', .false., 'volcanic ', 'MACC ', NULL() ) ! Natural sources (volcanic)
  1722. if (LMACCITY) then
  1723. sectors_def(70) = sector_type('emiss_anthro', 'anthropogenic ', .false., 'combrescom ', 'MACC ', NULL() ) ! Anthropogenic (MACCITY only)
  1724. sectors_def(71) = sector_type('emiss_air ', 'aircraft ', .true. , 'aircraft ', 'MACC ', NULL() ) ! Aircraft (MACCITY only)
  1725. else
  1726. sectors_def(70) = sector_type('emiss_anthro', 'anthropogenic ', .false., 'combrescom ', 'DUMMY ', NULL() ) ! Off if MACC only to provide natural emissions
  1727. sectors_def(71) = sector_type('emiss_air ', 'aircraft ', .true. , 'aircraft ', 'DUMMY ', NULL() ) !
  1728. end if
  1729. ! MEGAN emissions from MACC
  1730. sectors_def(72) = sector_type('MEGAN_MACC ', 'natural ', .false., 'surface ', 'MEGAN ', NULL())! Natural sources (soil)
  1731. ! edgar 4.1 sectors
  1732. sectors_def(17) = sector_type('1A1_ENE ', 'anthropogenic ', .false., 'combenergy ', 'ED41 ', NULL()) ! Energy production & distribution
  1733. sectors_def(18) = sector_type('1A2_2 ', 'anthropogenic ', .false., 'industry ', 'ED41 ', NULL()) ! Industrial processes and combustion
  1734. sectors_def(19) = sector_type('1A3b_c_e ', 'anthropogenic ', .false., 'surface ', 'ED41 ', NULL()) ! Land transport
  1735. sectors_def(20) = sector_type('1A3a ', 'aircraft ', .true. , 'aircraft ', 'ED41 ', NULL()) ! Aircraft
  1736. sectors_def(21) = sector_type('1A3d_SHIP ', 'ships ', .false., 'nearsurface ', 'ED41 ', NULL()) ! Ships domestic
  1737. sectors_def(22) = sector_type('1A3d1 ', 'ships ', .false., 'nearsurface ', 'ED41 ', NULL()) ! Ships international
  1738. sectors_def(23) = sector_type('1A4_5 ', 'anthropogenic ', .false., 'combrescom ', 'ED41 ', NULL()) ! Residential and commercial combustion
  1739. sectors_def(24) = sector_type('1B ', 'anthropogenic ', .false., 'combenergy ', 'ED41 ', NULL()) ! Fugitive emissions
  1740. sectors_def(25) = sector_type('3 ', 'anthropogenic ', .false., 'nearsurface ', 'ED41 ', NULL()) ! Solvent emissions
  1741. sectors_def(26) = sector_type('4_but_4E ', 'anthropogenic ', .false., 'surface ', 'ED41 ', NULL()) ! Agriculture (soils, waste burning, livestock)
  1742. sectors_def(27) = sector_type('6A_6C ', 'anthropogenic ', .false., 'waste ', 'ED41 ', NULL()) ! Waste disposal and incineration
  1743. sectors_def(28) = sector_type('7 ', 'anthropogenic ', .false., 'waste ', 'ED41 ', NULL()) ! Fossil fuel fires
  1744. ! edgar 4.2 sectors
  1745. sectors_def(29) = sector_type('1A1a ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy production
  1746. 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)
  1747. 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)
  1748. 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)
  1749. sectors_def(33) = sector_type('1A1b_c ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Energy production
  1750. 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)
  1751. sectors_def(35) = sector_type('1A2 ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Combustion in manufacturing industry
  1752. sectors_def(36) = sector_type('1A3 ', 'anthropogenic ', .false. , 'nearsurface', 'ED42 ', NULL()) ! Transport (including ships, aircraft!)
  1753. sectors_def(37) = sector_type('1A3a_c_d_e', 'anthropogenic ', .false. , 'nearsurface', 'ED42 ', NULL()) ! Non-road transport (including ships, aircraft!)
  1754. sectors_def(38) = sector_type('1A3b ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Road transport
  1755. sectors_def(39) = sector_type('1A4 ', 'anthropogenic ', .false., 'combrescom ', 'ED42 ', NULL()) ! Residential
  1756. sectors_def(40) = sector_type('1B1 ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive emissions
  1757. sectors_def(41) = sector_type('1B1_1B2_1A1b_c', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive and energy emissions
  1758. sectors_def(42) = sector_type('1B2a ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive emissions
  1759. sectors_def(43) = sector_type('1B2b ', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive emissions
  1760. sectors_def(44) = sector_type('1B2a_c_1A1b_c', 'anthropogenic ', .false., 'combenergy ', 'ED42 ', NULL()) ! Fugitive and energy emissions
  1761. sectors_def(45) = sector_type('2A_B_D_E_F_G', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions
  1762. sectors_def(46) = sector_type('2 ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions
  1763. sectors_def(47) = sector_type('2A ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions
  1764. sectors_def(48) = sector_type('2A_2B_2D ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions
  1765. sectors_def(49) = sector_type('2B ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions
  1766. sectors_def(50) = sector_type('2C ', 'anthropogenic ', .false., 'industry ', 'ED42 ', NULL()) ! Industry emissions
  1767. sectors_def(51) = sector_type('3 ', 'anthropogenic ', .false., 'nearsurface ', 'ED42 ', NULL()) ! Solvent emissions
  1768. sectors_def(52) = sector_type('4A ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agriculture
  1769. sectors_def(53) = sector_type('4B ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agriculture
  1770. sectors_def(54) = sector_type('4C_4D ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agriculture
  1771. sectors_def(55) = sector_type('4F ', 'anthropogenic ', .false., 'surface ', 'ED42 ', NULL()) ! Agricultural waste burning
  1772. sectors_def(56) = sector_type('6A_6C ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Waste disposal and incineration
  1773. sectors_def(57) = sector_type('6B ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Waste disposal and incineration
  1774. sectors_def(58) = sector_type('7 ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Fossil fuel fires
  1775. sectors_def(59) = sector_type('7A ', 'anthropogenic ', .false., 'waste ', 'ED42 ', NULL()) ! Fossil fuel fires
  1776. sectors_def(60) = sector_type('5A_C_D_F_4E', 'biomassburning', .false., 'forestfire ', 'ED42 ', NULL()) ! Large scale biomass burning
  1777. ! natural methane emissions LPJ and HYMN project
  1778. sectors_def(61) = sector_type('wetlands ', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane from wetlands
  1779. sectors_def(62) = sector_type('peatlands ', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane from peatlands
  1780. sectors_def(63) = sector_type('wetsoils ', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane from wet soils
  1781. sectors_def(64) = sector_type('soilconsumption', 'natural ', .false., 'surface ', 'LPJ ',NULL()) ! Methane soil uptake
  1782. sectors_def(65) = sector_type('oceans ', 'natural ', .false., 'surface ', 'HYMN ',NULL()) ! Methane ocean emissions
  1783. sectors_def(66) = sector_type('wildanimals', 'natural ', .false., 'surface ', 'HYMN ',NULL()) ! Methane emissions from wild animals
  1784. sectors_def(67) = sector_type('termites ', 'natural ', .false., 'surface ', 'HYMN ',NULL()) ! Methane ternite emissions
  1785. ! Biomass burning GFEDv3 monthly
  1786. sectors_def(68) = sector_type('wildfires ', 'biomassburning', .false., 'forestfire ', 'GFEDv3 ', NULL())
  1787. ! Biomass burning RETRO
  1788. sectors_def(69) = sector_type('fire_emis ', 'biomassburning', .false., 'forestfire ', 'RETRO ',NULL())
  1789. ! CMIP6
  1790. sectors_def(73) = sector_type('ENE ', 'anthropogenic ', .false., 'combenergy ', 'CMIP6 ', NULL() ) ! Energy sector
  1791. sectors_def(74) = sector_type('RCO ', 'anthropogenic ', .false., 'combrescom ', 'CMIP6 ', NULL() ) ! Residential, commercial and other
  1792. sectors_def(75) = sector_type('IND ', 'anthropogenic ', .false., 'industry ', 'CMIP6 ', NULL() ) ! Industrial sector
  1793. sectors_def(76) = sector_type('WST ', 'anthropogenic ', .false., 'waste ', 'CMIP6 ', NULL() ) ! Waste treatment and disposal
  1794. sectors_def(77) = sector_type('AGR ', 'anthropogenic ', .false., 'surface ', 'CMIP6 ', NULL() ) ! Agriculture (excl. agricultural waste burning, which is included in CMIP6 biomass burning emissions)
  1795. sectors_def(78) = sector_type('SLV ', 'anthropogenic ', .false., 'nearsurface ', 'CMIP6 ', NULL() ) ! Solvents production and application
  1796. sectors_def(79) = sector_type('TRA ', 'anthropogenic ', .false., 'surface ', 'CMIP6 ', NULL() ) ! Transportation sector (land)
  1797. sectors_def(80) = sector_type('SHP ', 'ships ', .false., 'nearsurface ', 'CMIP6 ', NULL() ) ! International shipping
  1798. sectors_def(81) = sector_type('AIR ', 'aircraft ', .true. , 'aircraft ', 'CMIP6 ', NULL() ) ! Aircraft
  1799. ! CMIP6BMB
  1800. sectors_def(82) = sector_type('wildfires ', 'biomassburning', .false., 'forestfire ', 'CMIP6BMB', NULL() ) ! Forest and grassland fires; the latter were assumed 'nearsurface' in AR5
  1801. ! -------------------------
  1802. ! info per species
  1803. ! ------------------------
  1804. ! ED42 sectors are not available for all species, so we define a sectors list per species.
  1805. !! These are the "ALL AVAILABLE". Kept for reference.
  1806. !ed42_co_sectors = (/'1A1a_6 ', '1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ', &
  1807. ! '1B2a_c_1A1b_c', '2A_2B_2D ', '2C ', '4F ', '5A_C_D_F_4E ', '7A ' /)
  1808. !
  1809. !ed42_ch4_sectors = (/'1A1_1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ', '1B1 ', '1B2a ', &
  1810. ! '1B2b ', '2 ', '4A ', '4B ', '4C_4D ', '4F ', &
  1811. ! '5A_C_D_F_4E', '6A_6C ', '6B ', '7A '/)
  1812. !
  1813. !ed42_nox_sectors = (/'1A1a ', '1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ',&
  1814. ! '1B2a_c_1A1b_c', '2 ', '4B ', '4C_4D ', '4F ',&
  1815. ! '5A_C_D_F_4E ', '6A_6C ', '7A ' /)
  1816. !
  1817. !ed42_hc_sectors = (/'1A1a ', '1A1b_c_1B_2C1_2C2', '1A2 ', '1A3a_c_d_e ', &
  1818. ! '1A3b ', '1A4 ', '2A_B_D_E_F_G ', '3 ', &
  1819. ! '4F ', '5A_C_D_F_4E ', '6A_6C ', '7A ' /)
  1820. !
  1821. !ed42_nh3_sectors = (/'1A1a_6 ', '1A1b_c ', '1A2 ', '1A3 ', '1A4 ', '2A ',&
  1822. ! '2B ', '4B ', '4C_4D ', '4F ', '5A_C_D_F_4E' /)
  1823. !
  1824. !ed42_so2_sectors = (/'1A1a_6C ', '1A2 ', '1A3a_c_d_e ', '1A3b ', '1A4 ',&
  1825. ! '1B1_1B2_1A1b_c', '2B_2D ', '2C ', '4F ', '5A_C_D_F_4E ', '7A '/)
  1826. ! Use only non-transport sectors (they are provided by ED41), and remove biomassburning:
  1827. ed42_co_sectors = (/ '1A1a_6 ', '1A2 ', '1A4 ', '1B2a_c_1A1b_c ', &
  1828. '2A_2B_2D ', '2C ', '4F ', '7A ' /)
  1829. ed42_ch4_sectors = (/'1A1_1A2 ', '1A4 ', '1B1 ', '1B2a ', &
  1830. '1B2b ', '2 ', '4A ', '4B ', &
  1831. '4C_4D ', '4F ', '6A_6C ', '6B ', &
  1832. '7A '/)
  1833. ed42_nox_sectors = (/'1A1a ', '1A2 ', '1A4 ', '1B2a_c_1A1b_c ', &
  1834. '2 ', '4B ', '4C_4D ', '4F ', &
  1835. '6A_6C ', '7A ' /)
  1836. ! Note that '5A_C_D_F_4E' is not only fire, but it is available only for the NMVOC species
  1837. ! which we do not use (instead we loop through emis_ar5_nvoc constituents) anyway
  1838. ed42_hc_sectors = (/'1A1a ', '1A1b_c_1B_2C1_2C2 ', '1A2 ', '1A4 ', &
  1839. '2A_B_D_E_F_G ', '3 ', '4F ', '6A_6C ', &
  1840. '7A ' /)
  1841. ed42_nh3_sectors = (/'1A1a_6 ', '1A1b_c ', '1A2 ', '1A4 ', &
  1842. '2A ', '2B ', '4B ', '4C_4D ', &
  1843. '4F ' /)
  1844. ed42_so2_sectors = (/'1A1a_6C ', '1A2 ', '1A4 ', '1B1_1B2_1A1b_c ', &
  1845. '2B_2D ', '2C ', '4F ', '7A '/)
  1846. ! ED41 sectors are used only for the transport sector - the screening is
  1847. ! coded in the *declare routines of each emission_*.F90 according to
  1848. ! sector name. It boils down to four cases:
  1849. !
  1850. ! (/'1A3a', '1A3b_c_e', '1A3d1', '1A3d_SHIP'/) : NOx
  1851. ! (/'1A3b_c_e', '1A3d1', '1A3d_SHIP'/) : some NMVOC, CO, CH4, SOx
  1852. ! (/'1A3b_c_e'/) : some NMVOC, NH3
  1853. ! NONE : some NMVOC
  1854. ! AR5
  1855. sectors_def( 1)%species => ar5_cat_ant_ene_ind
  1856. sectors_def( 2)%species => ar5_cat_ant_dom
  1857. sectors_def( 3)%species => ar5_cat_ant_ene_ind
  1858. sectors_def( 4)%species => ar5_cat_ant
  1859. sectors_def( 5)%species => ar5_cat_ant_agr
  1860. sectors_def( 6)%species => ar5_cat_ant_awb
  1861. sectors_def( 7)%species => ar5_cat_ant_slv
  1862. sectors_def( 8)%species => ar5_cat_ant_tra
  1863. sectors_def( 9)%species => ar5_cat_shp
  1864. sectors_def(10)%species => ar5_cat_air
  1865. sectors_def(11)%species => ar5_cat_bmb
  1866. sectors_def(12)%species => ar5_cat_bmb
  1867. n_ar5_ant_sec=8 ! hardcoded but could be counted
  1868. n_ar5_shp_sec=1
  1869. n_ar5_air_sec=1
  1870. n_ar5_bmb_sec=2
  1871. ! -------------------------
  1872. ! initialise providers info
  1873. ! ------------------------
  1874. do iprov = 1, numb_providers
  1875. providers_def(iprov)%name = all_providers(iprov)
  1876. providers_def(iprov)%nsect2d = count( (sectors_def%prov == all_providers(iprov)) .and. (sectors_def%f3d .eqv. .false.))
  1877. providers_def(iprov)%nsect3d = count( (sectors_def%prov == all_providers(iprov)) .and. (sectors_def%f3d .eqv. .true.))
  1878. if(okdebug) then
  1879. write(gol,'("EMISS-INFO - Inventory ",a," has ",i3, " 2d-sectors, and ",i3," 3d-sectors")')&
  1880. & all_providers(iprov), providers_def(iprov)%nsect2d, providers_def(iprov)%nsect3d ; call goPr
  1881. endif
  1882. end do
  1883. ! -------------------------
  1884. ! initialise GeopPotential Height on 1x1
  1885. ! ------------------------
  1886. do region=1, nregions
  1887. call Set( gph_dat(region), status, used=.true. )
  1888. end do
  1889. ! ----------------------------------------
  1890. ! allocate gridbox_area arrays
  1891. ! ----------------------------------------
  1892. allocate( gridbox_area_025( nlon1440, nlat720 ) )
  1893. allocate( gridbox_area_05 ( nlon720 , nlat360 ) )
  1894. #ifdef with_ch4_emis
  1895. allocate( lpj_gridbox_area ( lpj_dim_nlon, lpj_dim_nlat ) )
  1896. allocate( lpj_frac_wetlands ( lpj_dim_nlon, lpj_dim_nlat, 12 ) )
  1897. allocate( lpj_frac_rice ( lpj_dim_nlon, lpj_dim_nlat, 12 ) )
  1898. allocate( lpj_frac_peatlands ( lpj_dim_nlon, lpj_dim_nlat ) )
  1899. #endif
  1900. ! OK
  1901. status = 0
  1902. END SUBROUTINE EMISSION_READ_INIT
  1903. !EOC
  1904. !--------------------------------------------------------------------------
  1905. ! TM5 !
  1906. !--------------------------------------------------------------------------
  1907. !BOP
  1908. !
  1909. ! !IROUTINE: EMISSION_READ_DONE
  1910. !
  1911. ! !DESCRIPTION: Free allocated arrays.
  1912. !\\
  1913. !\\
  1914. ! !INTERFACE:
  1915. !
  1916. subroutine emission_read_done( status )
  1917. !
  1918. ! !OUTPUT PARAMETERS:
  1919. !
  1920. integer, intent(out) :: status
  1921. !
  1922. ! !REVISION HISTORY:
  1923. ! 1 Oct 2010 - Achim Strunk - v0
  1924. !
  1925. !EOP
  1926. !------------------------------------------------------------------------
  1927. !BOC
  1928. character(len=*), parameter :: rname=mname//'/emission_read_done'
  1929. deallocate( gridbox_area_025 )
  1930. deallocate( gridbox_area_05 )
  1931. #ifdef with_ch4_emis
  1932. deallocate( lpj_gridbox_area )
  1933. deallocate( lpj_frac_wetlands )
  1934. deallocate( lpj_frac_rice )
  1935. deallocate( lpj_frac_peatlands )
  1936. #endif
  1937. if (allocated( used_providers )) deallocate( used_providers )
  1938. if (allocated( used_providers_ch4 )) deallocate( used_providers_ch4 )
  1939. if (allocated( used_providers_isop)) deallocate( used_providers_isop )
  1940. if (allocated( used_providers_terp)) deallocate( used_providers_terp )
  1941. if (allocated( used_providers_aer )) deallocate( used_providers_aer )
  1942. ! OK
  1943. status = 0
  1944. END SUBROUTINE EMISSION_READ_DONE
  1945. !EOC
  1946. !--------------------------------------------------------------------------
  1947. ! TM5 !
  1948. !--------------------------------------------------------------------------
  1949. !BOP
  1950. !
  1951. ! !FUNCTION: EMISSION_COARSEN_TO_1X1
  1952. !
  1953. ! !DESCRIPTION: Coarsen the gridded information to 1x1 deg.
  1954. ! (taken from GEMS/MACC repository)
  1955. !\\
  1956. !\\
  1957. ! !INTERFACE:
  1958. !
  1959. function emission_coarsen_to_1x1( emis_in, dim_nlon, dim_nlat, shift_lon, status )
  1960. !
  1961. ! !RETURN VALUE:
  1962. !
  1963. real, dimension(360,180) :: emission_coarsen_to_1x1
  1964. !
  1965. ! !INPUT PARAMETERS:
  1966. !
  1967. integer, intent(in) :: dim_nlon
  1968. integer, intent(in) :: dim_nlat
  1969. real, intent(in) :: emis_in(dim_nlon, dim_nlat)
  1970. logical, intent(in) :: shift_lon
  1971. !
  1972. ! OUTPUT PARAMETERS:
  1973. !
  1974. integer , intent(out) :: status
  1975. !
  1976. ! !REVISION HISTORY:
  1977. ! 1 Oct 2010 - Achim Strunk - v0 for AR5
  1978. ! 1 Dec 2011 - Narcisa Banda - works for any input resolution lower than 1x1
  1979. ! if 1x1 can be divided into exact number of gridcells (no interpolation)
  1980. ! 1 Jul 2012 - Narcisa Banda - added the shift_lon logical flag:
  1981. ! true if the data is read on longitudes [0,360] (then they need to be shifted on [-180,180])
  1982. ! false if the data is read already on [-180,180]
  1983. !
  1984. !EOP
  1985. !------------------------------------------------------------------------
  1986. !BOC
  1987. integer :: i, j
  1988. integer :: nri, nrj
  1989. ! --- begin -----------------------------------
  1990. ! combine grid cells :
  1991. ! from [ 0,360]x[-90,90] 001:360,361:720 001:360
  1992. ! to [-180,180]x[-90,90] 001:180,181:360 001:180
  1993. if ((mod(dim_nlon, 360) /= 0 ) .or. (mod(dim_nlat, 180) /= 0)) then
  1994. write(gol,*) 'coarsening of emissions to 1x1 does not work for this resolution' ; call goErr
  1995. status = 1
  1996. return
  1997. endif
  1998. nri = dim_nlon/360
  1999. nrj = dim_nlat/180
  2000. if (shift_lon) then
  2001. ! combine grid cells :
  2002. ! from [ 0,360]x[-90,90] 001:360,361:720 001:360
  2003. ! to [-180,180]x[-90,90] 001:180,181:360 001:180
  2004. do j = 1, 180
  2005. ! west half
  2006. do i = 1, 180
  2007. 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))
  2008. end do
  2009. ! east half
  2010. do i = 1, 180
  2011. emission_coarsen_to_1x1(180+i,j) = sum(emis_in(nri*i-nri+1:nri*i,nrj*j-nrj+1:nrj*j))
  2012. end do
  2013. end do
  2014. else
  2015. do j=1, 180
  2016. do i=1, 360
  2017. emission_coarsen_to_1x1(i,j) = sum(emis_in(nri*i-nri+1:nri*i,nrj*j-nrj+1:nrj*j))
  2018. end do
  2019. end do
  2020. endif
  2021. ! ok
  2022. status = 0
  2023. end function emission_coarsen_to_1x1
  2024. !EOC
  2025. !--------------------------------------------------------------------------
  2026. ! TM5 !
  2027. !--------------------------------------------------------------------------
  2028. !BOP
  2029. !
  2030. ! !FUNCTION: VALID_YEAR
  2031. !
  2032. ! !DESCRIPTION: return a valid year for an emission inventory, based on
  2033. ! requested year.
  2034. !\\
  2035. !\\
  2036. ! !INTERFACE:
  2037. !
  2038. FUNCTION VALID_YEAR( iyear, iminmax, provider_name, verbose)
  2039. !
  2040. ! !RETURN VALUE:
  2041. !
  2042. integer :: valid_year
  2043. !
  2044. ! !INPUT PARAMETERS:
  2045. !
  2046. integer, intent(in) :: iyear, iminmax(2)
  2047. character(len=*), intent(in) :: provider_name
  2048. logical, intent(in) :: verbose
  2049. !
  2050. ! !REVISION HISTORY:
  2051. ! 26 Nov 2012 - Ph. Le Sager - v0
  2052. !
  2053. !EOP
  2054. !------------------------------------------------------------------------
  2055. !BOC
  2056. valid_year = MIN(iminmax(2),MAX(iyear,iminmax(1)))
  2057. ! info only once a year, and per inventory
  2058. if (verbose) then
  2059. write(gol,'(a,i4," (avail: ",i4,"-",i4,")")') ' EMISS-INFO - EMISS YEAR for '//trim(provider_name)//' : ', &
  2060. valid_year, iminmax ; call goPr
  2061. end if
  2062. END FUNCTION VALID_YEAR
  2063. !EOC
  2064. !--------------------------------------------------------------------------
  2065. ! TM5 !
  2066. !--------------------------------------------------------------------------
  2067. !BOP
  2068. !
  2069. ! !IROUTINE: EMISSION_CMIP6_READSECTOR
  2070. !
  2071. ! !DESCRIPTION: Reading one sector of the files for the requested month and
  2072. ! returning an interpolated 3d emission field (d3data)
  2073. ! and, for the CMIP6 2-D sectors, an interpolated 2d field
  2074. ! containing emissions from solid biofuel combustion (d2data_bf).
  2075. !\\
  2076. !\\
  2077. ! !INTERFACE:
  2078. !
  2079. subroutine emission_cmip6_ReadSector( comp, iyear, imonth, sector, d3data, status, d2data_bf )
  2080. !
  2081. use dims , only : icalendo
  2082. !
  2083. ! !INPUT PARAMETERS:
  2084. !
  2085. character(len=*) , intent(in) :: comp
  2086. integer , intent(in) :: iyear
  2087. integer , intent(in) :: imonth
  2088. integer , intent(in) :: sector
  2089. !
  2090. ! !OUTPUT PARAMETERS:
  2091. !
  2092. integer , intent(out) :: status
  2093. real, dimension(nlon360,nlat180,ar5_dim_3ddata), intent(out) :: d3data
  2094. real, dimension(nlon360,nlat180), intent(out), optional :: d2data_bf
  2095. !
  2096. !EOP
  2097. !------------------------------------------------------------------------
  2098. !BOC
  2099. character(len=*), parameter :: rname = mname//'/emission_cmip6_readsector'
  2100. character(len=256) :: fname
  2101. character(len=256) :: fname_gridboxarea
  2102. character(len=256) :: varfilename, varname, secname
  2103. integer :: lt, year, startyear
  2104. character(len=25) :: sec_str, sec_str2
  2105. character(len=13) :: time_str
  2106. character(len=60) :: source_str
  2107. character(len=50) :: version_str
  2108. logical :: existfile
  2109. character(len=4) :: cyear
  2110. logical :: first=.true.
  2111. ! --- begin -----------------------------------
  2112. ! initialise target array
  2113. d3data = 0.0
  2114. if (present(d2data_bf)) d2data_bf = 0.0
  2115. ! read in gridbox-area; once per CPU
  2116. if( .not. area_found_05 ) then
  2117. fname_gridboxarea = trim(emis_input_dir_cmip6)//'/'//trim(cmip6_filestr_gridboxarea)
  2118. call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, &
  2119. & nlon720, nlat360, status )
  2120. IF_NOTOK_RETURN(status=1)
  2121. area_found_05=.true.
  2122. endif
  2123. ! deal with out-of-bounds requested years
  2124. year = valid_year( iyear, cmip6_avail, 'CMIP6', first)
  2125. first=.false.
  2126. if ( trim(sectors_def(sector)%catname) == 'aircraft' .and. year < 1920 ) then
  2127. ! CMIP6 aircraft emissions before 1920 are zero and not read anymore
  2128. d3data(:,:,:) = 0.
  2129. else
  2130. ! cyear will contain strings with the years
  2131. write(cyear,'(I4.4)') year
  2132. ! ------------------------
  2133. ! construct filename
  2134. ! e.g.: <emisdir>/NOx-em-AIR-anthro_input4MIPs_emissions_CMIP_CEDS-v2016-06-18_gr_175001-179912.nc
  2135. ! ------------------------
  2136. if ( index(comp,'CH4') /= 1 ) then
  2137. if (year >= 1750 .and. year < 1800) then
  2138. time_str='175001-179912'
  2139. startyear=1750
  2140. else if (year >= 1800 .and. year < 1850) then
  2141. time_str='180001-184912'
  2142. startyear=1800
  2143. else if (year >= 1850 .and. year < 1851) then
  2144. time_str='185001-185012'
  2145. startyear=1850
  2146. else if (year >= 1851 .and. year < 1900) then
  2147. time_str='185101-189912'
  2148. startyear=1851
  2149. else if (year >= 1900 .and. year < 1950) then
  2150. time_str='190001-194912'
  2151. startyear=1900
  2152. else if (year >= 1950 .and. year < 2000) then
  2153. time_str='195001-199912'
  2154. startyear=1950
  2155. else if (year >= 2000 .and. year < 2015) then
  2156. time_str='200001-201412'
  2157. startyear=2000
  2158. else if (year >= 2015 .and. year <= 2100) then
  2159. time_str='201501-210012'
  2160. startyear=2015
  2161. else
  2162. write (gol,'("CMIP6 emissions beyond 2100 not available")') ; call goErr
  2163. status=1; TRACEBACK; return
  2164. endif
  2165. if (year >= 1750 .and. year < 2015) then
  2166. if (trim(sectors_def(sector)%catname) == 'aircraft') then
  2167. if ( index(comp,'SO2') /= 1 ) then
  2168. version_str='2017-08-30'
  2169. else
  2170. ! SO2 aicraft emissions have had another update in Oct. 2017
  2171. version_str='2017-10-05'
  2172. endif
  2173. else
  2174. version_str='2017-05-18'
  2175. endif
  2176. else if (year >= 2015 .and. year <=2100) then
  2177. version_str='1-1'
  2178. else
  2179. write (gol,'("CMIP6 emissions beyond 2100 not available")') ; call goErr
  2180. status=1; TRACEBACK; return
  2181. endif
  2182. else
  2183. ! CH4
  2184. if (year >= 1750 .and. year < 1850) then
  2185. write (gol,'("WARNING - Anthropogenic emissions of CH4 not available prior to 1850")') ; call goPr
  2186. write (gol,'("WARNING - 1850 values are used")') ; call goPr
  2187. year = 1850
  2188. endif
  2189. if (year >= 1850 .and. year < 1970) then
  2190. time_str='185001-196012'
  2191. startyear=1850
  2192. version_str='2017-05-18-supplemental-data'
  2193. else if (year >= 1970 .and. year < 2015) then
  2194. time_str='197001-201412'
  2195. startyear=1970
  2196. version_str='2017-05-18'
  2197. else if (year >= 2015 .and. year <= 2100) then
  2198. time_str='201501-210012'
  2199. startyear=2015
  2200. version_str='1-1'
  2201. else
  2202. write (gol,'("CMIP6 emissions beyond 2100 not available")') ; call goErr
  2203. status=1; TRACEBACK; return
  2204. endif
  2205. endif
  2206. if (year <= 2014 ) then
  2207. source_str='input4MIPs_emissions_CMIP_CEDS'
  2208. else
  2209. select case(trim(ssp_name))
  2210. case ("SSP3-7.0")
  2211. source_str='input4MIPs_emissions_ScenarioMIP_IAMC-AIM-ssp370'
  2212. ! Use SSP370-LowNTCF for specific species
  2213. ! NMVOC component names differ for surface and aircraft emissions
  2214. if ( ((index(comp,'BC' ) ==1) .and. LSSP370_LowBC ) .or. &
  2215. ((index(comp,'OC' ) ==1) .and. LSSP370_LowOC ) .or. &
  2216. ((index(comp,'SO2' ) ==1) .and. LSSP370_LowSOx ) .or. &
  2217. ((index(comp,'NH3' ) ==1) .and. LSSP370_LowNH3 ) .or. &
  2218. ((index(comp,'NOx' ) ==1) .and. LSSP370_LowNOx ) .or. &
  2219. ((index(comp,'CO' ) ==1) .and. LSSP370_LowCO ) .or. &
  2220. ((index(comp,'VOC' ) ==1) .and. LSSP370_LowNMVOC) .or. &
  2221. ((index(comp,'NMVOC' ) ==1) .and. LSSP370_LowNMVOC) .or. &
  2222. ((index(comp,'CH4' ) ==1) .and. LSSP370_LowCH4 ) ) then
  2223. source_str='input4MIPs_emissions_AerChemMIP_IAMC-AIM-ssp370-lowNTCF'
  2224. endif
  2225. case ("SSP3-LowNTCF")
  2226. source_str='input4MIPs_emissions_AerChemMIP_IAMC-AIM-ssp370-lowNTCF'
  2227. case default
  2228. write (gol,'("Emissions not implemented for scenario: ", a)') trim(ssp_name); call goErr
  2229. status=1; TRACEBACK; return
  2230. end select
  2231. endif
  2232. if ( trim(sectors_def(sector)%catname) == 'anthropogenic' .or. &
  2233. trim(sectors_def(sector)%catname) == 'ships' ) then
  2234. if ( index(comp,'VOC') == 1 ) then
  2235. ! individual VOC species
  2236. sec_str='em-speciated-VOC-anthro'
  2237. sec_str2='em_speciated_VOC_anthro'
  2238. version_str=trim(version_str)//'-supplemental-data'
  2239. else
  2240. sec_str='em-anthro'
  2241. sec_str2='em_anthro'
  2242. endif
  2243. varname=trim(comp)//'_'//trim(sec_str2)
  2244. ! change dash to underscore in few cases
  2245. if ( index(varname, 'VOC') == 1 ) varname(6:6)= '_'
  2246. if ( index(varname, 'hexanes-pl') == 7 ) varname(7:16) = 'hexanes_pl'
  2247. if ( index(varname, 'other-') == 7 ) varname(7:12) = 'other_'
  2248. else if ( trim(sectors_def(sector)%catname) == 'aircraft' ) then
  2249. sec_str='em-AIR-anthro'
  2250. sec_str2='em_AIR_anthro'
  2251. varname=trim(comp)//'_'//trim(sec_str2)
  2252. else
  2253. write (gol,'("Invalid CMIP6 sector")') ; call goErr
  2254. status=1; TRACEBACK; return
  2255. endif
  2256. varfilename=trim(comp)//'-'//trim(sec_str)
  2257. ! For NO, the species name in the file name has to be set to NOx
  2258. fname = trim(emis_input_dir_cmip6) //'/'// &
  2259. trim(varfilename) //'_'// &
  2260. trim(source_str) //'-'// &
  2261. trim(version_str) //'_'// &
  2262. 'gn' //'_'// &
  2263. trim(time_str) // &
  2264. '.nc'
  2265. ! test existence of file
  2266. inquire( file=trim(fname), exist=existfile)
  2267. if( .not. existfile ) then
  2268. write (gol,'(" CMIP6 file `",a,"` not found ")') trim(fname); call goErr
  2269. status = 1; TRACEBACK; return
  2270. end if
  2271. ! ------------------------------------------------
  2272. ! data record is read by emission_cmip6_Read2/3DRecord
  2273. secname = sectors_def(sector)%name
  2274. ! distinguish 2d/3d sectors
  2275. if( sectors_def(sector)%f3d ) then
  2276. d3data(:,:,:) = emission_cmip6_Read3DRecord( fname, varname, secname, imonth, year, startyear, status )
  2277. else
  2278. d3data(:,:,1) = emission_cmip6_Read2DRecord( fname, varname, secname, imonth, year, startyear, status )
  2279. ! Read mass emitted by solid biofuel burning
  2280. ! for carbonaceous aerosol.
  2281. ! Reading of biofuel emissions is done for all 2-D sectors,
  2282. ! even though in CMIP6 there are only contributions for RCO, IND, ENE and TRA.
  2283. if (present(d2data_bf)) then
  2284. if ( (index(comp,'BC') /= 1) .and. (index(comp,'OC') /= 1) ) then
  2285. write (gol,'("Reading solid biofuel emissions only implemented for BC and OC")'); call goErr
  2286. status = 1; TRACEBACK; return
  2287. endif
  2288. sec_str='em-SOLID-BIOFUEL-anthro'
  2289. sec_str2='em_SOLID_BIOFUEL_anthro'
  2290. varname=trim(comp)//'_'//trim(sec_str2)
  2291. varfilename=trim(comp)//'-'//trim(sec_str)
  2292. fname = trim(emis_input_dir_cmip6) //'/'// &
  2293. trim(varfilename) //'_'// &
  2294. trim(source_str) //'-'// &
  2295. trim(version_str) //'-'// &
  2296. 'supplemental-data' //'_'// &
  2297. 'gn' //'_'// &
  2298. trim(time_str) // &
  2299. '.nc'
  2300. ! test existence of file
  2301. inquire( file=trim(fname), exist=existfile)
  2302. if( .not. existfile ) then
  2303. write (gol,'(" CMIP6 file `",a,"` not found ")') trim(fname); call goErr
  2304. status = 1; TRACEBACK; return
  2305. end if
  2306. d2data_bf(:,:) = emission_cmip6_Read2DRecord( fname, varname, secname, imonth, year, startyear, status )
  2307. endif
  2308. end if
  2309. endif
  2310. IF_NOTOK_RETURN(status=1)
  2311. end subroutine emission_cmip6_ReadSector
  2312. !EOC
  2313. !--------------------------------------------------------------------------
  2314. ! TM5 !
  2315. !--------------------------------------------------------------------------
  2316. !BOP
  2317. !
  2318. ! !IROUTINE: EMISSION_CMIP6BMB_READSECTOR
  2319. !
  2320. ! !DESCRIPTION: Reading one sector of the files for the requested month and
  2321. ! returning an interpolated 3d emission field (d3data)
  2322. !\\
  2323. !\\
  2324. ! !INTERFACE:
  2325. !
  2326. subroutine emission_cmip6bmb_ReadSector( comp, iyear, imonth, sector, d3data, status )
  2327. !
  2328. ! !INPUT PARAMETERS:
  2329. !
  2330. character(len=*) , intent(in) :: comp
  2331. integer , intent(in) :: iyear
  2332. integer , intent(in) :: imonth
  2333. integer , intent(in) :: sector
  2334. !
  2335. ! !OUTPUT PARAMETERS:
  2336. !
  2337. integer , intent(out) :: status
  2338. real, dimension(nlon360,nlat180,ar5_dim_3ddata), intent(out) :: d3data
  2339. !
  2340. !EOP
  2341. !------------------------------------------------------------------------
  2342. !BOC
  2343. character(len=*), parameter :: rname = mname//'/emission_cmip6bmb_readsector'
  2344. character(len=256) :: fname
  2345. character(len=256) :: fname_gridboxarea
  2346. character(len=256) :: varfilename, varname
  2347. integer :: lt, year, startyear
  2348. integer :: j
  2349. character(len=50) :: sec_str
  2350. character(len=13) :: time_str
  2351. character(len=60) :: source_str
  2352. character(len=50) :: version_str
  2353. logical :: existfile
  2354. character(len=4) :: cyear
  2355. logical :: first=.true.
  2356. real, dimension(:,:), allocatable :: d3data_help
  2357. ! --- begin -----------------------------------
  2358. if ( trim(sectors_def(sector)%catname) /= 'biomassburning' ) then
  2359. write (gol,'("Invalid CMIP6 sector")') ; call goErr
  2360. status=1; TRACEBACK; return
  2361. endif
  2362. ! initialise target array
  2363. d3data = 0.0
  2364. ! deal with out-of-bounds requested years
  2365. year = valid_year( iyear, cmip6_avail, 'CMIP6BMB', first)
  2366. first=.false.
  2367. ! cyear will contain strings with the years
  2368. write(cyear,'(I4.4)') year
  2369. if (year <= 2014) then
  2370. sec_str='em-biomassburning'
  2371. source_str='input4MIPs_emissions_CMIP_VUA'
  2372. version_str='CMIP-BB4CMIP6-1-2'
  2373. ! read in gridbox-area; once per CPU
  2374. ! Only historical data are at 0.25x0.25 degree
  2375. if ( .not. area_found_025 ) then
  2376. fname_gridboxarea = trim(emis_input_dir_cmip6) //'/'// &
  2377. 'gridcellarea' //'-'// &
  2378. trim(sec_str) //'_'// &
  2379. trim(source_str) //'-'// &
  2380. trim(version_str) //'_'// &
  2381. 'gn.nc'
  2382. ! no need to swap the latitude order here
  2383. call emission_ReadGridboxArea(fname_gridboxarea, 'gridcellarea', gridbox_area_025, &
  2384. & nlon1440, nlat720, status )
  2385. IF_NOTOK_RETURN(status=1)
  2386. area_found_025=.true.
  2387. endif
  2388. else
  2389. if (index(comp,'NMVOC-') == 1) then
  2390. sec_str='em-speciated-VOC-openburning'
  2391. else
  2392. sec_str='em-openburning'
  2393. endif
  2394. select case(trim(ssp_name))
  2395. case ("SSP3-7.0")
  2396. source_str='input4MIPs_emissions_ScenarioMIP_IAMC-AIM-ssp370'
  2397. ! Use SSP370-LowNTCF for specific species
  2398. if ( ((index(comp,'BC' ) ==1) .and. LSSP370_LowBC ) .or. &
  2399. ((index(comp,'OC' ) ==1) .and. LSSP370_LowOC ) .or. &
  2400. ((index(comp,'SO2' ) ==1) .and. LSSP370_LowSOx ) .or. &
  2401. ((index(comp,'NH3' ) ==1) .and. LSSP370_LowNH3 ) .or. &
  2402. ((index(comp,'NOx' ) ==1) .and. LSSP370_LowNOx ) .or. &
  2403. ((index(comp,'CO' ) ==1) .and. LSSP370_LowCO ) .or. &
  2404. ((index(comp,'NMVOC-') ==1) .and. LSSP370_LowNMVOC) .or. &
  2405. ((index(comp,'CH4' ) ==1) .and. LSSP370_LowCH4 ) ) then
  2406. source_str='input4MIPs_emissions_AerChemMIP_IAMC-AIM-ssp370-lowNTCF'
  2407. endif
  2408. case ("SSP3-LowNTCF")
  2409. source_str='input4MIPs_emissions_AerChemMIP_IAMC-AIM-ssp370-lowNTCF'
  2410. case default
  2411. write (gol,'("Emissions not implemented for scenario: ",a)') trim(ssp_name); call goErr
  2412. status=1; TRACEBACK; return
  2413. end select
  2414. version_str='1-1'
  2415. endif
  2416. ! ------------------------
  2417. ! construct filename
  2418. ! e.g.: <emisdir>/NOx-em-biomassburning_input4MIPs_emissions_CMIP_VUA-CMIP-BB4CMIP6-1-2_gn_175001-184912.nc
  2419. ! ------------------------
  2420. varfilename=trim(comp)//'-'//trim(sec_str)
  2421. if (index(comp,'NMVOC-') == 1) then
  2422. ! change dash to underscore in few cases
  2423. if (year <= 2014) then
  2424. varname = trim(comp(7:))
  2425. ! change dash to underscore in few cases
  2426. if (varname(1:7) == 'Higher-') varname(1:7) = 'Higher_'
  2427. else
  2428. varname = trim(comp)
  2429. varname(1:6) = 'NMVOC_'
  2430. if (varname(7:13) == 'Higher-') varname(7:13) = 'Higher_'
  2431. varname = trim(varname) // '_em_speciated_VOC_openburning'
  2432. endif
  2433. else
  2434. if (year <= 2014) then
  2435. varname=trim(comp)
  2436. else
  2437. varname = trim(comp) // '_em_openburning'
  2438. endif
  2439. endif
  2440. if (year >= 1750 .and. year < 1850) then
  2441. time_str='175001-184912'
  2442. startyear=1750
  2443. else if (year >= 1850 .and. year <= 2014) then
  2444. time_str='185001-201512'
  2445. startyear=1850
  2446. else if (year >= 2015 .and. year <= 2100) then
  2447. time_str='201501-210012'
  2448. startyear=2015
  2449. else
  2450. write (gol,'("CMIP6 emissions beyond 2100 not available yet")') ; call goErr
  2451. status=1; TRACEBACK; return
  2452. endif
  2453. if (year <= 2014) then
  2454. fname = trim(emis_input_dir_cmip6) //'/'// &
  2455. trim(varfilename) //'_'// &
  2456. trim(source_str) //'-'// &
  2457. trim(version_str) //'_'// &
  2458. 'gn' //'_'// &
  2459. trim(time_str) // &
  2460. '.nc'
  2461. else
  2462. if (index(comp,'NMVOC-') == 1) then
  2463. fname = trim(emis_input_dir_cmip6) //'/'// &
  2464. trim(varfilename) //'_'// &
  2465. trim(source_str) //'-'// &
  2466. trim(version_str) //'-'// &
  2467. 'supplemental-data' //'_'// &
  2468. 'gn' //'_'// &
  2469. trim(time_str) // &
  2470. '.nc'
  2471. else
  2472. fname = trim(emis_input_dir_cmip6) //'/'// &
  2473. trim(varfilename) //'_'// &
  2474. trim(source_str) //'-'// &
  2475. trim(version_str) //'_'// &
  2476. 'gn' //'_'// &
  2477. trim(time_str) // &
  2478. '.nc'
  2479. endif
  2480. endif
  2481. ! test existence of file
  2482. inquire( file=trim(fname), exist=existfile)
  2483. if( .not. existfile ) then
  2484. write (gol,'(" CMIP6 file `",a,"` not found ")') trim(fname); call goErr
  2485. status = 1; TRACEBACK; return
  2486. end if
  2487. if (year <= 2014) then
  2488. allocate(d3data_help(nlon360,nlat180))
  2489. ! ------------------------------------------------
  2490. ! data record is read by emission_cmip6bmb_Read2DRecord
  2491. d3data_help(:,:) = emission_cmip6bmb_Read2DRecord( fname, varname, imonth, year, startyear, status )
  2492. IF_NOTOK_RETURN(status=1)
  2493. ! reverse latitudes
  2494. do j=1,nlat180
  2495. d3data(:,j,1) = d3data_help(:,nlat180-j+1)
  2496. enddo
  2497. deallocate(d3data_help)
  2498. else
  2499. ! ------------------------------------------------
  2500. ! data record is read by emission_cmip6bmb_ssp_Read2DRecord
  2501. d3data(:,:,1) = emission_cmip6bmb_ssp_Read2DRecord( fname, varname, imonth, year, startyear, status)
  2502. IF_NOTOK_RETURN(status=1)
  2503. endif
  2504. end subroutine emission_cmip6bmb_ReadSector
  2505. !EOC
  2506. !--------------------------------------------------------------------------
  2507. ! TM5 !
  2508. !--------------------------------------------------------------------------
  2509. !BOP
  2510. !
  2511. ! !FUNCTION: EMISSION_CMIP6_READ2DRECORD
  2512. !
  2513. ! !DESCRIPTION: Read a single 2d record of a given file and
  2514. ! return a 2d emission field interpolated on 1x1 grid.
  2515. !\\
  2516. !\\
  2517. ! !INTERFACE:
  2518. !
  2519. function emission_cmip6_Read2DRecord( fname, varname, secname, imonth, year, startyear, status )
  2520. !
  2521. ! !RETURN VALUE:
  2522. !
  2523. real :: emission_cmip6_Read2DRecord(nlon360,nlat180)
  2524. !
  2525. ! !INPUT PARAMETERS:
  2526. !
  2527. character(len=*), intent(in) :: fname, varname
  2528. character(len=sector_name_len), intent(in) :: secname
  2529. integer, intent(in) :: imonth, year, startyear
  2530. !
  2531. ! !OUTPUT PARAMETERS:
  2532. !
  2533. integer, intent(out) :: status
  2534. !
  2535. !EOP
  2536. !------------------------------------------------------------------------
  2537. !BOC
  2538. character(len=*), parameter :: rname = mname//'/emission_cmip6_Read2DRecord'
  2539. character(len=256) :: fname2
  2540. integer :: fid, varid, isec
  2541. integer :: fid2, varid2, year_first, year_second
  2542. !real :: emis_in(nlon720, nlat360, 1)
  2543. real :: emis_in(nlon720, nlat360, 1, 1)
  2544. real, allocatable :: emis_help(:,:,:,:)
  2545. real :: x
  2546. ! --- begin -----------------------------------
  2547. select case( trim(secname) )
  2548. case ('AGR')
  2549. isec=0
  2550. case ('ENE')
  2551. isec=1
  2552. case ('IND')
  2553. isec=2
  2554. case ('TRA')
  2555. isec=3
  2556. case ('RCO')
  2557. isec=4
  2558. case ('SLV')
  2559. isec=5
  2560. case ('WST')
  2561. isec=6
  2562. case ('SHP')
  2563. isec=7
  2564. case default
  2565. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  2566. secname, trim(fname) ; call goErr
  2567. status=1; TRACEBACK; return
  2568. end select
  2569. ! initialise
  2570. emission_cmip6_Read2DRecord = 0.0
  2571. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  2572. IF_NOTOK_RETURN(status=1)
  2573. CALL MDF_Inq_VarID( fid, TRIM(varname), varid, status )
  2574. IF_ERROR_RETURN(status=1)
  2575. if ( varid < 0 ) then
  2576. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  2577. varname, trim(fname) ; call goErr
  2578. status=1; TRACEBACK; return
  2579. else
  2580. if( okdebug ) then
  2581. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  2582. varname, trim(fname) ; call goErr
  2583. endif
  2584. ! Special case for methane emissions prior to 1970
  2585. ! which are provided at 10-year intervals,
  2586. ! starting at 1850.
  2587. if (index(varname,'CH4') == 1 .and. year < 1970) then
  2588. ! First year of the decade:
  2589. year_first = int(year/10) * 10
  2590. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth+12*(year_first-startyear)/10/) )
  2591. IF_NOTOK_RETURN(status=1)
  2592. if (year /= year_first) then
  2593. ! Also read data for the first year of the next decade
  2594. ! and apply a linear interpolation between the two years
  2595. allocate(emis_help(nlon720, nlat360, 1, 1))
  2596. year_second = year_first + 10
  2597. if (year_second == 1970) then
  2598. ! Read 1970 data from the regular 1970-2014 file
  2599. fname2 = trim(emis_input_dir_cmip6)//'/'// &
  2600. 'CH4-em-anthro_input4MIPs_emissions_CMIP_CEDS-2017-05-18_gn_197001-201412.nc'
  2601. CALL MDF_Open( TRIM(fname2), MDF_NETCDF, MDF_READ, fid2, status )
  2602. IF_NOTOK_RETURN(status=1)
  2603. CALL MDF_Inq_VarID( fid2, TRIM(varname), varid2, status )
  2604. IF_ERROR_RETURN(status=1)
  2605. if ( varid2 < 0 ) then
  2606. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  2607. varname, trim(fname2) ; call goErr
  2608. status=1; TRACEBACK; return
  2609. else
  2610. if ( okdebug ) then
  2611. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  2612. varname, trim(fname2) ; call goErr
  2613. endif
  2614. CALL MDF_Get_Var( fid2, varid2, emis_help, status, start=(/1,1,isec+1,imonth/) )
  2615. IF_NOTOK_RETURN(status=1)
  2616. endif
  2617. CALL MDF_Close( fid2, status )
  2618. IF_NOTOK_RETURN(status=1)
  2619. else
  2620. ! Read from the file containing the data prior to 1970,
  2621. ! which is already open
  2622. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,isec+1,imonth+12*(year_second-startyear)/10/) )
  2623. endif
  2624. ! Interpolate montly data between the two provided years
  2625. x = float(year-year_first)/10.
  2626. emis_in(:,:,1,1) = (1.-x) * emis_in(:,:,1,1) + x * emis_help(:,:,1,1)
  2627. deallocate(emis_help)
  2628. endif
  2629. ! SSP scenario emissions are provided for 2015, 2020, 2030, ... 2100
  2630. else if (year >= 2015 .and. year < 2020) then
  2631. ! First year of the period
  2632. year_first = 2015
  2633. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth/) )
  2634. IF_NOTOK_RETURN(status=1)
  2635. if (year /= year_first) then
  2636. ! Also read data for 2020
  2637. ! and apply a linear interpolation between the two years
  2638. allocate(emis_help(nlon720, nlat360, 1, 1))
  2639. year_second = 2020
  2640. ! Read data for 2020 by raising the index by 12
  2641. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,isec+1,imonth+12/) )
  2642. ! Interpolate montly data between the two provided years
  2643. x = float(year-year_first)/5.
  2644. emis_in(:,:,1,1) = (1.-x) * emis_in(:,:,1,1) + x * emis_help(:,:,1,1)
  2645. deallocate(emis_help)
  2646. endif
  2647. else if (year >= 2020) then
  2648. ! First year of the decade:
  2649. year_first = int(year/10) * 10
  2650. ! Change to reference year to 2020 by raising the index by 12
  2651. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth+12+12*(year_first-2020)/10/) )
  2652. IF_NOTOK_RETURN(status=1)
  2653. if (year /= year_first) then
  2654. ! Also read data for the first year of the next decade
  2655. ! and apply a linear interpolation between the two years
  2656. allocate(emis_help(nlon720, nlat360, 1, 1))
  2657. year_second = year_first + 10
  2658. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,isec+1,imonth+12+12*(year_second-2020)/10/) )
  2659. ! Interpolate monthly data between the two provided years
  2660. x = float(year-year_first)/10.
  2661. emis_in(:,:,1,1) = (1.-x) * emis_in(:,:,1,1) + x * emis_help(:,:,1,1)
  2662. deallocate(emis_help)
  2663. endif
  2664. else
  2665. ! read yearly emissions directly from file
  2666. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth+12*(year-startyear)/) )
  2667. IF_NOTOK_RETURN(status=1)
  2668. endif
  2669. ! convert from kg(species)/m^2/s to kg(species)/gridbox/s
  2670. emis_in(:,:,1,1) = emis_in(:,:,1,1) * gridbox_area_05
  2671. ! now coarsen to nlon360,nlat180
  2672. emission_cmip6_Read2DRecord = emission_coarsen_to_1x1( emis_in(:,:,1,1), nlon720, nlat360,.false., status )
  2673. IF_NOTOK_RETURN(status=1)
  2674. end if
  2675. CALL MDF_Close( fid, status )
  2676. IF_NOTOK_RETURN(status=1)
  2677. status = 0
  2678. return
  2679. end function emission_cmip6_Read2DRecord
  2680. !EOC
  2681. !--------------------------------------------------------------------------
  2682. ! TM5 !
  2683. !--------------------------------------------------------------------------
  2684. !BOP
  2685. !
  2686. ! !FUNCTION: EMISSION_CMIP6_READ3DRECORD
  2687. !
  2688. ! !DESCRIPTION: read one 3D sector
  2689. !
  2690. !\\
  2691. !\\
  2692. ! !INTERFACE:
  2693. !
  2694. function emission_cmip6_Read3DRecord( fname, varname, secname, imonth, year, startyear, status )
  2695. !
  2696. ! !RETURN VALUE:
  2697. !
  2698. real :: emission_cmip6_Read3DRecord(nlon360,nlat180,ar5_dim_3ddata)
  2699. !
  2700. ! !INPUT/OUTPUT PARAMETERS:
  2701. !
  2702. character(len=*), intent(in) :: fname, varname
  2703. character(32), intent(in) :: secname
  2704. !
  2705. ! !INPUT PARAMETERS:
  2706. !
  2707. integer, intent(in) :: imonth, year, startyear
  2708. !
  2709. ! !OUTPUT PARAMETERS:
  2710. !
  2711. integer, intent(out) :: status
  2712. !
  2713. ! !REVISION HISTORY:
  2714. ! 1 Oct 2010 - Achim Strunk -
  2715. !
  2716. ! !REMARKS:
  2717. !
  2718. !EOP
  2719. !------------------------------------------------------------------------
  2720. !BOC
  2721. character(len=*), parameter :: rname = mname//'/emission_cmip6_Read3DRecord'
  2722. integer :: fid, varid, lk
  2723. integer :: fid2, varid2, year_first, year_second
  2724. real, dimension(nlon720,nlat360,ar5_dim_3ddata,1) :: emis_in
  2725. real, allocatable :: emis_help(:,:,:,:)
  2726. real :: x
  2727. real, parameter :: layer_depth = 610. ! fixed height (m) of the vertical levels
  2728. ! on which the CMIP6 aircraft emissions
  2729. ! are provided.
  2730. ! --- begin -----------------------------------
  2731. ! initialise
  2732. emission_cmip6_Read3DRecord = 0.0
  2733. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  2734. IF_NOTOK_RETURN(status=1)
  2735. CALL MDF_Inq_VarID( fid, TRIM(varname), varid, status )
  2736. IF_ERROR_RETURN(status=1)
  2737. if ( varid < 0 ) then
  2738. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  2739. secname, trim(fname) ; call goErr
  2740. status=1; TRACEBACK; return
  2741. else
  2742. if( okdebug ) then
  2743. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  2744. secname, trim(fname) ; call goPr
  2745. endif
  2746. ! SSP scenario emissions are provided for 2015, 2020, 2030, ... 2100
  2747. if (year >= 2015 .and. year < 2020) then
  2748. ! First year of the period
  2749. year_first = 2015
  2750. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth/) )
  2751. IF_NOTOK_RETURN(status=1)
  2752. if (year /= year_first) then
  2753. ! Also read data for 2020
  2754. ! and apply a linear interpolation between the two years
  2755. allocate(emis_help(nlon720, nlat360, ar5_dim_3ddata, 1))
  2756. year_second = 2020
  2757. ! Read data for 2020 by raising the index by 12
  2758. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,1,imonth+12/) )
  2759. ! Interpolate montly data between the two provided years
  2760. x = float(year-year_first)/5.
  2761. emis_in(:,:,:,1) = (1.-x) * emis_in(:,:,:,1) + x * emis_help(:,:,:,1)
  2762. deallocate(emis_help)
  2763. endif
  2764. else if (year >= 2020) then
  2765. ! First year of the decade:
  2766. year_first = int(year/10) * 10
  2767. ! Change to reference year to 2020 by raising the index by 12
  2768. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth+12+12*(year_first-2020)/10/) )
  2769. IF_NOTOK_RETURN(status=1)
  2770. if (year /= year_first) then
  2771. ! Also read data for the first year of the next decade
  2772. ! and apply a linear interpolation between the two years
  2773. allocate(emis_help(nlon720, nlat360, ar5_dim_3ddata, 1))
  2774. year_second = year_first + 10
  2775. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,1,imonth+12+12*(year_second-2020)/10/) )
  2776. ! Interpolate monthly data between the two provided years
  2777. x = float(year-year_first)/10.
  2778. emis_in(:,:,:,1) = (1.-x) * emis_in(:,:,:,1) + x * emis_help(:,:,:,1)
  2779. deallocate(emis_help)
  2780. endif
  2781. else
  2782. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth+12*(year-startyear)/) )
  2783. IF_NOTOK_RETURN(status=1)
  2784. endif
  2785. do lk = 1, ar5_dim_3ddata
  2786. ! convert from kg(species)/m^2/s to kg(species)/m/s;
  2787. ! Note that CMIP6 aircraft emissions are given in kg(species)/m^2/s,
  2788. ! while AR5 aircraft emissions are given in kg(species)/m^3/s.
  2789. ! In order to be able to use the same vertical regridding routine lateron,
  2790. ! we convert to the same unit and include a division by the layer depth.
  2791. emis_in(:,:,lk,1) = emis_in(:,:,lk,1) * gridbox_area_05 / layer_depth
  2792. ! now coarsen to nlon360,nlat180
  2793. emission_cmip6_Read3DRecord(:,:,lk) = emission_coarsen_to_1x1( emis_in(:,:,lk,1) ,&
  2794. & nlon720, nlat360, .false., status )
  2795. IF_NOTOK_RETURN(status=1)
  2796. end do
  2797. end if
  2798. CALL MDF_Close( fid, status )
  2799. IF_NOTOK_RETURN(status=1)
  2800. status = 0
  2801. return
  2802. end function emission_cmip6_Read3DRecord
  2803. !EOC
  2804. !--------------------------------------------------------------------------
  2805. ! TM5 !
  2806. !--------------------------------------------------------------------------
  2807. !BOP
  2808. !
  2809. ! !FUNCTION: EMISSION_CMIP6BMB_READ2DRECORD
  2810. !
  2811. ! !DESCRIPTION: Read a single 2d record of a given file and
  2812. ! return a 2d emission field interpolated on 1x1 grid.
  2813. !\\
  2814. !\\
  2815. ! !INTERFACE:
  2816. !
  2817. function emission_cmip6bmb_Read2DRecord( fname, varname, imonth, year, startyear, status )
  2818. !
  2819. ! !RETURN VALUE:
  2820. !
  2821. real :: emission_cmip6bmb_Read2DRecord(nlon360,nlat180)
  2822. !
  2823. ! !INPUT PARAMETERS:
  2824. !
  2825. character(len=*), intent(in) :: fname
  2826. character(len=*), intent(in) :: varname
  2827. integer, intent(in) :: imonth, year, startyear
  2828. !
  2829. ! !OUTPUT PARAMETERS:
  2830. !
  2831. integer, intent(out) :: status
  2832. !
  2833. !EOP
  2834. !------------------------------------------------------------------------
  2835. !BOC
  2836. character(len=*), parameter :: rname = mname//'/emission_cmip6bmb_Read2DRecord'
  2837. integer :: fid, varid, isec
  2838. real :: emis_in(nlon1440, nlat720, 1)
  2839. ! --- begin -----------------------------------
  2840. ! initialise
  2841. emission_cmip6bmb_Read2DRecord = 0.0
  2842. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  2843. IF_NOTOK_RETURN(status=1)
  2844. CALL MDF_Inq_VarID( fid, TRIM(varname), varid, status )
  2845. IF_ERROR_RETURN(status=1)
  2846. if ( varid < 0 ) then
  2847. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  2848. varname, trim(fname) ; call goErr
  2849. status=1; TRACEBACK; return
  2850. else
  2851. if( okdebug ) then
  2852. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  2853. varname, trim(fname) ; call goErr
  2854. endif
  2855. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth+12*(year-startyear)/) )
  2856. IF_NOTOK_RETURN(status=1)
  2857. ! over the oceans emissions are set to 1.e20 instead of 0.
  2858. where ( emis_in > 1.e19 ) emis_in = 0.0
  2859. ! convert from kg(species)/m^2/s to kg(species)/gridbox/s
  2860. emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_025
  2861. ! now coarsen to nlon360,nlat180
  2862. emission_cmip6bmb_Read2DRecord = emission_coarsen_to_1x1( emis_in(:,:,1), nlon1440, nlat720,.false., status )
  2863. IF_NOTOK_RETURN(status=1)
  2864. end if
  2865. CALL MDF_Close( fid, status )
  2866. IF_NOTOK_RETURN(status=1)
  2867. status = 0
  2868. return
  2869. end function emission_cmip6bmb_Read2DRecord
  2870. !--------------------------------------------------------------------------
  2871. ! TM5 !
  2872. !--------------------------------------------------------------------------
  2873. !BOP
  2874. !
  2875. ! !FUNCTION: EMISSION_CMIP6BMB_SSP_READ2DRECORD
  2876. !
  2877. ! !DESCRIPTION: Read a single 2d record of a given file and
  2878. ! return a 2d emission field interpolated on 1x1 grid.
  2879. ! Copied from emission_cmip6_Read2DRecord
  2880. ! but with sector dimension removed.
  2881. !\\
  2882. !\\
  2883. ! !INTERFACE:
  2884. !
  2885. function emission_cmip6bmb_ssp_Read2DRecord( fname, varname, imonth, year, startyear, status )
  2886. !
  2887. ! !RETURN VALUE:
  2888. !
  2889. real :: emission_cmip6bmb_ssp_Read2DRecord(nlon360,nlat180)
  2890. !
  2891. ! !INPUT PARAMETERS:
  2892. !
  2893. character(len=*), intent(in) :: fname, varname
  2894. integer, intent(in) :: imonth, year, startyear
  2895. !
  2896. ! !OUTPUT PARAMETERS:
  2897. !
  2898. integer, intent(out) :: status
  2899. !
  2900. !EOP
  2901. !------------------------------------------------------------------------
  2902. !BOC
  2903. character(len=*), parameter :: rname = mname//'/emission_cmip6bmb_ssp_Read2DRecord'
  2904. character(len=256) :: fname2
  2905. integer :: fid, varid
  2906. integer :: fid2, varid2, year_first, year_second
  2907. real :: emis_in(nlon720, nlat360, 1)
  2908. real, allocatable :: emis_help(:,:,:)
  2909. real :: x
  2910. ! --- begin -----------------------------------
  2911. ! initialise
  2912. emission_cmip6bmb_ssp_Read2DRecord = 0.0
  2913. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  2914. IF_NOTOK_RETURN(status=1)
  2915. CALL MDF_Inq_VarID( fid, TRIM(varname), varid, status )
  2916. IF_ERROR_RETURN(status=1)
  2917. if ( varid < 0 ) then
  2918. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  2919. varname, trim(fname) ; call goErr
  2920. status=1; TRACEBACK; return
  2921. else
  2922. if( okdebug ) then
  2923. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  2924. varname, trim(fname) ; call goErr
  2925. endif
  2926. ! SSP scenario emissions are provided for 2015, 2020, 2030, ... 2100
  2927. if (year >= 2015 .and. year < 2020) then
  2928. ! First year of the period
  2929. year_first = 2015
  2930. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) )
  2931. IF_NOTOK_RETURN(status=1)
  2932. if (year /= year_first) then
  2933. ! Also read data for 2020
  2934. ! and apply a linear interpolation between the two years
  2935. allocate(emis_help(nlon720, nlat360, 1))
  2936. year_second = 2020
  2937. ! Read data for 2020 by raising the index by 12
  2938. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,imonth+12/) )
  2939. ! Interpolate montly data between the two provided years
  2940. x = float(year-year_first)/5.
  2941. emis_in(:,:,1) = (1.-x) * emis_in(:,:,1) + x * emis_help(:,:,1)
  2942. deallocate(emis_help)
  2943. endif
  2944. else if (year >= 2020) then
  2945. ! First year of the decade:
  2946. year_first = int(year/10) * 10
  2947. ! Change to reference year to 2020 by raising the index by 12
  2948. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth+12+12*(year_first-2020)/10/) )
  2949. IF_NOTOK_RETURN(status=1)
  2950. if (year /= year_first) then
  2951. ! Also read data for the first year of the next decade
  2952. ! and apply a linear interpolation between the two years
  2953. allocate(emis_help(nlon720, nlat360, 1))
  2954. year_second = year_first + 10
  2955. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,imonth+12+12*(year_second-2020)/10/) )
  2956. ! Interpolate monthly data between the two provided years
  2957. x = float(year-year_first)/10.
  2958. emis_in(:,:,1) = (1.-x) * emis_in(:,:,1) + x * emis_help(:,:,1)
  2959. deallocate(emis_help)
  2960. endif
  2961. else
  2962. ! As this function is only used for the future period (2015-2100)
  2963. ! the code will never get here.
  2964. ! read yearly emissions directly from file
  2965. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth+12*(year-startyear)/) )
  2966. IF_NOTOK_RETURN(status=1)
  2967. endif
  2968. ! convert from kg(species)/m^2/s to kg(species)/gridbox/s
  2969. emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05
  2970. ! now coarsen to nlon360,nlat180
  2971. emission_cmip6bmb_ssp_Read2DRecord = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360,.false., status )
  2972. IF_NOTOK_RETURN(status=1)
  2973. end if
  2974. CALL MDF_Close( fid, status )
  2975. IF_NOTOK_RETURN(status=1)
  2976. status = 0
  2977. return
  2978. end function emission_cmip6bmb_ssp_Read2DRecord
  2979. !EOC
  2980. !--------------------------------------------------------------------------
  2981. ! TM5 !
  2982. !--------------------------------------------------------------------------
  2983. !BOP
  2984. !
  2985. ! !IROUTINE: READ_CMIP6_ZCH4
  2986. !
  2987. ! !DESCRIPTION: Read CMIP6 zonal mean CH4 for specified year/month
  2988. ! and convert from 0.5 to 1 degree latitude bands
  2989. !\\
  2990. !\\
  2991. ! !INTERFACE:
  2992. !
  2993. SUBROUTINE READ_CMIP6_ZCH4(field, year, month, status)
  2994. !
  2995. ! !USES:
  2996. !
  2997. use emission_data, only : cmip6_ch4_dirname
  2998. !
  2999. ! !OUTPUT PARAMETERS:
  3000. !
  3001. integer, intent(out) :: status
  3002. ! output zonal mean field in 1 degree latitude bands:
  3003. real, dimension(nlat180), intent(out) :: field
  3004. !
  3005. ! !INPUT PARAMETERS:
  3006. !
  3007. integer, intent(in) :: year, month
  3008. !
  3009. ! !REMARKS:
  3010. !
  3011. !EOP
  3012. !------------------------------------------------------------------------
  3013. !BOC
  3014. character(len=*), parameter :: rname = mname//'/Read_CMIP6_CH4'
  3015. character(len=256) :: fname_gridboxarea
  3016. character(len=512) :: zch4_fname
  3017. integer :: startyear
  3018. integer :: fid, varid
  3019. ! zonal mean field in CMIP6 file:
  3020. integer :: j_coarse, j_fine, j_int
  3021. real :: area_norm
  3022. real*4, dimension(nlat360) :: field05
  3023. ! read in gridbox-area; once per CPU
  3024. if( .not. area_found_05 ) then
  3025. fname_gridboxarea = trim(emis_input_dir_ar5)//'/'//trim(ar5_filestr_gridboxarea)
  3026. call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, &
  3027. & nlon720, nlat360, status )
  3028. IF_NOTOK_RETURN(status=1)
  3029. area_found_05=.true.
  3030. endif
  3031. if (year .le. 2014) then
  3032. zch4_fname='mole-fraction-of-methane-in-air_input4MIPs_GHGConcentrations_CMIP_UoM-CMIP-1-2-0_gr-0p5x360deg_000001-201412.nc'
  3033. startyear=0
  3034. else
  3035. select case (trim(ssp_name))
  3036. case ("SSP3-7.0")
  3037. zch4_fname='mole-fraction-of-methane-in-air_input4MIPs_GHGConcentrations_ScenarioMIP_UoM-AIM-ssp370-1-2-1_gr-0p5x360deg_201501-250012.nc'
  3038. if (LSSP370_LowCH4) then
  3039. zch4_fname='mole-fraction-of-methane-in-air_input4MIPs_GHGConcentrations_AerChemMIP_UoM-AIM-ssp370-lowNTCF-1-2-1_gr-0p5x360deg_201501-250012.nc'
  3040. endif
  3041. case ("SSP3-LowNTCF")
  3042. zch4_fname='mole-fraction-of-methane-in-air_input4MIPs_GHGConcentrations_AerChemMIP_UoM-AIM-ssp370-lowNTCF-1-2-1_gr-0p5x360deg_201501-250012.nc'
  3043. case default
  3044. write (gol,'("CH4 surface zonal means not implemented for scenario: ",a)') trim(ssp_name) ; call goErr
  3045. status=1; TRACEBACK; return
  3046. end select
  3047. startyear=2015
  3048. endif
  3049. zch4_fname=trim(cmip6_ch4_dirname)//trim(zch4_fname)
  3050. CALL MDF_Open( TRIM(zch4_fname), MDF_NETCDF, MDF_READ, fid, status )
  3051. IF_NOTOK_RETURN(status=1)
  3052. CALL MDF_Inq_VarID( fid, 'mole_fraction_of_methane_in_air', varid, status )
  3053. IF_ERROR_RETURN(status=1)
  3054. CALL MDF_Get_Var( fid, varid, field05, status, start = (/1,month+12*(year-startyear)/) )
  3055. IF_NOTOK_RETURN(status=1)
  3056. CALL MDF_Close( fid, status )
  3057. IF_NOTOK_RETURN(status=1)
  3058. ! convert from 0.5 to 1 degree latitude bands:
  3059. field(:)=0.
  3060. do j_coarse = 1,nlat180
  3061. area_norm=0.
  3062. do j_int=1,2
  3063. ! Set longitude index to 1 (arbitrary)
  3064. j_fine=2*(j_coarse-1)+j_int
  3065. field(j_coarse)=field(j_coarse)+field05(j_fine)*gridbox_area_05(1,j_fine)
  3066. area_norm=area_norm+gridbox_area_05(1,j_fine)
  3067. enddo
  3068. field(j_coarse)=field(j_coarse)/area_norm
  3069. enddo
  3070. status = 0
  3071. END SUBROUTINE READ_CMIP6_ZCH4
  3072. !EOC
  3073. !--------------------------------------------------------------------------
  3074. ! TM5 !
  3075. !--------------------------------------------------------------------------
  3076. !BOP
  3077. !
  3078. ! !IROUTINE: EMISSION_AR5_READSECTOR
  3079. !
  3080. ! !DESCRIPTION: Reading one sector of the files to be interpolated and
  3081. ! returning an interpolated 3d emission field (d3data)
  3082. !\\
  3083. !\\
  3084. ! !INTERFACE:
  3085. !
  3086. subroutine emission_ar5_ReadSector( comp, iyear, imonth, sector, d3data, status )
  3087. !
  3088. ! !INPUT PARAMETERS:
  3089. !
  3090. character(len=*) , intent(in) :: comp
  3091. integer , intent(in) :: iyear
  3092. integer , intent(in) :: imonth
  3093. integer , intent(in) :: sector
  3094. !
  3095. ! !OUTPUT PARAMETERS:
  3096. !
  3097. integer , intent(out) :: status
  3098. real, dimension(nlon360,nlat180,ar5_dim_3ddata), intent(out) :: d3data
  3099. !
  3100. ! !REVISION HISTORY:
  3101. ! 1 Oct 2010 - Achim Strunk - v0
  3102. !
  3103. !EOP
  3104. !------------------------------------------------------------------------
  3105. !BOC
  3106. character(len=*), parameter :: rname = mname//'/emission_ar5_read2dsector'
  3107. character(len=256) :: fname
  3108. character(len=256) :: fname_gridboxarea
  3109. character(32) :: secname
  3110. integer :: lt, year
  3111. logical :: existfile
  3112. integer, dimension(2) :: ltimes
  3113. character(len=4), dimension(2) :: ar5_cyears
  3114. real, dimension(2) :: ar5_ipcoef_years
  3115. logical :: first=.true.
  3116. real, dimension(nlon360,nlat180) :: d2data
  3117. ! --- begin -----------------------------------
  3118. ! initialise target array
  3119. d3data = 0.0
  3120. ! read in gridbox-area; once per CPU
  3121. if( .not. area_found_05 ) then
  3122. fname_gridboxarea = trim(emis_input_dir_ar5)//'/'//trim(ar5_filestr_gridboxarea)
  3123. call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, &
  3124. & nlon720, nlat360, status )
  3125. IF_NOTOK_RETURN(status=1)
  3126. area_found_05=.true.
  3127. endif
  3128. ! ----------------------------------------
  3129. ! get the right times to interpolate and related coefficients
  3130. ! (ar5_avail_yrs(ltimes))
  3131. !
  3132. ! --> result will be a linear interpolation between neighbouring files
  3133. !
  3134. ! ----------------------------------------
  3135. allocate( ltimeind( ar5_nr_avail_yrs ) )
  3136. ltimeind = .false.
  3137. ! deal with out-of-bounds requested years
  3138. year = valid_year( iyear, ar5_avail, 'AR5', first)
  3139. first=.false.
  3140. where( ar5_avail_yrs < year ) ltimeind = .true.
  3141. ! times(1): index representing time instance earlier than current year
  3142. ! times(2): -"- -"- later than current year
  3143. ltimes(2) = count( ltimeind ) + 1
  3144. ltimes(1) = max( ltimes(2) - 1, 1 )
  3145. ! check a match with repository
  3146. ! (in order to copy only one file instead of two)
  3147. if( ar5_avail_yrs(ltimes(2)) == year ) &
  3148. ltimes(1) = ltimes(2)
  3149. deallocate( ltimeind )
  3150. ! ar5_cyears will contain strings with the years
  3151. write(ar5_cyears(1),'(I4.4)') ar5_avail_yrs(ltimes(1))
  3152. write(ar5_cyears(2),'(I4.4)') ar5_avail_yrs(ltimes(2))
  3153. ! ar5_ipcoef_years will contain interpolation coefficients
  3154. ! default: factors 1.0/0.0
  3155. ar5_ipcoef_years(1) = 1.0
  3156. ar5_ipcoef_years(2) = 0.0
  3157. if( ltimes(2) /= ltimes(1) ) then
  3158. ar5_ipcoef_years(1) = (ar5_avail_yrs(ltimes(2)) - year) / &
  3159. real( ar5_avail_yrs(ltimes(2)) - ar5_avail_yrs(ltimes(1)) )
  3160. ar5_ipcoef_years(2) = 1.0 - ar5_ipcoef_years(1)
  3161. end if
  3162. ! ------------------------
  3163. ! read files (index=1: earlier file; index=2: later file)
  3164. ! ------------------------
  3165. do lt = 1, 2
  3166. if (ar5_ipcoef_years(lt) == 0.) cycle
  3167. ! ------------------------
  3168. ! construct filename
  3169. ! e.g.: <emisdir>/IPCC_emissions_RCP45_CO_biomassburning_2010_0.5x0.5.nc
  3170. ! ------------------------
  3171. if (trim(filestr_rcpiden)=='hist') then
  3172. fname = trim(emis_input_dir_ar5) //'/'// &
  3173. trim(filestr_common_pre) //'_'// &
  3174. trim(comp) //'_'// &
  3175. trim(sectors_def(sector)%catname) //'_'// &
  3176. ar5_cyears(lt) //'_'// &
  3177. trim(filestr_common_post)
  3178. else
  3179. fname = trim(emis_input_dir_ar5) //'/'// &
  3180. trim(filestr_common_pre) //'_'// &
  3181. trim(filestr_rcpiden) //'_'// &
  3182. trim(comp) //'_'// &
  3183. trim(sectors_def(sector)%catname) //'_'// &
  3184. ar5_cyears(lt) //'_'// &
  3185. trim(filestr_common_post)
  3186. endif
  3187. ! test existence of file
  3188. inquire( file=trim(fname), exist=existfile)
  3189. if( .not. existfile ) then
  3190. write (gol,'(" AR5 file `",a,"` not found ")') trim(fname); call goErr
  3191. status = 1; TRACEBACK; return
  3192. end if
  3193. ! ------------------------------------------------
  3194. ! data record is read by emission_ar5_Read2/3DRecord
  3195. ! add data scaled by interpolation factor ar5_ipcoef_years
  3196. secname = sectors_def(sector)%name
  3197. ! temporary fix as CMIP6 CH4 emissions are not available yet
  3198. ! change sector names to be able to use AR5 reading routine
  3199. if ( trim(sectors_def(sector)%prov) == 'CMIP6' ) then
  3200. select case( trim(secname) )
  3201. case ('AGR')
  3202. secname='emiss_agr'
  3203. case ('ENE')
  3204. secname='emiss_ene'
  3205. case ('IND')
  3206. secname='emiss_ind'
  3207. case ('TRA')
  3208. secname='emiss_tra'
  3209. case ('RCO')
  3210. secname='emiss_dom'
  3211. case ('WST')
  3212. secname='emiss_wst'
  3213. case ('SHP')
  3214. secname='emiss_shp'
  3215. case default
  3216. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  3217. secname, trim(fname) ; call goErr
  3218. status=1; TRACEBACK; return
  3219. end select
  3220. endif
  3221. ! distinguish 2d/3d sectors
  3222. if( sectors_def(sector)%f3d ) then
  3223. d3data(:,:,:) = d3data(:,:,:) + ar5_ipcoef_years(lt) * &
  3224. emission_ar5_Read3DRecord( fname, secname, imonth, status )
  3225. else
  3226. !>>> TvN
  3227. ! Set sectoral emissions not provided in the historical AR5 files to zero
  3228. ! for years before 2000.
  3229. ! Note these emissions are non-zero in the RCPs.
  3230. ! It is assumed below that the data for 2000 (and 2005) are taken from the RCP files.
  3231. if ( ar5_avail_yrs(ltimes(lt)) .lt. 2000 .and. &
  3232. ( ( trim(secname) .eq. 'emiss_slv' .and. (trim(comp) .eq. 'CO') ) .or. &
  3233. ( trim(secname) .eq. 'emiss_agr' .and. &
  3234. ( trim(comp) .eq. 'acids' .or. &
  3235. trim(comp) .eq. 'alcohols' .or. &
  3236. trim(comp) .eq. 'benzene' .or. &
  3237. trim(comp) .eq. 'butanes' .or. &
  3238. trim(comp) .eq. 'ethane' .or. &
  3239. trim(comp) .eq. 'ethene' .or. &
  3240. trim(comp) .eq. 'ethers' .or. &
  3241. trim(comp) .eq. 'ethyne' .or. &
  3242. trim(comp) .eq. 'formaldehyde' .or. &
  3243. trim(comp) .eq. 'hexanes_and_higher_alkanes' .or. &
  3244. trim(comp) .eq. 'ketones' .or. &
  3245. trim(comp) .eq. 'other_alkanals' .or. &
  3246. trim(comp) .eq. 'other_alkenes_and_alkynes' .or. &
  3247. trim(comp) .eq. 'other_aromatics' .or. &
  3248. trim(comp) .eq. 'pentanes' .or. &
  3249. trim(comp) .eq. 'propane' .or. &
  3250. trim(comp) .eq. 'propene' .or. &
  3251. trim(comp) .eq. 'toluene' .or. &
  3252. trim(comp) .eq. 'xylene' ) ) ) ) then
  3253. d2data(:,:) = 0.
  3254. else
  3255. d2data(:,:) = emission_ar5_Read2DRecord( fname, secname, imonth, status )
  3256. endif
  3257. !d3data(:,:,1) = d3data(:,:,1) + ar5_ipcoef_years(lt) * &
  3258. ! emission_ar5_Read2DRecord( fname, secname, imonth, status )
  3259. d3data(:,:,1) = d3data(:,:,1) + ar5_ipcoef_years(lt) * d2data(:,:)
  3260. !<<< TvN
  3261. end if
  3262. IF_NOTOK_RETURN(status=1)
  3263. end do ! lt
  3264. end subroutine emission_ar5_ReadSector
  3265. !EOC
  3266. !--------------------------------------------------------------------------
  3267. ! TM5 !
  3268. !--------------------------------------------------------------------------
  3269. !BOP
  3270. !
  3271. ! !FUNCTION: EMISSION_AR5_READ2DRECORD
  3272. !
  3273. ! !DESCRIPTION: Read a single 2d record of a given file and
  3274. ! return a 2d emission field interpolated on 1x1 grid.
  3275. !\\
  3276. !\\
  3277. ! !INTERFACE:
  3278. !
  3279. function emission_ar5_Read2DRecord( fname, secname, imonth, status )
  3280. !
  3281. ! !RETURN VALUE:
  3282. !
  3283. real :: emission_ar5_Read2DRecord(nlon360,nlat180)
  3284. !
  3285. ! !INPUT PARAMETERS:
  3286. !
  3287. character(len=*), intent(in) :: fname
  3288. character(len=sector_name_len), intent(in) :: secname
  3289. integer, intent(in) :: imonth
  3290. !
  3291. ! !OUTPUT PARAMETERS:
  3292. !
  3293. integer, intent(out) :: status
  3294. !
  3295. ! !REVISION HISTORY:
  3296. ! 1 Oct 2010 - Achim Strunk - v0
  3297. !
  3298. !EOP
  3299. !------------------------------------------------------------------------
  3300. !BOC
  3301. character(len=*), parameter :: rname = mname//'/emission_ar5_Read2DRecord'
  3302. integer :: fid, varid
  3303. real :: emis_in(nlon720, nlat360, 1)
  3304. ! --- begin -----------------------------------
  3305. ! initialise
  3306. emission_ar5_Read2DRecord = 0.0
  3307. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  3308. IF_NOTOK_RETURN(status=1)
  3309. CALL MDF_Inq_VarID( fid, TRIM(secname), varid, status )
  3310. IF_ERROR_RETURN(status=1)
  3311. if ( varid < 0 ) then
  3312. write (gol,'("EMISS - AR5 - no `",a,"` emissions in file ",a)') &
  3313. secname, trim(fname) ; call goErr
  3314. status=1; TRACEBACK; return
  3315. else
  3316. if( okdebug ) then
  3317. write (gol,'("EMISS-INFO - AR5 - found `",a,"` emissions in file ",a)') &
  3318. secname, trim(fname) ; call goPr
  3319. endif
  3320. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) )
  3321. IF_NOTOK_RETURN(status=1)
  3322. ! convert from kg(species)/m^2/s to kg(species)/gridbox/s
  3323. emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05
  3324. ! now coarsen to nlon360,nlat180
  3325. emission_ar5_Read2DRecord = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360,.true., status )
  3326. IF_NOTOK_RETURN(status=1)
  3327. end if
  3328. CALL MDF_Close( fid, status )
  3329. IF_NOTOK_RETURN(status=1)
  3330. status = 0
  3331. return
  3332. end function emission_ar5_Read2DRecord
  3333. !EOC
  3334. !--------------------------------------------------------------------------
  3335. ! TM5 !
  3336. !--------------------------------------------------------------------------
  3337. !BOP
  3338. !
  3339. ! !FUNCTION: EMISSION_AR5_READ3DRECORD
  3340. !
  3341. ! !DESCRIPTION: read one 3D sector
  3342. !
  3343. !\\
  3344. !\\
  3345. ! !INTERFACE:
  3346. !
  3347. function emission_ar5_Read3DRecord( fname, secname, imonth, status )
  3348. !
  3349. ! !RETURN VALUE:
  3350. !
  3351. real :: emission_ar5_Read3DRecord(nlon360,nlat180,ar5_dim_3ddata)
  3352. !
  3353. ! !INPUT/OUTPUT PARAMETERS:
  3354. !
  3355. character(len=*), intent(in) :: fname
  3356. character(32), intent(inout) :: secname
  3357. !
  3358. ! !INPUT PARAMETERS:
  3359. !
  3360. integer, intent(in) :: imonth
  3361. !
  3362. ! !OUTPUT PARAMETERS:
  3363. !
  3364. integer, intent(out) :: status
  3365. !
  3366. ! !REVISION HISTORY:
  3367. ! 1 Oct 2010 - Achim Strunk -
  3368. !
  3369. ! !REMARKS:
  3370. !
  3371. !EOP
  3372. !------------------------------------------------------------------------
  3373. !BOC
  3374. character(len=*), parameter :: rname = mname//'/emission_ar5_Read3DRecord'
  3375. integer :: fid, varid, lk
  3376. real, dimension(nlon720,nlat360,ar5_dim_3ddata,1) :: emis_in
  3377. ! --- begin -----------------------------------
  3378. ! initialise
  3379. emission_ar5_Read3DRecord = 0.0
  3380. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  3381. IF_NOTOK_RETURN(status=1)
  3382. CALL MDF_Inq_VarID( fid, TRIM(secname), varid, status )
  3383. IF_ERROR_RETURN(status=1)
  3384. if ( varid < 0 ) then
  3385. write (gol,'("EMISS - AR5 - no `",a,"` emissions in file ",a)') &
  3386. secname, trim(fname) ; call goErr
  3387. status=1; TRACEBACK; return
  3388. else
  3389. if( okdebug ) then
  3390. write (gol,'("EMISS-INFO - AR5 - found `",a,"` emissions in file ",a)') &
  3391. secname, trim(fname) ; call goPr
  3392. endif
  3393. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth/) )
  3394. IF_NOTOK_RETURN(status=1)
  3395. do lk = 1, ar5_dim_3ddata
  3396. ! convert from kg(species)/m^3/s to kg(species)/m/s :
  3397. emis_in(:,:,lk,1) = emis_in(:,:,lk,1) * gridbox_area_05
  3398. ! now coarsen to nlon360,nlat180
  3399. emission_ar5_Read3DRecord(:,:,lk) = emission_coarsen_to_1x1( emis_in(:,:,lk,1) ,&
  3400. & nlon720, nlat360, .true., status )
  3401. IF_NOTOK_RETURN(status=1)
  3402. end do
  3403. end if
  3404. CALL MDF_Close( fid, status )
  3405. IF_NOTOK_RETURN(status=1)
  3406. status = 0
  3407. return
  3408. end function emission_ar5_Read3DRecord
  3409. !EOC
  3410. !--------------------------------------------------------------------------
  3411. ! TM5 !
  3412. !--------------------------------------------------------------------------
  3413. !BOP
  3414. !
  3415. ! !IROUTINE: EMISSION_READGRIDBOXAREA
  3416. !
  3417. ! !DESCRIPTION:
  3418. ! reading gridbox surface areas for 0.5 x 0.5 Edgar 4
  3419. ! needed to scale the emissions from mass/m^2 to mass/grid
  3420. !\\
  3421. !\\
  3422. ! !INTERFACE:
  3423. !
  3424. subroutine emission_ReadGridboxArea(fname, recname, gridbox_area, dim_nlon, dim_nlat, status )
  3425. !
  3426. ! !INPUT PARAMETERS:
  3427. !
  3428. character(len=*), intent(in) :: fname
  3429. character(len=*), intent(in) :: recname
  3430. integer, intent(in) :: dim_nlon
  3431. integer, intent(in) :: dim_nlat
  3432. !
  3433. ! !OUTPUT PARAMETERS:
  3434. !
  3435. integer, intent(out) :: status
  3436. real, dimension(dim_nlon, dim_nlat), intent(out) :: gridbox_area
  3437. !
  3438. ! !REVISION HISTORY:
  3439. !
  3440. ! 1 Oct 2010 - Achim Strunk - v0
  3441. ! 1 Dec 2011 - Narcisa Banda - generalized it for any gridbox area size
  3442. !
  3443. ! !REMARKS:
  3444. !
  3445. !EOP
  3446. !------------------------------------------------------------------------
  3447. !BOC
  3448. character(len=*), parameter :: rname = mname//'/emission_ReadGridboxArea'
  3449. integer :: fid, varid
  3450. ! --- begin -----------------------------------
  3451. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  3452. IF_NOTOK_RETURN(status=1)
  3453. CALL MDF_Inq_VarID( fid, TRIM(recname), varid, status )
  3454. IF_ERROR_RETURN(status=1)
  3455. CALL MDF_Get_Var( fid, varid, gridbox_area, status )
  3456. IF_NOTOK_RETURN(status=1)
  3457. CALL MDF_Close( fid, status )
  3458. IF_NOTOK_RETURN(status=1)
  3459. status = 0
  3460. end subroutine emission_ReadGridboxArea
  3461. !EOC
  3462. !--------------------------------------------------------------------------
  3463. ! TM5 !
  3464. !--------------------------------------------------------------------------
  3465. !BOP
  3466. !
  3467. ! !IROUTINE: EMISSION_AR5_REGRID_AIRCRAFT
  3468. !
  3469. ! !DESCRIPTION: Vertical regridding of the AR5 aircraft data.
  3470. ! The vertical levels of the input data are hard coded.
  3471. ! (Taken from GFED_daily_AR5 (VH) and left as is)
  3472. !\\
  3473. !\\
  3474. ! !INTERFACE:
  3475. !
  3476. subroutine emission_ar5_regrid_aircraft(region, i0, j0, field_in, field_out, status )
  3477. !
  3478. ! !USES:
  3479. !
  3480. use meteodata, only : gph_dat
  3481. use tm5_distgrid, only : dgrid, get_distgrid
  3482. use dims, only : lm
  3483. !
  3484. ! !OUTPUT PARAMETERS:
  3485. !
  3486. integer, intent(out) :: status
  3487. !
  3488. ! !INPUT PARAMETERS:
  3489. !
  3490. integer, intent(in) :: region, i0, j0
  3491. real, dimension(i0:, j0:, 1:), intent(in) :: field_in
  3492. real, dimension(i0:, j0:, 1:), intent(out) :: field_out
  3493. !
  3494. ! !REVISION HISTORY:
  3495. ! 1 Oct 2010 - Achim Strunk - Taken from GFED_daily_AR5 (VH) and left as is
  3496. ! 3 Dec 2012 - Ph. Le Sager - modified for lat-lon mpi decomposition
  3497. ! - work with zoom regions
  3498. ! - mass conservation per column
  3499. !
  3500. ! !REMARKS:
  3501. !
  3502. !EOP
  3503. !------------------------------------------------------------------------
  3504. !BOC
  3505. character(len=*), parameter :: rname = mname//'/emission_ar5_regrid_aircraft'
  3506. integer, parameter :: lm_in=25
  3507. real, dimension(:,:,:), pointer :: gph ! geopotential height (m)
  3508. integer :: i,j,l
  3509. real, dimension(lm_in) :: height_in_min, height_in_max
  3510. real, allocatable :: dz(:), height(:)
  3511. real :: height_min,height_max
  3512. real :: height_out_min,height_out_max
  3513. real, dimension(lm_in), parameter :: height_in=(/ & ! Height in meter
  3514. 305., 915., 1525., 2135., 2745., 3355., 3965., 4575., 5185., 5795., &
  3515. 6405., 7015., 7625., 8235., 8845., 9455.,10065.,10675.,11285., &
  3516. 11895.,12505.,13115.,13725.,14335.,14945./)
  3517. real :: dz_in(25)
  3518. integer :: l_in, i1, i2, j1, j2, lmr
  3519. real :: total_in, total_out, total_ratio
  3520. ! --- begin --------------------------------------
  3521. call golabel()
  3522. gph => gph_dat(region)%data
  3523. CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  3524. lmr = lm(region)
  3525. allocate(dz(lmr), height(lmr+1))
  3526. ! sanity check
  3527. if (okdebug) then
  3528. if (i1/=i0 .or. j1/=j0) then
  3529. status = 1 ; TRACEBACK
  3530. return
  3531. end if
  3532. if (lm_in /= ubound(field_in,3) ) then
  3533. write(gol,*)'wrong vertical input resolution'; call goErr
  3534. status = 1
  3535. TRACEBACK; return
  3536. endif
  3537. if ((ubound(field_out,3)+1) /= ubound(gph,3)) then
  3538. write(gol,*)'wrong vertical output resolution'; call goErr
  3539. status = 1
  3540. TRACEBACK; return
  3541. endif
  3542. end if
  3543. ! locally flat atmosphere assumed
  3544. ! area linear in i,j
  3545. ! height above sea level
  3546. height_in_min(1)=0.
  3547. do l_in = 2,lm_in
  3548. height_in_min(l_in)=(height_in(l_in-1)+height_in(l_in))/2.
  3549. enddo
  3550. height_in_max(lm_in)=15555.
  3551. do l_in = 1,lm_in-1
  3552. height_in_max(l_in)=(height_in(l_in)+height_in(l_in+1))/2.
  3553. enddo
  3554. ! init
  3555. field_out = 0.0
  3556. ! regrid
  3557. do i=i1, i2
  3558. do j=j1, j2
  3559. total_in = 0.0
  3560. ! calculate total input emissions
  3561. do l_in=1, lm_in
  3562. dz_in(l_in) = height_in_max(l_in)-height_in_min(l_in)
  3563. total_in =total_in + field_in(i,j,l_in)*dz_in(l_in)
  3564. enddo
  3565. ! zero based height:
  3566. height(1) = 0.0
  3567. do l=1, lmr
  3568. dz(l) = gph(i,j,l+1) - gph(i,j,l)
  3569. height(l+1) = height(l) + dz(l)
  3570. enddo
  3571. do l=1,lmr-1
  3572. height_out_min=height(l)
  3573. height_out_max=height(l+1)
  3574. ! write(*,*)'DO AR5- regrid - C2',i,j,l,height_out_min,height_out_max
  3575. do l_in=1,lm_in
  3576. if (height_out_max .le. height_in_min(l_in)) exit
  3577. if (height_out_min .lt. height_in_max(l_in)) then
  3578. height_max=min(height_out_max,height_in_max(l_in))
  3579. height_min=max(height_out_min,height_in_min(l_in))
  3580. ! helpfield as field_in is ordered from high to low
  3581. ! field_out(i,j,l) = field_out(i,j,l) + helpfield2(i,j,lm_in-l_in+1)* &
  3582. ! (height_max-height_min)/(height_in_max(l_in)-height_in_min(l_in))
  3583. ! helpfield as field_in is ordered from low to high
  3584. ! write(*,*)'DO AR5- regrid - C',i,j,l,l_in,height_max-height_min
  3585. field_out(i,j,l) = field_out(i,j,l) + field_in(i,j,l_in)* &
  3586. (height_max-height_min) ! kg/m -> kg / gridbox
  3587. endif
  3588. enddo
  3589. enddo
  3590. ! conserve total exactly: not possible because units are in kg/m...
  3591. total_out = sum(field_out(i,j,:))
  3592. if (total_out /= 0) then
  3593. total_ratio = total_in/total_out
  3594. field_out(i,j,:) = field_out(i,j,:)*total_ratio
  3595. end if
  3596. enddo
  3597. enddo
  3598. deallocate(dz, height)
  3599. call golabel()
  3600. ! ok
  3601. status = 0
  3602. end subroutine emission_ar5_regrid_aircraft
  3603. !EOC
  3604. !--------------------------------------------------------------------------
  3605. ! TM5 !
  3606. !--------------------------------------------------------------------------
  3607. !BOP
  3608. !
  3609. ! !IROUTINE: EMISSION_MACC_READSECTOR
  3610. !
  3611. ! !DESCRIPTION: Read an MACC sector field out of an open file.
  3612. !\\
  3613. !\\
  3614. ! !INTERFACE:
  3615. !
  3616. subroutine emission_macc_ReadSector( fpath, comp, iyear, imonth, fext, recname, unit, emis, status )
  3617. !
  3618. ! !USES:
  3619. !
  3620. use chem_param, only : xmn, xmno2
  3621. !
  3622. ! !INPUT PARAMETERS:
  3623. !
  3624. character(len=*), intent(in) :: fpath ! dir
  3625. character(len=*), intent(in) :: comp ! species name (as in filename)
  3626. integer, intent(in) :: iyear
  3627. integer, intent(in) :: imonth
  3628. character(len=*), intent(in) :: fext ! tail of filename
  3629. character(len=*), intent(in) :: recname ! sector name
  3630. character(len=*), intent(in) :: unit
  3631. !
  3632. ! !OUTPUT PARAMETERS:
  3633. !
  3634. real, intent(out) :: emis(nlon360,nlat180,ar5_dim_3ddata)
  3635. integer, intent(out) :: status
  3636. !
  3637. ! !REVISION HISTORY:
  3638. ! 1 Oct 2010 - Achim Strunk -
  3639. ! 28 Nov 2012 - Ph. Le Sager - switch to MDF interface
  3640. ! 6 Jan 2014 - Ph. Le Sager - code for MACCity: 3D emission field to deal with IPCC aircraft file
  3641. !
  3642. ! !REMARKS:
  3643. !
  3644. !EOP
  3645. !------------------------------------------------------------------------
  3646. !BOC
  3647. character(len=*), parameter :: rname = mname//'/emission_macc_ReadSector'
  3648. character(len=256) :: fname
  3649. character(len=256) :: fname_gridboxarea
  3650. character(len=32) :: fcomp
  3651. integer :: fid, varid, year, lk
  3652. real :: emis_in( nlon720, nlat360, ar5_dim_3ddata, 1)
  3653. logical :: first=.true.
  3654. ! --- begin -----------------------------------
  3655. ! read in gridbox-area; same name as ar5 gridbox area file
  3656. if( .not. area_found_05 ) then
  3657. fname_gridboxarea = trim(emis_input_dir_mac)//'/'//trim(ar5_filestr_gridboxarea)
  3658. call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, &
  3659. & nlon720, nlat360, status )
  3660. IF_NOTOK_RETURN(status=1)
  3661. area_found_05 = .true.
  3662. endif
  3663. ! file name component:
  3664. fcomp = comp
  3665. year = valid_year( iyear, macc_avail, 'MACC', first)
  3666. first = .false.
  3667. ! zero field
  3668. emis = 0.0
  3669. !=== FILENAME
  3670. if (trim(recname) == "emiss_air") then ! If MACC-CITY, specific handling of aircraft emissions
  3671. ! available only for NO or BC
  3672. if ( (trim(fcomp) /= "NO").and.(trim(fcomp) /= "BC") ) return
  3673. write (fname,'(a,"/IPCC_emissions_",a,"_aircraft_",i4.4,"_0.5x0.5.nc")') trim(fpath), trim(fcomp), year
  3674. else
  3675. write (fname,'(a,"/JUELICH_MACC_reanalysis_",a,"_",i4.4,"_",a)') trim(fpath), trim(fcomp), year, trim(fext)
  3676. end if
  3677. !=== SCREEN OUT cases without data (There are more cases, but they are already handled in calling routines.)
  3678. ! ***************************************************************************
  3679. ! ****** THIS IS MESSY. IT NEEDS CONSOLIDATION: SHOULD BUILD LIST OF ********
  3680. ! ****** SECTORS PER SPECIES, LIKE ED42 ********
  3681. ! ***************************************************************************
  3682. if (trim(recname) == "emiss_oc") then
  3683. ! no "emiss_oc" for : C2H5OH, BIGALK, ISOPRENE, TERPENES, BIGENE, TOLUENE, CH2O, CH3CHO, CH3COCH3, MEK
  3684. ! only for : C2H6, C3H8, C2H4, C3H6, NH3, and CO
  3685. if ( (trim(fcomp) /= "C2H6").and.(trim(fcomp) /= "C3H8").and.(trim(fcomp) /= "C2H4").and.&
  3686. (trim(fcomp) /= "C3H6").and.(trim(fcomp) /= "NH3").and.(trim(fcomp) /= "CO") ) return
  3687. else if (trim(recname) == "emiss_anthro") then
  3688. ! there is no "emiss_anthro" for : ISOPRENE, TERPENES
  3689. if ( (trim(fcomp) == "ISOPRENE").or.(trim(fcomp) == "TERPENES") ) return
  3690. end if
  3691. if (trim(recname) == "emiss_bio") then
  3692. ! We arrive here if we are not using MEGAN. No "emiss_bio" for C2H5OH, BIGALK, BIGENE:
  3693. if ( (trim(fcomp) == "C2H5OH").or.(trim(fcomp) == "BIGALK").or.(trim(fcomp) == "BIGENE") ) return
  3694. endif
  3695. if (trim(fcomp) == "BC") then
  3696. if ((trim(recname) /= "emiss_anthro").and.(trim(recname) /= "emiss_air") ) return
  3697. endif
  3698. if ((trim(fcomp) == "OC").and.(trim(recname) /= "emiss_anthro")) return
  3699. !=== READ
  3700. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  3701. IF_NOTOK_RETURN(status=1)
  3702. CALL MDF_Inq_VarID( fid, trim(recname), varid, status )
  3703. IF_NOTOK_RETURN(status=1)
  3704. if( okdebug ) then
  3705. write (gol,'("EMISS-INFO - MACC - found `",a,"` emissions category in file `",a,"`")') trim(recname), trim(fname); call goPr
  3706. endif
  3707. ! 3D
  3708. if (trim(recname) == "emiss_air") then
  3709. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth/) )
  3710. IF_NOTOK_RETURN(status=1)
  3711. do lk = 1, ar5_dim_3ddata
  3712. ! convert from kg(species)/m^2/s to kg(species)/gridbox/s :
  3713. emis_in(:,:,lk,1) = emis_in(:,:,lk,1) * gridbox_area_05
  3714. ! now coarsen to nlon360,nlat180
  3715. emis(:,:,lk) = emission_coarsen_to_1x1( emis_in(:,:,lk,1) , nlon720, nlat360, .true., status )
  3716. IF_NOTOK_RETURN(status=1)
  3717. end do
  3718. else !2D
  3719. CALL MDF_Get_Var( fid, varid, emis_in(:,:,1,1), status, start=(/1,1,imonth/) )
  3720. IF_NOTOK_RETURN(status=1)
  3721. ! convert from kg(species)/m^2/s to kg(species)/s
  3722. emis_in(:,:,1,1) = emis_in(:,:,1,1) * gridbox_area_05
  3723. ! combine grid cells
  3724. emis(:,:,1) = emission_coarsen_to_1x1( emis_in(:,:,1,1), nlon720, nlat360, .true., status )
  3725. IF_NOTOK_RETURN(status=1)
  3726. endif
  3727. CALL MDF_Close( fid, status )
  3728. IF_NOTOK_RETURN(status=1)
  3729. status = 0
  3730. end subroutine Emission_macc_ReadSector
  3731. !EOC
  3732. !--------------------------------------------------------------------------
  3733. ! TM5 !
  3734. !--------------------------------------------------------------------------
  3735. !BOP
  3736. !
  3737. ! !IROUTINE: EMISSION_ED4_READSECTOR
  3738. !
  3739. ! !DESCRIPTION: Read an EDAGR-4 sector field out of an open file.
  3740. !
  3741. !\\
  3742. !\\
  3743. ! !INTERFACE:
  3744. !
  3745. function emission_ed4_Read2DRecord( fname, secname, status )
  3746. !
  3747. ! !RETURN VALUE:
  3748. !
  3749. real :: emission_ed4_Read2DRecord(nlon360,nlat180)
  3750. !
  3751. ! !INPUT PARAMETERS:
  3752. !
  3753. character(len=*), intent(in) :: fname
  3754. character(32), intent(in) :: secname
  3755. !
  3756. ! !OUTPUT PARAMETERS:
  3757. !
  3758. integer, intent(out) :: status
  3759. !
  3760. ! !REVISION HISTORY:
  3761. ! 1 Apr 2012 - Narcisa Banda - v0
  3762. !
  3763. ! !REMARKS:
  3764. !
  3765. !EOP
  3766. !------------------------------------------------------------------------
  3767. !BOC
  3768. character(len=*), parameter :: rname = mname//'/emission_ed4_Read2DRecord'
  3769. integer :: fid, varid
  3770. real, dimension(nlon720,nlat360) :: emis_in
  3771. ! initialise
  3772. emission_ed4_Read2DRecord = 0.0
  3773. ! search for the record
  3774. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  3775. IF_NOTOK_RETURN(status=1)
  3776. CALL MDF_Inq_VarID( fid, secname, varid, status )
  3777. IF_ERROR_RETURN(status=1)
  3778. if ( varid < 0 ) then
  3779. write (gol,'("EMISS-INFO - ED41 - no `",a,"` emissions in file", a)') &
  3780. trim(secname), trim(fname); call goPr
  3781. status=1; TRACEBACK; return
  3782. else
  3783. if( okdebug ) then
  3784. write (gol,'("EMISS-INFO - ED41 - found `",a,"` emissions in file", a)') &
  3785. trim(secname), trim(fname); call goPr
  3786. endif
  3787. CALL MDF_Get_Var( fid, varid, emis_in, status )
  3788. IF_NOTOK_RETURN(status=1)
  3789. ! convert from kg(species)/m^2/s to kg(species)/s
  3790. emis_in = emis_in * gridbox_area_05
  3791. ! combine grid cells
  3792. emission_ed4_Read2DRecord = emission_coarsen_to_1x1( emis_in , nlon720, nlat360, .true., status )
  3793. IF_NOTOK_RETURN(status=1)
  3794. end if
  3795. CALL MDF_Close( fid, status )
  3796. IF_NOTOK_RETURN(status=1)
  3797. status = 0
  3798. return
  3799. end function Emission_ed4_Read2DRecord
  3800. !EOC
  3801. !--------------------------------------------------------------------------
  3802. ! TM5 !
  3803. !--------------------------------------------------------------------------
  3804. !BOP
  3805. !
  3806. ! !IROUTINE: EMISSION_ED4_READSECTOR
  3807. !
  3808. ! !DESCRIPTION: Reading one sector of the files to be interpolated and
  3809. ! returning an interpolated 3d emission field (d3data)
  3810. !\\
  3811. !\\
  3812. ! !INTERFACE:
  3813. !
  3814. subroutine emission_ed4_ReadSector( fpath, comp, compl, iyear, imonth, sector, version, unit, d3data, status)
  3815. !
  3816. ! !INPUT PARAMETERS:
  3817. !
  3818. character(len=*), intent(in) :: fpath
  3819. character(len=*), intent(in) :: comp
  3820. character(len=*), intent(in) :: compl
  3821. integer, intent(in) :: iyear
  3822. integer, intent(in) :: sector
  3823. character(len=*), intent(in) :: version
  3824. character(len=*), intent(in) :: unit
  3825. integer, intent(in) :: imonth
  3826. !
  3827. ! !OUTPUT PARAMETERS:
  3828. !
  3829. integer, intent(out) :: status
  3830. real, intent(out) :: d3data( nlon360, nlat180, ar5_dim_3ddata)
  3831. !
  3832. ! !REVISION HISTORY:
  3833. ! 1 Apr 2012 - Narcisa Banda - v0
  3834. !
  3835. ! !REMARKS:
  3836. !
  3837. !EOP
  3838. !------------------------------------------------------------------------
  3839. !BOC
  3840. character(len=*), parameter :: rname = mname//'/emission_ed4_readsector'
  3841. character(len=256) :: fname
  3842. character(len=256) :: fname_gridboxarea
  3843. character(len=sector_name_len) :: secname
  3844. character(len=32) :: recname
  3845. character(len=4) :: ver
  3846. integer :: lt, year
  3847. logical :: existfile
  3848. logical :: first41=.true., first42=.true.
  3849. integer, dimension(2) :: ltimes
  3850. character(len=4), dimension(2) :: ed41_cyears
  3851. real, dimension(2) :: ed41_ipcoef_years
  3852. ! --- begin -----------------------------------
  3853. ! initialise target array
  3854. d3data = 0.0
  3855. ! read in gridbox-area; once per CPU
  3856. if( .not. area_found_05 ) then
  3857. fname_gridboxarea = trim(emis_input_dir_ar5)//'/'//trim(ed4_filestr_gridboxarea)
  3858. call emission_ReadGridboxArea(fname_gridboxarea, 'cell_area', gridbox_area_05, &
  3859. & nlon720, nlat360, status )
  3860. IF_NOTOK_RETURN(status=1)
  3861. area_found_05 = .true.
  3862. endif
  3863. ! ------------------------
  3864. ! target year(s)
  3865. ! ------------------------
  3866. if (version == 'ED41') then
  3867. ver='41'
  3868. year = valid_year( iyear, ed41_avail, 'EDGAR 4.1', first41)
  3869. first41=.false.
  3870. allocate( ltimeind( ed41_nr_avail_yrs ) )
  3871. ltimeind = .false.
  3872. where( ed41_avail_yrs < year ) ltimeind = .true.
  3873. ! times(1): index representing time instance earlier than current year
  3874. ! times(2): -"- -"- later than current year
  3875. ltimes(2) = count( ltimeind ) + 1
  3876. ltimes(1) = max( ltimes(2) - 1, 1 )
  3877. ! check a match with repository (in order to copy only one file instead of two)
  3878. if( ed41_avail_yrs(ltimes(2)) == year ) ltimes(1) = ltimes(2)
  3879. deallocate( ltimeind )
  3880. ! ed41_cyears will contain strings with the years
  3881. write(ed41_cyears(1),'(I4.4)') ed41_avail_yrs(ltimes(1))
  3882. write(ed41_cyears(2),'(I4.4)') ed41_avail_yrs(ltimes(2))
  3883. ! ed41_ipcoef_years will contain interpolation coefficients
  3884. ! default: factors 1.0/0.0
  3885. ed41_ipcoef_years(1) = 1.0
  3886. ed41_ipcoef_years(2) = 0.0
  3887. if( ltimes(2) /= ltimes(1) ) then
  3888. ed41_ipcoef_years(1) = (ed41_avail_yrs(ltimes(2)) - year) / &
  3889. real( ed41_avail_yrs(ltimes(2)) - ed41_avail_yrs(ltimes(1)) )
  3890. ed41_ipcoef_years(2) = 1.0 - ed41_ipcoef_years(1)
  3891. end if
  3892. else if (version == 'ED42') then
  3893. ver='42'
  3894. year = valid_year( iyear, ed42_avail, 'EDGAR 4.2', first42)
  3895. first42=.false.
  3896. else
  3897. write (gol,'("ERROR - This version of EDGAR has not been implemented ")'); call goErr
  3898. status=1; TRACEBACK; return
  3899. endif
  3900. ! ------------------------
  3901. ! read files (EDv4.1 - index=1: earlier file; index=2: later file)
  3902. ! ------------------------
  3903. recname = 'emi_'//trim(compl)
  3904. if (version=='ED41') then
  3905. do lt = 1, 2
  3906. if (ed41_ipcoef_years(lt) == 0.) cycle
  3907. write (fname,'(a,"/v",a,"_",a,"_",a,"_IPCC_",a,".0.5x0.5.nc")') trim(fpath), trim(ver), trim(comp), &
  3908. & ed41_cyears(lt), trim(sectors_def(sector)%name)
  3909. ! test existence of file
  3910. inquire( file=trim(fname), exist=existfile)
  3911. if( .not. existfile ) then
  3912. write (gol,'(" EDGAR4.1 - file `",a,"` not found ")') trim(fname); call goErr
  3913. status=1; TRACEBACK; return
  3914. end if
  3915. ! distinguish 2d/3d sectors
  3916. if( sectors_def(sector)%f3d ) then
  3917. d3data(:,:,:) = d3data(:,:,:) + ed41_ipcoef_years(lt) * &
  3918. emission_ar5_Read3DRecord( trim(fname), recname, imonth, status )
  3919. else
  3920. d3data(:,:,1) = d3data(:,:,1) + ed41_ipcoef_years(lt) * &
  3921. emission_ed4_Read2DRecord( trim(fname), recname, status )
  3922. end if
  3923. IF_NOTOK_RETURN(status=1)
  3924. enddo
  3925. else
  3926. write (fname,'(a,"/v",a,"_",a,"_",i4.4,"_IPCC_",a,".0.5x0.5.nc")') trim(fpath), trim(ver), trim(comp), &
  3927. & year, trim(sectors_def(sector)%name)
  3928. ! test existence of file
  3929. inquire( file=trim(fname), exist=existfile)
  3930. if( .not. existfile ) then
  3931. write (gol,'(" EDGAR4.2 - file `",a,"` not found ")') trim(fname); call goErr
  3932. status=1; TRACEBACK; return
  3933. end if
  3934. if( sectors_def(sector)%f3d ) then
  3935. d3data(:,:,:) = d3data(:,:,:) + emission_ar5_Read3DRecord( trim(fname), recname, imonth, status )
  3936. else
  3937. d3data(:,:,1) = d3data(:,:,1) + emission_ed4_Read2DRecord( trim(fname), recname, status )
  3938. end if
  3939. IF_NOTOK_RETURN(status=1)
  3940. end if
  3941. status=0
  3942. end subroutine emission_ed4_ReadSector
  3943. !EOC
  3944. !--------------------------------------------------------------------------
  3945. ! TM5 !
  3946. !--------------------------------------------------------------------------
  3947. !BOP
  3948. !
  3949. ! !IROUTINE: EMISSION_LPJ_READSECTOR
  3950. !
  3951. ! !DESCRIPTION: Read an LPJ sector field out of an open file.
  3952. !\\
  3953. !\\
  3954. ! !INTERFACE:
  3955. !
  3956. subroutine emission_LPJ_ReadSector( fpath, iyear, imonth, sector, unit, emis, status )
  3957. !
  3958. ! !USES:
  3959. !
  3960. use dims, only : sec_year
  3961. !
  3962. ! !INPUT PARAMETERS:
  3963. !
  3964. character(len=*), intent(in) :: fpath
  3965. integer, intent(in) :: iyear
  3966. integer, intent(in) :: imonth
  3967. character(len=*), intent(in) :: sector
  3968. character(len=*), intent(in) :: unit
  3969. !
  3970. ! !OUTPUT PARAMETERS:
  3971. !
  3972. real, intent(out) :: emis(nlon360,nlat180)
  3973. integer, intent(out) :: status
  3974. !
  3975. ! !REVISION HISTORY:
  3976. ! 1 Oct 2010 - Achim Strunk - v0
  3977. !
  3978. ! !REMARKS:
  3979. !
  3980. !EOP
  3981. !------------------------------------------------------------------------
  3982. !BOC
  3983. character(len=*), parameter :: rname = mname//'/emission_LPJ_ReadSector'
  3984. ! --- local -----------------------------------
  3985. character(len=256) :: fname
  3986. character(len=256) :: fname_gridboxarea
  3987. real :: emis_in(lpj_dim_nlon,lpj_dim_nlat,1)
  3988. integer :: fid, varid, year, i, j
  3989. logical :: first=.true.
  3990. ! --- begin -----------------------------------
  3991. ! read in gridbox-area; once per CPU
  3992. if( .not. lpj_area_found ) then
  3993. fname_gridboxarea = trim(fpath)//'/'//trim(lpj_filestr_gridboxarea)
  3994. call emission_ReadGridboxArea(fname_gridboxarea, 'areaw', lpj_gridbox_area, &
  3995. & lpj_dim_nlon, lpj_dim_nlat, status )
  3996. lpj_area_found = .true.
  3997. IF_NOTOK_RETURN(status=1)
  3998. endif
  3999. ! Following emissions are from the EU HYMN project via the LPJ model (Spahni et al., Biogeosciences, 2011)
  4000. ! Three categories used: peatlands, wetsoils and wetlands
  4001. ! units in inputfiles: g CH4/y/m2
  4002. ! coverage is 60S - 90N ; no emissions south of 60S
  4003. ! grid cells with any emission have values -999 there skip in the summing across all emission types
  4004. !
  4005. ! CALCULATION EXAMPLE FOR CH4 FLUXES (e.g. for the year 2004):
  4006. ! ***************************************************************************
  4007. ! PEATLAND FLUX per grid cell (PLFpgc):
  4008. ! PLF = lpj_NHpeatlands_2004.nc(ch4_flux) * 0.75
  4009. ! PLFpgc = PLF * A * PF/2.61
  4010. ! "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]"
  4011. ! "The PF map overestimates total peatland area by a factor of 2.61 compared to Prigent et al., 2007"
  4012. !RICE AGRICULTURE FLUX per grid cell (RAFpgc) - Not Used as implicitly in EDGAR 4.0
  4013. !RAF = lpj_rice_2004.nc(ch4_flux)
  4014. !RAFpgc = RAF * A * RF
  4015. !WETLAND FLUX per grid cell (WLFpgc):
  4016. !WLF = lpj_wetlands_2004.nc(ch4_flux)
  4017. !WLFpgc = WLF * A * IF
  4018. !WETSOILS FLUX per grid cell (WSFpgc):
  4019. !WSF = lpj_wetsoils_2004.nc(ch4_flux)
  4020. !WSFpgc = WSF * A * (1-PF/2.61-IF-RF)
  4021. !"PF is set =0 between 60°S-45°N, IF is set =0 between 45°N-90°N"
  4022. !TOTAL NET FLUX per grid cell (TFpgc):
  4023. !TFpgc = PLFpgc + WLFpgc + RAFpgc + WSFpgc - SCFpgc
  4024. !e.g. for 2004 this results in a global net source:
  4025. !TFpgc = 28.17 + 81.31 + 43.11 + 63.16 - 25.83 Tg CH4/year
  4026. !TFpgc = 189.92 Tg CH4/year
  4027. !
  4028. ! sink term for uptake of CH4 by soils given in mg CH4/ y/ m2 / ppmv(CH4)
  4029. ! therefore store field and then apply later on using latitudinal average for CH4
  4030. !
  4031. ! SOIL CONSUMPTION FLUX per grid cell (SCFpgc):
  4032. ! SCF = lpj_soilconsumption_2004.nc(ch4_flux)
  4033. ! or
  4034. ! SCF = lpj_soilconsumption-perconc_2004.nc(ch4_flux) * atm. CH4 (in ppmv)
  4035. ! SCFpgc = SCF * A * (1-IF-RF) "peatland grid cells are already excluded"
  4036. if( .not. lpj_fractions_found ) then
  4037. fname = trim(fpath)//'/maps/lpj_natwet_fraction.nc'
  4038. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4039. IF_NOTOK_RETURN(status=1)
  4040. CALL MDF_Inq_VarID( fid, 'inund', varid, status )
  4041. IF_ERROR_RETURN(status=1)
  4042. CALL MDF_Get_Var( fid, varid, lpj_frac_wetlands, status )
  4043. IF_NOTOK_RETURN(status=1)
  4044. CALL MDF_Close( fid, status )
  4045. IF_NOTOK_RETURN(status=1)
  4046. fname = trim(fpath)//'/maps/lpj_rice_fraction.nc'
  4047. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4048. IF_NOTOK_RETURN(status=1)
  4049. CALL MDF_Inq_VarID( fid, 'rice', varid, status )
  4050. IF_ERROR_RETURN(status=1)
  4051. CALL MDF_Get_Var( fid, varid, lpj_frac_rice, status )
  4052. IF_NOTOK_RETURN(status=1)
  4053. CALL MDF_Close( fid, status )
  4054. IF_NOTOK_RETURN(status=1)
  4055. fname = trim(fpath)//'/maps/lpj_peatland_fraction.nc'
  4056. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4057. IF_NOTOK_RETURN(status=1)
  4058. CALL MDF_Inq_VarID( fid, 'scfrac', varid, status )
  4059. IF_ERROR_RETURN(status=1)
  4060. CALL MDF_Get_Var( fid, varid, lpj_frac_peatlands, status )
  4061. IF_NOTOK_RETURN(status=1)
  4062. CALL MDF_Close( fid, status )
  4063. IF_NOTOK_RETURN(status=1)
  4064. lpj_fractions_found = .true.
  4065. lpj_frac_peatlands = lpj_frac_peatlands/2.61
  4066. endif
  4067. year = valid_year( iyear, lpj_avail, 'LPJ', first)
  4068. first=.false.
  4069. ! target file name with year
  4070. if (trim(sector).eq.'soilconsumption') then
  4071. write (fname,'(a,"/",a,"/lpj_",a,"-perconc_",i4.4,".nc")') trim(fpath), trim(sector), trim(sector), year
  4072. else
  4073. write (fname,'(a,"/",a,"/lpj_",a,"_",i4.4,".nc")') trim(fpath), trim(sector), trim(sector), year
  4074. end if
  4075. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4076. IF_NOTOK_RETURN(status=1)
  4077. CALL MDF_Inq_VarID( fid, 'ch4_flux', varid, status )
  4078. IF_NOTOK_RETURN(status=1)
  4079. if( okdebug ) then
  4080. write (gol,'("EMISS-INFO - LPJ - found ch4 emissions for sector `",a,"` in file ",a)') &
  4081. trim(sector), trim(fname); call goPr
  4082. endif
  4083. emis = 0.0
  4084. ! extract record for requested month
  4085. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) )
  4086. IF_NOTOK_RETURN(status=1)
  4087. do j=1,lpj_dim_nlat
  4088. do i=1, lpj_dim_nlon
  4089. if(emis_in(i,j,1)>0.) then
  4090. select case( trim(sector) )
  4091. case('wetlands')
  4092. !convert from [g m-2 per year] to [kg per cell per sec]
  4093. 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)
  4094. case('peatlands')
  4095. 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)
  4096. case('wetsoils')
  4097. emis(i,j+30) = emis_in(i,j,1)*lpj_gridbox_area(i,j)*&
  4098. &(1.-lpj_frac_wetlands(i,j,imonth)-lpj_frac_peatlands(i,j)-lpj_frac_rice(i,j,imonth))*(1.e-3/sec_year)
  4099. case('rice')
  4100. 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)
  4101. case('soilconsumption')
  4102. !convert from [mg m-2 per year per ppmv] to [kg per cell per sec per ppmv]
  4103. emis(i,j+30) = emis_in(i,j,1)*lpj_gridbox_area(i,j)*&
  4104. &(1. - lpj_frac_wetlands(i,j,imonth) - lpj_frac_rice(i,j,imonth))*(1.e-6/sec_year)
  4105. end select
  4106. endif
  4107. enddo
  4108. enddo
  4109. ! no coarsening needed, but used to shift the longitudes from [0, 360]
  4110. ! to [-180, 180]
  4111. emis = emission_coarsen_to_1x1( emis, nlon360, nlat180,.true., status )
  4112. CALL MDF_Close( fid, status )
  4113. IF_NOTOK_RETURN(status=1)
  4114. status = 0
  4115. end subroutine Emission_LPJ_ReadSector
  4116. !EOC
  4117. !--------------------------------------------------------------------------
  4118. ! TM5 !
  4119. !--------------------------------------------------------------------------
  4120. !BOP
  4121. !
  4122. ! !IROUTINE: EMISSION_HYMN_READSECTOR
  4123. !
  4124. ! !DESCRIPTION: Read a HYMN Non-LPJ sector field out of an open file.
  4125. !\\
  4126. !\\
  4127. ! !INTERFACE:
  4128. !
  4129. subroutine emission_HYMN_ReadSector( fpath, sector, unit, emis, status )
  4130. !
  4131. ! !USES:
  4132. !
  4133. use dims, only : sec_year, dxy11
  4134. !
  4135. ! !INPUT PARAMETERS:
  4136. !
  4137. character(len=*), intent(in) :: fpath
  4138. character(len=*), intent(in) :: sector
  4139. character(len=*), intent(in) :: unit
  4140. !
  4141. ! !OUTPUT PARAMETERS:
  4142. !
  4143. real, intent(out) :: emis(nlon360,nlat180)
  4144. integer, intent(out) :: status
  4145. !
  4146. ! !REVISION HISTORY:
  4147. ! 1 Oct 2010 - Achim Strunk - v0
  4148. !
  4149. ! !REMARKS:
  4150. !
  4151. !EOP
  4152. !------------------------------------------------------------------------
  4153. !BOC
  4154. character(len=*), parameter :: rname = mname//'/emission_HYMN_ReadSector'
  4155. ! --- local -----------------------------------
  4156. character(len=256) :: fname
  4157. character(len=256) :: fname_gridboxarea
  4158. integer :: fid, varid, i, j
  4159. real :: emis_in(nlon360,nlat180,1,1)
  4160. character(len=80) :: title
  4161. character(len=80) :: units
  4162. ! --- begin -----------------------------------
  4163. ! target file name with year
  4164. select case(trim(sector))
  4165. case('oceans')
  4166. write (fname,'(a,"/CH4-natural-nonLPJ/CH4-N40-Lambert-0000-sfc-glb100x100.nc4")' ) trim(fpath)
  4167. case('wildanimals')
  4168. write (fname,'(a,"/CH4-natural-nonLPJ/CH4-N70-Olson-0000-sfc-glb100x100.nc4")' ) trim(fpath)
  4169. case('termites')
  4170. write (fname,'(a,"/CH4-natural-nonLPJ/CH4-N71-Sanderson-0000-sfc-glb100x100.nc4")') trim(fpath)
  4171. end select
  4172. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4173. IF_NOTOK_RETURN(status=1)
  4174. CALL MDF_Inq_VarID( fid, 'field', varid, status )
  4175. IF_NOTOK_RETURN(status=1)
  4176. if( okdebug ) then
  4177. write (gol,'("EMISS-INFO - HYMN - found ch4 emissions from sector `",a,"` in file ",a)') &
  4178. trim(sector), trim(fname); call goPr
  4179. endif
  4180. emis = 0.0
  4181. CALL MDF_Get_Var( fid, varid, emis_in, status )
  4182. IF_NOTOK_RETURN(status=1)
  4183. ! from [kg/cell/yr] to [kg/cell/sec]
  4184. emis(:,:) = emis_in(:,:,1,1)/sec_year
  4185. CALL MDF_Close( fid, status )
  4186. IF_NOTOK_RETURN(status=1)
  4187. status = 0
  4188. end subroutine Emission_HYMN_ReadSector
  4189. !EOC
  4190. !--------------------------------------------------------------------------
  4191. ! TM5 !
  4192. !--------------------------------------------------------------------------
  4193. !BOP
  4194. !
  4195. ! !IROUTINE: emission_gfed_ReadSector
  4196. !
  4197. ! !DESCRIPTION: Read GFEDv3 out of an open file.
  4198. !\\
  4199. !\\
  4200. ! !INTERFACE:
  4201. !
  4202. subroutine emission_gfed_ReadSector( fpath, comp, iyear, imonth, recname, unit, emis, status )
  4203. !
  4204. ! !USES:
  4205. !
  4206. use chem_param, only : xmn, xmno2
  4207. !
  4208. ! !INPUT PARAMETERS:
  4209. !
  4210. character(len=*), intent(in) :: fpath
  4211. character(len=*), intent(in) :: comp
  4212. integer, intent(in) :: iyear
  4213. integer, intent(in) :: imonth
  4214. character(len=*), intent(in) :: recname
  4215. character(len=*), intent(in) :: unit
  4216. !
  4217. ! !OUTPUT PARAMETERS:
  4218. !
  4219. real, intent(out) :: emis(nlon360,nlat180)
  4220. integer, intent(out) :: status
  4221. !
  4222. ! !REVISION HISTORY:
  4223. ! 1 Oct 2010 - Achim Strunk -
  4224. !
  4225. ! !REMARKS:
  4226. !
  4227. !EOP
  4228. !------------------------------------------------------------------------
  4229. !BOC
  4230. character(len=*), parameter :: rname = mname//'/emission_gfed_ReadSector'
  4231. ! --- local -----------------------------------
  4232. character(len=256) :: fname
  4233. real :: emis_in(nlon720,nlat360,1)
  4234. real :: emis_help(nlon360,nlat180)
  4235. integer :: fid, varid, year, j
  4236. logical :: first=.true.
  4237. ! --- begin -----------------------------------
  4238. ! target file name with year
  4239. year = valid_year( iyear, gfed3_avail, 'GFEDv3', first)
  4240. first=.false.
  4241. write (fname,'(a,"/GFEDv3_surface_",a,"_",i4.4,".0.5x0.5.nc")') trim(fpath), trim(comp), year
  4242. ! read in gridbox-area; once per CPU
  4243. if( .not. area_found_05 ) then
  4244. call emission_ReadGridboxArea(fname, 'gridbox_area', gridbox_area_05, &
  4245. & nlon720, nlat360, status )
  4246. IF_NOTOK_RETURN(status=1)
  4247. area_found_05 = .true.
  4248. endif
  4249. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4250. IF_NOTOK_RETURN(status=1)
  4251. CALL MDF_Inq_VarID( fid, trim(recname), varid, status )
  4252. IF_ERROR_RETURN(status=1)
  4253. if ( varid < 0 ) then
  4254. write (gol,'("EMISS-INFO - GFEDv3 - no `",a,"` emissions for `",a,"` in file ",a)') &
  4255. trim(recname), trim(comp), trim(fname); call goErr
  4256. status=1; TRACEBACK; return
  4257. else
  4258. if( okdebug ) then
  4259. write (gol,'("EMISS-INFO - GFEDv3 - found `",a,"` emissions for `",a,"` in file ",a)') &
  4260. trim(recname), trim(comp), trim(fname); call goPr
  4261. endif
  4262. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) )
  4263. IF_NOTOK_RETURN(status=1)
  4264. ! convert from kg(species)/m^2/s to kg(species)/s
  4265. emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05
  4266. ! combine grid cells :
  4267. if (trim(comp)=='bc' .or. trim(comp)=='oc') then
  4268. ! GFED3 emissions of BC and OC are correctly given in the files.
  4269. ! They don't need a shift in the zonal direction, but latitudes need to be reversed.
  4270. emis_help = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .false., status )
  4271. IF_NOTOK_RETURN(status=1)
  4272. do j=1,nlat180
  4273. emis(:,j)=emis_help(:,nlat180-j+1)
  4274. end do
  4275. else
  4276. ! GFED3 emissions of other components are erroneously shifted by 180 degrees in the files.
  4277. ! This is corrected by applying a shift to the data.
  4278. emis = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .true., status )
  4279. IF_NOTOK_RETURN(status=1)
  4280. endif
  4281. endif
  4282. CALL MDF_Close( fid, status )
  4283. IF_NOTOK_RETURN(status=1)
  4284. status = 0
  4285. end subroutine Emission_gfed_ReadSector
  4286. !EOC
  4287. !--------------------------------------------------------------------------
  4288. ! TM5 !
  4289. !--------------------------------------------------------------------------
  4290. !BOP
  4291. !
  4292. ! !IROUTINE: emission_retro_ReadSector
  4293. !
  4294. ! !DESCRIPTION: Read a RETRO sector field out of an open file.
  4295. !\\
  4296. !\\
  4297. ! !INTERFACE:
  4298. !
  4299. subroutine emission_retro_ReadSector( fpath, comp, iyear, imonth, recname, unit, emis, status )
  4300. !
  4301. ! !USES:
  4302. !
  4303. use chem_param, only : xmn, xmno2
  4304. !
  4305. ! !INPUT PARAMETERS:
  4306. !
  4307. character(len=*), intent(in) :: fpath
  4308. character(len=*), intent(in) :: comp
  4309. integer, intent(in) :: iyear
  4310. integer, intent(in) :: imonth
  4311. character(len=*), intent(in) :: recname
  4312. character(len=*), intent(in) :: unit
  4313. !
  4314. ! !OUTPUT PARAMETERS:
  4315. !
  4316. real, intent(out) :: emis(nlon360,nlat180)
  4317. integer, intent(out) :: status
  4318. !
  4319. ! !REVISION HISTORY:
  4320. ! 1 Oct 2010 - Achim Strunk -
  4321. !
  4322. ! !REMARKS:
  4323. !
  4324. !EOP
  4325. !------------------------------------------------------------------------
  4326. !BOC
  4327. character(len=*), parameter :: rname = mname//'/emission_retro_ReadSector'
  4328. character(len=256) :: fname
  4329. real :: emis_in(nlon720,nlat360,1)
  4330. integer :: fid, varid, year
  4331. logical :: first=.true.
  4332. ! --- begin -----------------------------------
  4333. year = valid_year( iyear, retro_avail, 'RETRO', first)
  4334. first=.false.
  4335. write (fname,'(a,"/RETRO_FIRES_V2_",i4.4,"_",a,"_aggregated.nc")') trim(fpath), year, trim(comp)
  4336. ! read in gridbox-area
  4337. if( .not. area_found_05 ) then
  4338. call emission_ReadGridboxArea(fname, 'gridbox_area', gridbox_area_05, &
  4339. & nlon720, nlat360, status )
  4340. IF_NOTOK_RETURN(status=1)
  4341. area_found_05 = .true.
  4342. endif
  4343. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4344. IF_NOTOK_RETURN(status=1)
  4345. CALL MDF_Inq_VarID( fid, trim(recname), varid, status )
  4346. IF_ERROR_RETURN(status=1)
  4347. if ( varid < 0 ) then
  4348. write (gol,'("EMISS-INFO - RETRO - no `",a,"` emissions for `",a,"` in file ", a)') &
  4349. trim(recname), trim(comp), trim(fname); call goErr
  4350. status=1; TRACEBACK; return
  4351. else
  4352. if( okdebug ) then
  4353. write (gol,'("EMISS-INFO - RETRO - found `",a,"` emissions for `",a,"` in file ", a)') &
  4354. trim(recname), trim(comp), trim(fname); call goPr
  4355. endif
  4356. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) )
  4357. IF_NOTOK_RETURN(status=1)
  4358. !convert from kg(species)/m^2/s to kg(species)/s
  4359. emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05
  4360. ! combine grid cells :
  4361. emis = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .true., status )
  4362. IF_NOTOK_RETURN(status=1)
  4363. end if ! emis category found
  4364. CALL MDF_Close( fid, status )
  4365. IF_NOTOK_RETURN(status=1)
  4366. status = 0
  4367. end subroutine Emission_retro_ReadSector
  4368. !EOC
  4369. !--------------------------------------------------------------------------
  4370. ! TM5 !
  4371. !--------------------------------------------------------------------------
  4372. !BOP
  4373. !
  4374. ! !IROUTINE: emission_megan_ReadSector
  4375. !
  4376. ! !DESCRIPTION: Read a MACC-MEGAN sector field out of an open file.
  4377. !\\
  4378. !\\
  4379. ! !INTERFACE:
  4380. !
  4381. subroutine emission_megan_ReadSector( fpath, comp, iyear, imonth, recname, unit, emis, status )
  4382. !
  4383. ! !USES:
  4384. !
  4385. use chem_param, only : xmn, xmno2
  4386. !
  4387. ! !INPUT PARAMETERS:
  4388. !
  4389. character(len=*), intent(in) :: fpath
  4390. character(len=*), intent(in) :: comp
  4391. integer, intent(in) :: iyear
  4392. integer, intent(in) :: imonth
  4393. character(len=*), intent(in) :: recname
  4394. character(len=*), intent(in) :: unit
  4395. !
  4396. ! !OUTPUT PARAMETERS:
  4397. !
  4398. real, intent(out) :: emis(nlon360,nlat180)
  4399. integer, intent(out) :: status
  4400. integer :: i,j
  4401. !
  4402. ! REVISION HISTORY:
  4403. ! 29 Jan 2014 - Jason Williams -
  4404. !
  4405. ! !REMARKS:
  4406. !
  4407. !EOP
  4408. !------------------------------------------------------------------------
  4409. !BOC
  4410. character(len=*), parameter :: rname = mname//'/emission_megan_ReadSector'
  4411. character(len=256) :: fname
  4412. real :: emis_in(nlon720,nlat360,1)
  4413. real :: flip_array(360,180)
  4414. integer :: fid, varid, year
  4415. logical :: first=.true.
  4416. ! --- begin -----------------------------------
  4417. ! target file name with year
  4418. year = valid_year( iyear, megan_avail, 'MACC-MEGAN', first)
  4419. first=.false.
  4420. write (fname,'(a,"/MEGAN-MACC_biogenic_",i4.4,"_",a,".nc")') trim(fpath), year, trim(comp)
  4421. ! read in gridbox-area; once per CPU
  4422. if( .not. area_found_05 ) then
  4423. call emission_ReadGridboxArea(fname, 'gridbox_area', gridbox_area_05, nlon720, nlat360, status )
  4424. IF_NOTOK_RETURN(status=1)
  4425. area_found_05 = .true.
  4426. endif
  4427. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  4428. IF_NOTOK_RETURN(status=1)
  4429. CALL MDF_Inq_VarID( fid, trim(recname), varid, status )
  4430. IF_ERROR_RETURN(status=1)
  4431. if ( varid < 0 ) then
  4432. write (gol,'("EMISS-INFO - MACC-MEGAN - no `",a,"` emissions for `",a,"` in file ", a)') &
  4433. trim(recname), trim(comp), trim(fname); call goErr
  4434. status=1; TRACEBACK; return
  4435. else
  4436. if (okdebug) then
  4437. write (gol,'("EMISS-INFO - MACC-MEGAN - found `",a,"` emissions for `",a,"` in file ", a)') &
  4438. trim(recname), trim(comp), trim(fname); call goPr
  4439. endif
  4440. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,imonth/) )
  4441. IF_NOTOK_RETURN(status=1)
  4442. !convert from kg(species)/m^2/s to kg(species)/s
  4443. emis_in(:,:,1) = emis_in(:,:,1) * gridbox_area_05
  4444. ! combine grid cells :
  4445. emis = emission_coarsen_to_1x1( emis_in(:,:,1), nlon720, nlat360, .true., status )
  4446. IF_NOTOK_RETURN(status=1)
  4447. flip_array(:,:)=emis(:,:)
  4448. !
  4449. ! flip the array
  4450. !
  4451. do j=1,180
  4452. emis(:,j)=flip_array(:,(180-j)+1)
  4453. enddo
  4454. do i=1,180
  4455. flip_array(i,:)=emis(i+180,:)
  4456. flip_array(i+180,:)=emis(i,:)
  4457. enddo
  4458. do j=1,180
  4459. emis(:,j)=flip_array(:,j)
  4460. enddo
  4461. end if ! emis category found
  4462. CALL MDF_Close( fid, status )
  4463. IF_NOTOK_RETURN(status=1)
  4464. status = 0
  4465. end subroutine Emission_megan_ReadSector
  4466. !EOC
  4467. END MODULE EMISSION_READ