user_output_pdump.F90 232 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621
  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. #define IF_NOTOK_MDF(action) if (status/=0) then; TRACEBACK; action; call MDF_CLose(fid,status); status=1; return; end if
  5. !
  6. #include "tm5.inc"
  7. !-----------------------------------------------------------------------------
  8. ! TM5 !
  9. !-----------------------------------------------------------------------------
  10. !BOP
  11. !
  12. ! !MODULE: USER_OUTPUT_PDUMP
  13. !
  14. ! !DESCRIPTION:
  15. !
  16. ! Module to deal with time-series output. Output are in NetCDF-4 and use CF
  17. ! conventions. The following output are available:
  18. !
  19. ! - one file with grid definition
  20. ! - one file with time series of some met fields (pressure, temperature, winds, ...)
  21. ! - one or more files with time series of some tracers
  22. ! - one or two files with Local Time output for some tracers
  23. ! - one file with time series of wet and dry depositions
  24. ! - one file with time series of deposition velocity
  25. !
  26. ! If the macro (cpp) "tropomi" is used, then the temperature and extra attributes added to the vmr (tracers) datasets.
  27. !
  28. ! Activation, tracers to account for, time step of the series, are set in the
  29. ! rcfile, following this template :
  30. !
  31. !
  32. ! SAMPLE RCFILE
  33. !
  34. ! output.pdump : T
  35. ! output.pdump.dataset.author : John Doe
  36. ! output.pdump.dataset.institution : MyFirm, Anytown, USA
  37. ! output.pdump.dataset.version : GEMS GRG; era2003 simulation
  38. ! tropomi only:
  39. ! output.pdump.tropomi.tm5version : v4
  40. ! output.pdump.tropomi.institution : KNMI
  41. ! output.pdump.tropomi.tm5reference : Huijnen et al., ACP
  42. ! output.pdump.tropomi.authoremail : Doe@john.com
  43. ! output.pdump.tropomi.datasetname : "S5P_AUX_CTMFCT" or "S5P_AUX_CTMANA"
  44. !
  45. ! output.pdump.fname.model : TM5
  46. ! output.pdump.fname.expid : V2
  47. ! output.pdump.fname.grid.300x200 : 3x2 ! short name, required if there is zoom regions
  48. ! output.pdump.fname.grid.100x100 : 1x1
  49. !
  50. ! output.pdump.griddef.apply : T
  51. !
  52. ! output.pdump.tp.apply : T
  53. ! output.pdump.tp.dhour : 1
  54. !
  55. ! output.pdump.vmr.n : 3
  56. !
  57. ! output.pdump.vmr.001.apply : T
  58. ! output.pdump.vmr.001.fname : vmr3
  59. ! output.pdump.vmr.001.dhour : 3
  60. ! output.pdump.vmr.001.tracers : SO2 NOy CH4 OH HNO3 PAN H2O2 Radon Lead
  61. !
  62. ! output.pdump.vmr.002.apply : T
  63. ! output.pdump.vmr.002.fname : vmr1
  64. ! output.pdump.vmr.002.dhour : 1
  65. ! output.pdump.vmr.002.tracers : O3 O3s CO NO2 NO CH2O
  66. !
  67. ! output.pdump.vmr.003.apply : F
  68. ! output.pdump.vmr.003.fname : vmra
  69. ! output.pdump.vmr.003.dhour : 3
  70. ! output.pdump.vmr.003.tracers : SO4 NO3_A BC BCS POM SS1_N SS1_M SS2_N SS2_M SS3_N SS3_M DUST2_N DUST2_M DUST3_N DUST3_M
  71. !
  72. ! output.pdump.lt.apply : T
  73. ! output.pdump.lt.tracers : O3
  74. ! output.pdump.lt.localtime : 2
  75. !
  76. ! output.pdump.lt2.apply : F
  77. ! output.pdump.lt2.tracers :
  78. ! output.pdump.lt2.localtime :
  79. !
  80. ! output.pdump.depositions.apply : F
  81. ! output.pdump.depositions.dhour : 3
  82. ! output.pdump.depositions.tracers : O3 HNO3 NO NO2 H2O2 CH2O PAN CO NH3 NH4 SO2 NOy
  83. !
  84. ! output.pdump.depvels.apply : F
  85. ! output.pdump.depvels.dhour : 3
  86. ! output.pdump.depvels.tracers : O3 HNO3 NO NO2 H2O2 CH2O PAN CO NH3 NH4 SO2
  87. !
  88. !\\
  89. !\\
  90. ! !INTERFACE:
  91. !
  92. MODULE USER_OUTPUT_PDUMP
  93. !
  94. ! !USES:
  95. !
  96. use partools, only : isRoot
  97. use GO, only : gol, goPr, goErr, goLabel
  98. use GO, only : TDate, IncrDate, NewDate
  99. use GO, only : operator(+), SystemDate, Get
  100. use dims, only : nregions, idatee, idatei, okdebug, nread
  101. use chem_param, only : ntrace
  102. use chem_param, only : iNOx, iHNO3, iPAN, iOrgNtr
  103. #ifdef with_m7
  104. use chem_param, only : iNO3_a
  105. use chem_param, only : iSO4nus, iSO4ais, iSO4acs, iSO4cos
  106. use chem_param, only : iBCais, iBCacs, iBCcos, iBCaii
  107. use chem_param, only : iPOMais, iPOMacs, iPOMcos, iPOMaii
  108. use chem_param, only : iDUacs, iDUcos, iDUaci, iDUcoi
  109. use chem_param, only : iSScos, iSSacs
  110. #endif
  111. USE MDF
  112. USE TM5_DISTGRID, only : dgrid, Get_DistGrid, update_halo
  113. IMPLICIT NONE
  114. PRIVATE
  115. !
  116. ! !PUBLIC MEMBER FUNCTIONS:
  117. !
  118. public :: Output_PDUMP_Init
  119. public :: Output_PDUMP_Step
  120. public :: Output_PDUMP_Done
  121. !
  122. ! !PRIVATE DATA MEMBERS:
  123. !
  124. character(len=*), parameter :: mname = 'user_output_pdump'
  125. character(len=*), parameter :: outfileversnr = '0.1'
  126. integer, parameter :: time_reftime6(6) = (/1950,01,01,00,00,00/) ! reference time
  127. character(len=*), parameter :: time_units = 'days since 1950-01-01 00:00:00'
  128. !
  129. ! NOy is not a standard tracer field, but sum of some transported tracers:
  130. ! NOx HNO3 PAN orgntr NO3_a
  131. ! where NOx is the sum of short lived tracers:
  132. ! NOx = NO + NO2 + NO3 + HNO4 + 2*N2O5
  133. !
  134. #ifdef with_m7
  135. integer, parameter :: iNOy = ntrace + 1
  136. integer, parameter :: nNOyt = 5
  137. integer, parameter :: iNOyt(nNOyt) = (/ iNOx, iHNO3, iNO3_a, iPAN, iOrgNtr /)
  138. integer, parameter :: iSO4 = ntrace + 2
  139. integer, parameter :: nSO4t = 4
  140. integer, parameter :: iSO4t(nSO4t) = (/ iSO4nus, iSO4ais, iSO4acs, iSO4cos /)
  141. integer, parameter :: iBC = ntrace + 3
  142. integer, parameter :: nBCt = 4
  143. integer, parameter :: iBCt(nBCt) = (/ iBCais, iBCacs, iBCcos, iBCaii /)
  144. integer, parameter :: iPOM = ntrace + 4
  145. integer, parameter :: nPOMt = 4
  146. integer, parameter :: iPOMt(nPOMt) = (/ iPOMais, iPOMacs, iPOMcos, iPOMaii /)
  147. integer, parameter :: iSS = ntrace + 5
  148. integer, parameter :: nSSt = 2
  149. integer, parameter :: iSSt(nSSt) = (/ iSSacs, iSScos /)
  150. integer, parameter :: iDU = ntrace + 6
  151. integer, parameter :: nDUt = 4
  152. integer, parameter :: iDUt(nDUt) = (/ iDUacs, iDUcos, iDUaci, iDUcoi /)
  153. #else
  154. integer, parameter :: iNOy = ntrace + 1
  155. integer, parameter :: nNOyt = 4
  156. integer, parameter :: iNOyt(nNOyt) = (/ iNOx, iHNO3, iPAN, iOrgNtr /)
  157. #endif
  158. !
  159. ! !PRIVATE TYPES:
  160. !
  161. type TPdumpFile_GridDef
  162. integer :: trec
  163. integer :: ncid
  164. integer :: dimid_scalar, dimid_lon, dimid_lat, dimid_lev, dimid_levi
  165. integer :: varid_lon, varid_lat, varid_time, varid_date
  166. integer :: varid_gridbox_area
  167. integer :: varid_a, varid_b
  168. integer :: varid_a_bnds, varid_b_bnds
  169. integer :: varid_p0
  170. !integer :: varid_ps
  171. !integer :: varid_geo_height
  172. end type TPdumpFile_GridDef
  173. type TPdumpFile_TP
  174. integer :: trec
  175. integer :: dhour
  176. integer :: ncid
  177. integer :: dimid_lon, dimid_lat, dimid_lev, dimid_time, dimid_datelen
  178. integer :: varid_lon, varid_lat, varid_lev, varid_time, varid_date
  179. integer :: varid_ps
  180. integer :: varid_surface_temp
  181. integer :: varid_orog
  182. integer :: varid_geop
  183. integer :: varid_pressure
  184. integer :: varid_temp
  185. integer :: varid_humid
  186. integer :: varid_u, varid_v, varid_w
  187. real, allocatable :: data3d(:,:,:,:,:)
  188. real, allocatable :: data2d(:,:,:,:)
  189. real, allocatable :: time(:)
  190. real, allocatable :: date(:,:)
  191. end type TPdumpFile_TP
  192. type TPdumpFile_VMR
  193. integer :: trec, n_rec
  194. logical :: apply
  195. real :: dhour
  196. integer :: dsec
  197. character(len=256) :: tracer_names
  198. integer :: ncid
  199. integer :: dimid_lon, dimid_lat, dimid_lev, dimid_levi, dimid_time, dimid_datelen
  200. integer :: varid_lon, varid_lat, varid_lev, varid_time, varid_date
  201. integer :: varid_ps
  202. integer :: varid_a_bnds, varid_b_bnds
  203. integer :: ntr
  204. integer :: itr(ntrace)
  205. character(len=8) :: name_tr(ntrace)
  206. #ifdef with_m7
  207. logical :: lpmx(ntrace)
  208. real :: sizepmx(ntrace)
  209. #endif
  210. integer :: varid_tr(ntrace)
  211. character(len=4) :: varid_type(ntrace)
  212. real, allocatable :: data3d(:,:,:,:,:)
  213. real, allocatable :: sp(:,:,:)
  214. real, allocatable :: time(:)
  215. real, allocatable :: date(:,:)
  216. real, allocatable :: data3d_t(:,:,:,:)
  217. integer :: varid_temp
  218. #ifdef tropomi
  219. integer :: varid_hyai, varid_hybi, varid_hyam, varid_hybm
  220. integer :: varid_hgt
  221. integer :: varid_ltropo
  222. real, allocatable :: data2d_hgt(:,:)
  223. integer, allocatable:: data2d_ltropo(:,:,:)
  224. #endif
  225. end type TPdumpFile_VMR
  226. type TPdumpFile_LT
  227. integer :: trec
  228. character(len=256) :: tracer_names
  229. integer :: ncid
  230. integer :: local_time
  231. integer :: dimid_lon, dimid_lat, dimid_lev, dimid_time, dimid_datelen
  232. integer :: varid_lon, varid_lat, varid_lev, varid_time, varid_date
  233. integer :: varid_ps
  234. integer :: ntr
  235. integer :: itr(ntrace)
  236. character(len=8) :: name_tr(ntrace)
  237. integer :: varid_tr(ntrace)
  238. real,allocatable :: accu(:,:,:,:)
  239. real,allocatable :: naccu(:,:)
  240. real,allocatable :: p_accu(:,:)
  241. real,allocatable :: np_accu(:)
  242. #ifdef with_m7
  243. logical :: laod(ntrace)
  244. real :: wavel(ntrace)
  245. #endif
  246. end type TPdumpFile_LT
  247. type TPdumpFile_DEPS
  248. integer :: trec
  249. integer :: dhour
  250. character(len=256) :: tracer_names
  251. integer :: ncid
  252. integer :: dimid_lon, dimid_lat, dimid_time, dimid_datelen
  253. integer :: varid_lon, varid_lat, varid_time, varid_date, varid_accum
  254. integer :: ntr
  255. integer :: itr(ntrace)
  256. character(len=8) :: name_tr(ntrace)
  257. integer :: varid_ddep(ntrace)
  258. real, pointer :: ddep_budget(:,:,:)
  259. logical :: with_wdep(ntrace)
  260. integer :: varid_wdep(ntrace)
  261. real, pointer :: wdep_budget(:,:,:)
  262. type(TDate) :: t0_budget
  263. real, allocatable :: data2d_dry(:,:,:,:)
  264. real, allocatable :: data2d_wet(:,:,:,:)
  265. real, allocatable :: time(:), dt(:)
  266. real, allocatable :: date(:,:)
  267. end type TPdumpFile_DEPS
  268. type TPdumpFile_DEPV
  269. integer :: trec
  270. integer :: dhour
  271. character(len=256) :: tracer_names
  272. integer :: ncid
  273. integer :: dimid_lon, dimid_lat, dimid_time, dimid_datelen
  274. integer :: varid_lon, varid_lat, varid_time, varid_date
  275. integer :: ntr
  276. integer :: itr(ntrace)
  277. character(len=8) :: name_tr(ntrace)
  278. integer :: varid_tr(ntrace)
  279. real, allocatable :: data2d(:,:,:,:)
  280. real, allocatable :: time(:)
  281. real, allocatable :: date(:,:)
  282. end type TPdumpFile_DEPV
  283. ! --- var -----------------------------
  284. integer :: fid ! file id for IF_NOTOK_MDF macro
  285. integer :: access_mode ! netcdf-4 access mode
  286. integer :: curr_day(nregions,3)
  287. logical :: firstday
  288. logical :: lastday ! it is last day and not a full day (ie day does not end at 00 of next day)
  289. character(len=32) :: fname_model
  290. character(len=8) :: fname_expid, meteo_class
  291. character(len=32) :: fname_grid(nregions)
  292. character(len=256) :: dataset_author, institution, dataset_version
  293. #ifdef tropomi
  294. character(len=256) :: tropomi_authoremail, tropomi_tm5_reference, tropomi_institution
  295. character(len=256) :: tropomi_tm5_version, tropomi_dataset_name
  296. character(len=15) :: tropomi_date_start, tropomi_date_stop, tropomi_date_create
  297. #endif
  298. logical, save :: griddef_apply
  299. type(TPdumpFile_GridDef), save :: RF_GridDef(nregions)
  300. logical, save :: tp_apply
  301. integer :: tp_dhour, n_tp_rec
  302. type(TPdumpFile_TP), save :: RF_TP(nregions)
  303. integer, save :: nvmr
  304. logical, allocatable :: vmr_apply(:)
  305. real, allocatable :: vmr_sregbord(:,:)
  306. character(len=16), allocatable :: vmr_fname(:)
  307. real, allocatable :: vmr_dhour(:)
  308. character(len=256), allocatable :: vmr_tracer_names(:)
  309. type(TPdumpFile_VMR), allocatable, save :: RF_VMR(:,:)
  310. logical, save :: lt_apply
  311. character(len=16) :: lt_fname
  312. character(len=256) :: lt_tracer_names
  313. integer :: lt_localtime
  314. type(TPdumpFile_LT), save :: RF_LT(nregions)
  315. logical, save :: lt2_apply
  316. character(len=16) :: lt2_fname
  317. character(len=256) :: lt2_tracer_names
  318. integer :: lt2_localtime
  319. type(TPdumpFile_LT), save :: RF_LT2(nregions)
  320. logical, save :: deps_apply
  321. character(len=16) :: deps_fname
  322. integer :: deps_dhour, n_deps_rec
  323. character(len=256) :: deps_tracer_names
  324. type(TPdumpFile_DEPS), save :: RF_DEPS(nregions)
  325. logical, save :: depv_apply
  326. character(len=16) :: depv_fname
  327. integer :: depv_dhour, n_depv_rec
  328. character(len=256) :: depv_tracer_names
  329. type(TPdumpFile_DEPV), save :: RF_DEPV(nregions)
  330. !
  331. ! !REVISION HISTORY:
  332. ! 1 Oct 2010 - Achim Strunk - revised older RETRO ouptut :
  333. ! add 2nd local time, regional output,
  334. ! handle aerosol tracers and M7
  335. ! 10 Jul 2012 - Ph. Le Sager - switch from pnetcdf to netcdf4_par (through
  336. ! MDF); get rid of the with_tendencies code.
  337. ! 12 Nov 2012 - Ph. Le Sager - adapted for lon-lat MPI decomposition.
  338. ! - get rid of unlimited dimensions so we can
  339. ! write in collective mode.
  340. ! - store series to write them only at end-of-day
  341. ! to speed-up code
  342. ! 10 Oct 2013 - Ph. Le Sager - fixed GET_N_TIME_RECORDS and several 'init'
  343. ! and write' routines.
  344. ! 14 Apr 2014 - Ph. Le Sager + JEW - tropomi add-ons in VMR: Temperature,
  345. ! As, Bs, better CF
  346. ! 8 October 2014 - H. Eskes - changes in tropomi output (based on the "tropomi" macro)
  347. !
  348. ! !REMARKS:
  349. !
  350. ! (1) Initially called RETRO output for GEMS GRG, the module has been adapted
  351. ! for CLIMAQS project and renamed PDUMP.
  352. ! (2) Previous remarks "as is":
  353. ! - longitudes from [0,360] ?
  354. ! this is imposible for zoom area's such as for the heatwave
  355. ! - levels from surface to top
  356. ! - time from 1950-01-01 00:00
  357. ! (3) This is supposed to work with netcdf4_parallel. You cannot use
  358. ! MPI with a non-parallel version of netcdf4 here.
  359. ! (4) The parallel writing is done in COLLECTIVE mode, but remain
  360. ! expensive on some system. Possible optimization : output one file
  361. ! per month (chunk/leg), and/or per field, and/or per processor.
  362. ! (5) Switch in nstep for DEPS data should work for full days. Not tested
  363. ! for partial days.
  364. !
  365. ! !TODO:
  366. ! - test with M7 tracers. Which ones?
  367. ! - in LT_WRITE : AOD if m7 needs to be coded
  368. ! - in RF_VMR_INIT : match tracer with CF standard names for some aerosols
  369. ! (dust,...)
  370. !
  371. !EOP
  372. !------------------------------------------------------------------------
  373. CONTAINS
  374. !--------------------------------------------------------------------------
  375. ! TM5 !
  376. !--------------------------------------------------------------------------
  377. !BOP
  378. !
  379. ! !FUNCTION: GET_N_TIME_RECORDS
  380. !
  381. ! !DESCRIPTION: return number of time steps for a daily timeseries file
  382. !\\
  383. !\\
  384. ! !INTERFACE:
  385. !
  386. FUNCTION GET_N_TIME_RECORDS( date, dsec, isDEPS, mess )
  387. !
  388. ! !USES:
  389. !
  390. USE GO , only : TDate, NewDate, rTotal, operator(-)
  391. !
  392. ! !RETURN VALUE:
  393. !
  394. integer :: get_n_time_records
  395. !
  396. ! !INPUT PARAMETERS:
  397. !
  398. integer, intent(in) :: date(6) ! 1st time step of the day (timestart basically)
  399. integer, intent(in) :: dsec ! time step for timeseries in sec (should divide 24*3600, be divided by ndyn/2)
  400. logical, optional, intent(in) :: isDEPS ! to differentiate b/w DEPS and others
  401. character(len=*), optional, intent(in) :: mess ! message (if okdebug)
  402. !
  403. ! !REVISION HISTORY:
  404. ! 9 Nov 2012 - Ph. Le Sager - v0
  405. ! 9 Oct 2013 - Ph. Le Sager - fix to work with default "output.after.step: v"
  406. ! 15 Jul 2014 - Ph. Le Sager - works with seconds instead of hours
  407. !
  408. ! !REMARKS:
  409. ! - dynamic timestep cannot be LARGER than timestep of timeseries, with notable exception
  410. ! of dynamic timestep = 2*timeseries_timestep.
  411. !
  412. ! !TODO:
  413. ! - check if anything changes with other possible values of "output.after.step"
  414. !
  415. !EOP
  416. !------------------------------------------------------------------------
  417. !BOC
  418. integer :: is, ie, delta, dynstep
  419. logical :: deps
  420. type(TDate) :: t, t0
  421. real :: time
  422. ! Type of record (standard=vmr, tp, depv) or special (deps)
  423. deps=.false.
  424. if (present(isDEPS)) deps=isDEPS
  425. ! Start index
  426. delta=date(4)*3600+date(5)*60+date(6) ! 0, unless start of the run is not at 00:00:00
  427. if (deps) delta=delta + nread ! one DYNAMIC time step done to output something
  428. if (modulo(delta,dsec)==0) then
  429. is=delta/dsec
  430. else
  431. is=(delta+dsec)/dsec
  432. end if
  433. ! End index for daily file (nread=dynamic time step read from rc)
  434. ie = (24*3600 - nread/2) / dsec
  435. if (deps) then ! there will be an extra step if run goes further than midnight
  436. t0 = NewDate( time6=date )
  437. t = NewDate( time6=idatee )
  438. time = rTotal( t - t0, 'day' )
  439. if (time > 1) ie=24*3600/dsec
  440. end if
  441. ! Case of "last day stopping before midnite". (Need testing for DEPS)
  442. if (lastday) ie=(idatee(4)*3600+idatee(5)*60+idatee(6)-nread/2)/dsec
  443. ! length
  444. get_n_time_records = ie-is+1
  445. if(okdebug)then
  446. if (present(mess))then
  447. write(gol,*) 'GET_N_TIME_RECORDS -'//trim(mess); call goPr
  448. end if
  449. write(gol,*) "GET_N_TIME_RECORDS - is, ie, deps, firstday, lastday, get_n_time_records:" ; call goPr
  450. write(gol,*) "GET_N_TIME_RECORDS - ", is, ie, deps, firstday, lastday, get_n_time_records ; call goPr
  451. write(gol,*) "GET_N_TIME_RECORDS - date, dsec, nread ", date, dsec, nread ; call goPr
  452. write(gol,*) "GET_N_TIME_RECORDS - idateE ", idatee ; call goPr
  453. end if
  454. return
  455. END FUNCTION GET_N_TIME_RECORDS
  456. !EOC
  457. !--------------------------------------------------------------------------
  458. ! TM5 !
  459. !--------------------------------------------------------------------------
  460. !BOP
  461. !
  462. ! !IROUTINE: OUTPUT_PDUMP_INIT
  463. !
  464. ! !DESCRIPTION: reads rc file keys relevant for pdump
  465. !\\
  466. !\\
  467. ! !INTERFACE:
  468. !
  469. SUBROUTINE OUTPUT_PDUMP_INIT( rcF, dsec_min, status )
  470. !
  471. ! !USES:
  472. !
  473. use GO, only : TrcFile, ReadRc
  474. use MeteoData, only : lli, set
  475. use MeteoData, only : sp_dat, oro_dat, temper_dat, humid_dat, pu_dat, pv_dat
  476. use MeteoData, only : mfw_dat, gph_dat, t2m_dat
  477. !
  478. ! !INPUT/OUTPUT PARAMETERS:
  479. !
  480. type(TrcFile), intent(inout) :: rcF
  481. !
  482. ! !OUTPUT PARAMETERS:
  483. !
  484. integer, intent(out) :: dsec_min ! smallest timeseries period in sec
  485. integer, intent(out) :: status
  486. !
  487. ! !REVISION HISTORY:
  488. ! 1 Oct 2010 - Achim Strunk - upgrade from RETRO to PDUMP
  489. ! 8 Nov 2012 - Ph. Le Sager - added access mode switch
  490. !
  491. !EOP
  492. !------------------------------------------------------------------------
  493. !BOC
  494. character(len=*), parameter :: rname = mname//'/Output_PDUMP_Init'
  495. ! --- local ------------------------------
  496. integer :: region
  497. character(len=64) :: key
  498. character(len=3) :: nr
  499. integer :: ivmr
  500. ! --- begin -------------------------------
  501. call goLabel(rname)
  502. #ifdef MPI
  503. #ifdef with_netcdf4_par
  504. access_mode = MDF_COLLECTIVE
  505. #else
  506. write(gol,'("Time Series output (PDUMP) requires netcdf4 with parallel access enabled")') ; call goErr
  507. TRACEBACK
  508. status=1; return
  509. #endif
  510. #else
  511. access_mode = MDF_INDEPENDENT
  512. #endif
  513. ! which day
  514. firstday = .true.
  515. lastday = .true.
  516. ! lowest time frequency in sec
  517. dsec_min = 999999
  518. if (any(idatei(1:3)/=idatee(1:3))) lastday=.false. ! i.e. at least one full day
  519. ! dataset keys:
  520. call ReadRc( rcF, 'output.pdump.dataset.author' , dataset_author , status )
  521. IF_NOTOK_RETURN(status=1)
  522. call ReadRc( rcF, 'output.pdump.dataset.institution', institution , status )
  523. IF_NOTOK_RETURN(status=1)
  524. call ReadRc( rcF, 'output.pdump.dataset.version' , dataset_version , status )
  525. IF_NOTOK_RETURN(status=1)
  526. #ifdef tropomi
  527. call ReadRc( rcF, 'output.pdump.tropomi.tm5version', tropomi_tm5_version , status )
  528. IF_NOTOK_RETURN(status=1)
  529. call ReadRc( rcF, 'output.pdump.tropomi.institution', tropomi_institution , status )
  530. IF_NOTOK_RETURN(status=1)
  531. call ReadRc( rcF, 'output.pdump.tropomi.tm5reference', tropomi_tm5_reference , status )
  532. IF_NOTOK_RETURN(status=1)
  533. call ReadRc( rcF, 'output.pdump.tropomi.authoremail', tropomi_authoremail , status )
  534. IF_NOTOK_RETURN(status=1)
  535. call ReadRc( rcF, 'output.pdump.tropomi.datasetname', tropomi_dataset_name , status )
  536. IF_NOTOK_RETURN(status=1)
  537. #endif
  538. ! filename keys:
  539. call ReadRc( rcF, 'output.pdump.fname.model', fname_model, status )
  540. IF_NOTOK_RETURN(status=1)
  541. call ReadRc( rcF, 'output.pdump.fname.expid', fname_expid, status )
  542. IF_NOTOK_RETURN(status=1)
  543. ! prefix grid name in case of zooming regions:
  544. if ( nregions > 1 ) then
  545. ! loop over regions:
  546. do region = 1, nregions
  547. ! short grid name from rcfile:
  548. call ReadRc( rcF, 'output.pdump.fname.grid.'//trim(lli(region)%name), key, status )
  549. IF_NOTOK_RETURN(status=1)
  550. ! fill grid extenstion to file names:
  551. fname_grid(region) = '-'//trim(key)
  552. end do
  553. else
  554. ! empty
  555. fname_grid = ''
  556. end if
  557. ! griddef file ?
  558. call ReadRc( rcF, 'output.pdump.griddef.apply', griddef_apply, status )
  559. IF_NOTOK_RETURN(status=1)
  560. ! temperature, pressure, etc file ?
  561. call ReadRc( rcF, 'output.pdump.tp.apply', tp_apply, status )
  562. IF_NOTOK_RETURN(status=1)
  563. if (tp_apply) then
  564. ! ensure that required meteo is loaded
  565. do region=1,nregions
  566. call Set( sp_dat(region), status, used=.true. )
  567. call Set( oro_dat(region), status, used=.true. )
  568. call Set( temper_dat(region), status, used=.true. )
  569. call Set( t2m_dat(region), status, used=.true. )
  570. call Set( humid_dat(region), status, used=.true. )
  571. call Set( pu_dat(region), status, used=.true. )
  572. call Set( pv_dat(region), status, used=.true. )
  573. call Set( mfw_dat(region), status, used=.true. )
  574. call Set( gph_dat(region), status, used=.true. ) ! used to compute vertical wind
  575. end do
  576. ! time resolution (1 hour by default)
  577. call ReadRc( rcF, 'output.pdump.tp.dhour', tp_dhour, status, default=1 )
  578. IF_ERROR_RETURN(status=1)
  579. dsec_min = tp_dhour*3600
  580. end if
  581. ! VMR files
  582. call ReadRc( rcF, 'output.pdump.vmr.n', nvmr, status ) ! number of vmr files to be written
  583. IF_NOTOK_RETURN(status=1)
  584. if ( nvmr < 0 ) then
  585. write (gol,'("strange specification of number of vmr files : ",i6)') nvmr; call goErr
  586. TRACEBACK; status=1; return
  587. end if
  588. ! meteo
  589. call ReadRc( rcF, 'my.meteo.class', meteo_class, status, default='unknown' )
  590. IF_ERROR_RETURN(status=1)
  591. ! write any vmr files ?
  592. if ( nvmr > 0 ) then
  593. ! storage:
  594. allocate( vmr_apply(nvmr) ) ; vmr_apply = .false.
  595. allocate( vmr_fname(nvmr) ) ; vmr_fname = ''
  596. allocate( vmr_dhour(nvmr) ) ; vmr_dhour = -1.
  597. allocate( vmr_tracer_names(nvmr) ) ; vmr_tracer_names = ''
  598. allocate( vmr_sregbord(nvmr,4) ) ; vmr_sregbord = -999.9
  599. allocate( RF_VMR(nregions,nvmr) )
  600. #ifdef tropomi
  601. do region=1,nregions
  602. call Set( temper_dat(region), status, used=.true. )
  603. call Set( gph_dat(region), status, used=.true. ) ! used to compute surface altitude
  604. end do
  605. #endif
  606. ! loop over vmr files:
  607. do ivmr = 1, nvmr
  608. ! number in rc keys:
  609. write (nr,'(i3.3)') ivmr
  610. ! apply ?
  611. call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.apply', vmr_apply(ivmr), status )
  612. IF_NOTOK_RETURN(status=1)
  613. rf_vmr(:,ivmr)%apply = vmr_apply(ivmr)
  614. ! proceed ?
  615. if ( vmr_apply(ivmr) ) then
  616. ! first part of filename:
  617. call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.fname', vmr_fname(ivmr), status )
  618. IF_NOTOK_RETURN(status=1)
  619. ! time resolution:
  620. call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.dhour', vmr_dhour(ivmr), status )
  621. IF_NOTOK_RETURN(status=1)
  622. ! here is the catch: fractional hour for step should divide 3600
  623. dsec_min = min( dsec_min, int(vmr_dhour(ivmr)*3600) )
  624. ! tracers to be written:
  625. call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.tracers', vmr_tracer_names(ivmr), status )
  626. IF_NOTOK_RETURN(status=1)
  627. end if ! apply ?
  628. end do ! vmr numbers
  629. ! required meteo
  630. if (any(vmr_apply)) then
  631. do region=1,nregions
  632. call Set( sp_dat(region), status, used=.true. )
  633. end do
  634. end if
  635. end if ! nvmr > 0
  636. ! ---------------------
  637. ! local time:
  638. ! ---------------------
  639. ! file 1
  640. lt_fname = 'lt'
  641. call ReadRc( rcF, 'output.pdump.lt.apply', lt_apply, status )
  642. IF_NOTOK_RETURN(status=1)
  643. if ( lt_apply ) then
  644. call ReadRc( rcF, 'output.pdump.lt.tracers', lt_tracer_names, status )
  645. IF_NOTOK_RETURN(status=1)
  646. call ReadRc( rcF, 'output.pdump.lt.localtime', lt_localtime, status )
  647. IF_NOTOK_RETURN(status=1)
  648. end if
  649. ! file 2
  650. lt2_fname = 'lt2'
  651. call ReadRc( rcF, 'output.pdump.lt2.apply', lt2_apply, status )
  652. IF_NOTOK_RETURN(status=1)
  653. if ( lt2_apply ) then
  654. call ReadRc( rcF, 'output.pdump.lt2.tracers', lt2_tracer_names, status )
  655. IF_NOTOK_RETURN(status=1)
  656. call ReadRc( rcF, 'output.pdump.lt2.localtime', lt2_localtime, status )
  657. IF_NOTOK_RETURN(status=1)
  658. end if
  659. if (lt_apply .or. lt2_apply) then
  660. do region=1,nregions
  661. call Set( sp_dat(region), status, used=.true. )
  662. end do
  663. end if
  664. ! ---------------------
  665. ! deposition fluxes:
  666. ! ---------------------
  667. deps_fname = 'depositions'
  668. call ReadRc( rcF, 'output.pdump.depositions.apply', deps_apply, status )
  669. IF_NOTOK_RETURN(status=1)
  670. if ( deps_apply ) then
  671. #ifdef with_budgets
  672. call ReadRc( rcF, 'output.pdump.depositions.dhour', deps_dhour, status )
  673. IF_NOTOK_RETURN(status=1)
  674. call ReadRc( rcF, 'output.pdump.depositions.tracers', deps_tracer_names, status )
  675. IF_NOTOK_RETURN(status=1)
  676. dsec_min = min( dsec_min, deps_dhour*3600)
  677. #else
  678. write(gol,*) "timeseries of deposition fluxes requires using 'with_budget' macro" ; call goErr
  679. status=1 ; TRACEBACK ; return
  680. #endif
  681. end if
  682. ! ---------------------
  683. ! deposition velocities:
  684. ! ---------------------
  685. depv_fname = 'depvels'
  686. call ReadRc( rcF, 'output.pdump.depvels.apply', depv_apply, status )
  687. IF_NOTOK_RETURN(status=1)
  688. if ( depv_apply ) then
  689. #ifdef with_budgets
  690. call ReadRc( rcF, 'output.pdump.depvels.dhour', depv_dhour, status )
  691. IF_NOTOK_RETURN(status=1)
  692. call ReadRc( rcF, 'output.pdump.depvels.tracers', depv_tracer_names, status )
  693. IF_NOTOK_RETURN(status=1)
  694. dsec_min = min( dsec_min, depv_dhour*3600)
  695. #else
  696. write(gol,*) "timeseries of deposition velocities requires using 'with_budget' macro" ; call goErr
  697. status=1 ; TRACEBACK ; return
  698. #endif
  699. end if
  700. ! no files open yet
  701. curr_day = -1
  702. call goLabel()
  703. ! ok
  704. status = 0
  705. END SUBROUTINE OUTPUT_PDUMP_INIT
  706. !EOC
  707. !--------------------------------------------------------------------------
  708. ! TM5 !
  709. !--------------------------------------------------------------------------
  710. !BOP
  711. !
  712. ! !IROUTINE: OUTPUT_PDUMP_STEP
  713. !
  714. ! !DESCRIPTION:
  715. !\\
  716. !\\
  717. ! !INTERFACE:
  718. !
  719. SUBROUTINE OUTPUT_PDUMP_STEP( region, idate_f, status )
  720. !
  721. ! !INPUT PARAMETERS:
  722. !
  723. integer, intent(in) :: region
  724. integer, intent(in) :: idate_f(6)
  725. !
  726. ! !OUTPUT PARAMETERS:
  727. !
  728. integer, intent(out) :: status
  729. !
  730. ! !REVISION HISTORY:
  731. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  732. !
  733. ! !REMARKS:
  734. ! (1) called every hour.
  735. !
  736. !EOP
  737. !------------------------------------------------------------------------
  738. !BOC
  739. character(len=*), parameter :: rname = mname//'/Output_PDUMP_Step'
  740. ! --- begin -------------------------------
  741. call goLabel(rname)
  742. !----------------------
  743. ! close if necessary
  744. !----------------------
  745. ! if a file is open, and it is a new day
  746. if ( all(curr_day(region,:) > 0) .and. any(idate_f(1:3) /= curr_day(region,:)) ) then
  747. ! write in previous day file end-of-interval data
  748. call PDUMP_Files_Write2( region, idate_f, status )
  749. IF_NOTOK_RETURN(status=1)
  750. ! close all
  751. call PDUMP_Files_Close( region, status )
  752. IF_NOTOK_RETURN(status=1)
  753. ! no files open ...
  754. curr_day(region,:) = -1
  755. firstday = .false.
  756. end if
  757. !----------------------
  758. ! open if necessary
  759. !----------------------
  760. if ( any(curr_day(region,:) < 0) ) then
  761. if (all(idate_f(1:3)==idatee(1:3))) lastday=.true. ! means last day is not a full day
  762. write(gol,*) "U_O_Pdump open [idate_f, last day] = ", idate_f, lastday; call goPr
  763. call PDUMP_Files_Open( region, idate_f, status )
  764. IF_NOTOK_RETURN(status=1)
  765. ! store date of current day
  766. curr_day(region,:) = idate_f(1:3)
  767. end if
  768. !----------------------
  769. ! write
  770. !----------------------
  771. call PDUMP_Files_Write( region, idate_f, status )
  772. IF_NOTOK_RETURN(status=1)
  773. ! if not midnight, write end-of-interval data
  774. if ( any(idate_f(4:6) > 0) ) then
  775. call PDUMP_Files_Write2( region, idate_f, status )
  776. IF_NOTOK_RETURN(status=1)
  777. end if
  778. !----------------------
  779. ! done
  780. !----------------------
  781. call goLabel()
  782. status = 0
  783. END SUBROUTINE OUTPUT_PDUMP_STEP
  784. !EOC
  785. !--------------------------------------------------------------------------
  786. ! TM5 !
  787. !--------------------------------------------------------------------------
  788. !BOP
  789. !
  790. ! !IROUTINE: OUTPUT_PDUMP_DONE
  791. !
  792. ! !DESCRIPTION:
  793. !\\
  794. !\\
  795. ! !INTERFACE:
  796. !
  797. SUBROUTINE OUTPUT_PDUMP_DONE( status )
  798. !
  799. ! !USES:
  800. !
  801. use dims, only : itaur
  802. use datetime, only : tau2date
  803. !
  804. ! !OUTPUT PARAMETERS:
  805. !
  806. integer, intent(out) :: status
  807. !
  808. ! !REVISION HISTORY:
  809. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  810. ! 31 Aug 2012 - P. Le Sager - reverse order in which regions are dealt with (MDF issue)
  811. !
  812. !EOP
  813. !------------------------------------------------------------------------
  814. !BOC
  815. character(len=*), parameter :: rname = mname//'/Output_PDUMP_Done'
  816. integer :: region
  817. integer,dimension(6) :: idate_f
  818. ! --- begin -------------------------------
  819. ! close files:
  820. do region = nregions, 1, -1
  821. ! write end of interval DEPS data (requires that DEPS nstep is calculated with .false. -see RF_DEPS_Init-)
  822. call tau2date(itaur(region),idate_f)
  823. call PDUMP_Files_Write2( region, idate_f, status )
  824. IF_NOTOK_RETURN(status=1)
  825. call PDUMP_Files_Close( region, status )
  826. IF_NOTOK_RETURN(status=1)
  827. end do
  828. ! clear:
  829. if ( nvmr > 0 ) then
  830. deallocate( vmr_apply )
  831. deallocate( vmr_fname )
  832. deallocate( vmr_dhour )
  833. deallocate( vmr_tracer_names )
  834. deallocate( vmr_sregbord )
  835. deallocate( RF_VMR )
  836. end if
  837. ! ok
  838. status = 0
  839. END SUBROUTINE OUTPUT_PDUMP_DONE
  840. !EOC
  841. ! ********************************************************************
  842. ! ***
  843. ! *** open/write/close pdump files
  844. ! ***
  845. ! ********************************************************************
  846. !--------------------------------------------------------------------------
  847. ! TM5 !
  848. !--------------------------------------------------------------------------
  849. !BOP
  850. !
  851. ! !IROUTINE: PDUMP_FILES_OPEN
  852. !
  853. ! !DESCRIPTION: call init method of each output file.
  854. !\\
  855. !\\
  856. ! !INTERFACE:
  857. !
  858. subroutine PDUMP_Files_Open( region, idate_f, status )
  859. !
  860. ! !USES:
  861. !
  862. use global_data, only : outdir
  863. !
  864. ! !INPUT PARAMETERS:
  865. !
  866. integer, intent(in) :: region
  867. integer, intent(in) :: idate_f(6)
  868. !
  869. ! !OUTPUT PARAMETERS:
  870. !
  871. integer, intent(out) :: status
  872. !
  873. ! !REVISION HISTORY:
  874. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  875. !
  876. !EOP
  877. !------------------------------------------------------------------------
  878. !BOC
  879. character(len=*), parameter :: rname = mname//'/PDUMP_Files_Open'
  880. ! --- local -------------------------------
  881. integer :: ivmr
  882. ! --- begin -------------------------------
  883. ! grid definition:
  884. if ( griddef_apply ) then
  885. call RF_GridDef_Init( RF_GridDef(region), outdir, fname_model, fname_expid, region, status )
  886. IF_NOTOK_RETURN(status=1)
  887. end if
  888. ! dynamics:
  889. if ( tp_apply ) then
  890. call RF_TP_Init ( RF_TP(region) , outdir, fname_model, fname_expid, &
  891. region, idate_f, tp_dhour, status )
  892. IF_NOTOK_RETURN(status=1)
  893. end if
  894. ! tracer concentrations:
  895. do ivmr = 1, nvmr
  896. if ( .not. vmr_apply(ivmr) ) cycle
  897. call RF_VMR_Init( RF_VMR(region,ivmr), outdir, fname_model, fname_expid, &
  898. vmr_fname(ivmr), region, idate_f, &
  899. vmr_dhour(ivmr), vmr_tracer_names(ivmr), status )
  900. IF_NOTOK_RETURN(status=1)
  901. vmr_apply(ivmr) = rf_vmr(region,ivmr)%apply
  902. end do
  903. ! lt output:
  904. if ( lt_apply ) then
  905. call RF_LT_Init( RF_LT(region), outdir, fname_model, fname_expid, &
  906. lt_fname, region, idate_f, &
  907. lt_localtime, lt_tracer_names, status )
  908. IF_NOTOK_RETURN(status=1)
  909. end if
  910. if ( lt2_apply ) then
  911. call RF_LT_Init( RF_LT2(region), outdir, fname_model, fname_expid, &
  912. lt2_fname, region, idate_f, &
  913. lt2_localtime, lt2_tracer_names, status )
  914. IF_NOTOK_RETURN(status=1)
  915. end if
  916. #ifdef with_budgets
  917. ! deposition fluxes:
  918. if ( deps_apply ) then
  919. call RF_DEPS_Init( RF_DEPS(region), outdir, fname_model, fname_expid, &
  920. deps_fname, region, idate_f, &
  921. deps_dhour, deps_tracer_names, status )
  922. IF_NOTOK_RETURN(status=1)
  923. end if
  924. ! deposition velocities:
  925. if ( depv_apply ) then
  926. call RF_DEPV_Init( RF_DEPV(region), outdir, fname_model, fname_expid, &
  927. depv_fname, region, idate_f, &
  928. depv_dhour, depv_tracer_names, status )
  929. IF_NOTOK_RETURN(status=1)
  930. end if
  931. #endif
  932. ! ok
  933. status = 0
  934. END SUBROUTINE PDUMP_FILES_OPEN
  935. !EOC
  936. !--------------------------------------------------------------------------
  937. ! TM5 !
  938. !--------------------------------------------------------------------------
  939. !BOP
  940. !
  941. ! !IROUTINE: PDUMP_FILES_WRITE
  942. !
  943. ! !DESCRIPTION: call write method for each output file.
  944. !\\
  945. !\\
  946. ! !INTERFACE:
  947. !
  948. SUBROUTINE PDUMP_FILES_WRITE( region, idate_f, status )
  949. !
  950. ! !INPUT PARAMETERS:
  951. !
  952. integer, intent(in) :: region
  953. integer, intent(in) :: idate_f(6)
  954. !
  955. ! !OUTPUT PARAMETERS:
  956. !
  957. integer, intent(out) :: status
  958. !
  959. ! !REVISION HISTORY:
  960. ! 1 Oct 2010 - Achim Strunk -
  961. !
  962. !EOP
  963. !------------------------------------------------------------------------
  964. !BOC
  965. character(len=*), parameter :: rname = mname//'/PDUMP_Files_Write'
  966. integer :: ivmr
  967. ! --- begin -------------------------------
  968. ! grid definition:
  969. if ( griddef_apply ) then
  970. call RF_GridDef_Write( RF_GridDef(region), region, status )
  971. IF_NOTOK_RETURN(status=1)
  972. end if
  973. ! dynamics:
  974. if ( tp_apply ) then
  975. call RF_TP_Write( RF_TP(region), region, idate_f, status )
  976. IF_NOTOK_RETURN(status=1)
  977. end if
  978. ! tracer fields:
  979. do ivmr = 1, nvmr
  980. if ( .not. vmr_apply(ivmr) ) cycle
  981. call RF_VMR_Write( RF_VMR(region,ivmr), region, idate_f, status )
  982. IF_NOTOK_RETURN(status=1)
  983. end do
  984. ! lt output:
  985. if ( lt_apply ) then
  986. call RF_LT_Write( RF_LT(region), region, idate_f, status )
  987. IF_NOTOK_RETURN(status=1)
  988. end if
  989. if ( lt2_apply ) then
  990. call RF_LT_Write( RF_LT2(region), region, idate_f, status )
  991. IF_NOTOK_RETURN(status=1)
  992. end if
  993. #ifdef with_budgets
  994. ! deposition velocities:
  995. if ( depv_apply ) then
  996. call RF_DEPV_Write( RF_DEPV(region), region, idate_f, status )
  997. IF_NOTOK_RETURN(status=1)
  998. end if
  999. #endif
  1000. status = 0
  1001. END SUBROUTINE PDUMP_FILES_WRITE
  1002. !EOC
  1003. !--------------------------------------------------------------------------
  1004. ! TM5 !
  1005. !--------------------------------------------------------------------------
  1006. !BOP
  1007. !
  1008. ! !IROUTINE: PDUMP_FILES_WRITE2
  1009. !
  1010. ! !DESCRIPTION: write at end of time interval
  1011. !
  1012. !\\
  1013. !\\
  1014. ! !INTERFACE:
  1015. !
  1016. SUBROUTINE PDUMP_FILES_WRITE2( region, idate_f, status )
  1017. !
  1018. ! !INPUT PARAMETERS:
  1019. !
  1020. integer, intent(in) :: region
  1021. integer, intent(in) :: idate_f(6)
  1022. !
  1023. ! !OUTPUT PARAMETERS:
  1024. !
  1025. integer, intent(out) :: status
  1026. !
  1027. ! !REVISION HISTORY:
  1028. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  1029. !
  1030. !EOP
  1031. !------------------------------------------------------------------------
  1032. !BOC
  1033. character(len=*), parameter :: rname = mname//'/PDUMP_Files_Write2'
  1034. ! --- begin -------------------------------
  1035. #ifdef with_budgets
  1036. ! deposition fluxes:
  1037. if ( deps_apply ) then
  1038. call RF_DEPS_Write( RF_DEPS(region), region, idate_f, status )
  1039. IF_NOTOK_RETURN(status=1)
  1040. end if
  1041. #endif
  1042. ! lt output:
  1043. if ( lt_apply ) then
  1044. call RF_LT_Write( RF_LT(region), region, idate_f, status )
  1045. IF_NOTOK_RETURN(status=1)
  1046. end if
  1047. if ( lt2_apply ) then
  1048. call RF_LT_Write( RF_LT2(region), region, idate_f, status )
  1049. IF_NOTOK_RETURN(status=1)
  1050. end if
  1051. ! ok
  1052. status = 0
  1053. END SUBROUTINE PDUMP_FILES_WRITE2
  1054. !EOC
  1055. !--------------------------------------------------------------------------
  1056. ! TM5 !
  1057. !--------------------------------------------------------------------------
  1058. !BOP
  1059. !
  1060. ! !IROUTINE: PDUMP_FILES_CLOSE
  1061. !
  1062. ! !DESCRIPTION: call done method of each output file.
  1063. !\\
  1064. !\\
  1065. ! !INTERFACE:
  1066. !
  1067. SUBROUTINE PDUMP_FILES_CLOSE( region, status )
  1068. !
  1069. ! !INPUT PARAMETERS:
  1070. !
  1071. integer, intent(in) :: region
  1072. !
  1073. ! !OUTPUT PARAMETERS:
  1074. !
  1075. integer, intent(out) :: status
  1076. !
  1077. ! !REVISION HISTORY:
  1078. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  1079. ! 31 Aug 2012 - Ph. Le Sager - switch closing order, since it was giving issues on some machine.
  1080. !
  1081. !EOP
  1082. !------------------------------------------------------------------------
  1083. !BOC
  1084. character(len=*), parameter :: rname = mname//'/PDUMP_Files_Close'
  1085. ! --- local -------------------------------
  1086. integer :: ivmr
  1087. ! --- begin -------------------------------
  1088. #ifdef with_budgets
  1089. if ( depv_apply ) then
  1090. call RF_DEPV_Done( RF_DEPV(region), status )
  1091. IF_NOTOK_RETURN(status=1)
  1092. end if
  1093. if ( deps_apply ) then
  1094. call RF_DEPS_Done( RF_DEPS(region), status )
  1095. IF_NOTOK_RETURN(status=1)
  1096. end if
  1097. #endif
  1098. if ( lt2_apply ) then
  1099. call RF_LT_Done( RF_LT2(region), region, status )
  1100. IF_NOTOK_RETURN(status=1)
  1101. end if
  1102. if ( lt_apply ) then
  1103. call RF_LT_Done( RF_LT(region), region, status )
  1104. IF_NOTOK_RETURN(status=1)
  1105. end if
  1106. do ivmr = nvmr, 1, -1
  1107. if ( .not. vmr_apply(ivmr) ) cycle
  1108. call RF_VMR_Done( RF_VMR(region,ivmr), status )
  1109. IF_NOTOK_RETURN(status=1)
  1110. end do
  1111. if ( tp_apply ) then
  1112. call RF_TP_Done ( RF_TP(region) , status )
  1113. IF_NOTOK_RETURN(status=1)
  1114. end if
  1115. if ( griddef_apply ) then
  1116. call RF_GridDef_Done( RF_GridDef(region), status )
  1117. IF_NOTOK_RETURN(status=1)
  1118. end if
  1119. status = 0
  1120. end subroutine PDUMP_Files_Close
  1121. !EOC
  1122. !--------------------------------------------------------------------------
  1123. ! TM5 !
  1124. !--------------------------------------------------------------------------
  1125. !BOP
  1126. !
  1127. ! !IROUTINE: RF_GRIDDEF_INIT
  1128. !
  1129. ! !DESCRIPTION:
  1130. !
  1131. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1132. ! FILE 1: Model horizontal grid definition
  1133. ! (longitude, latitude, size of gridbox [m2] ).
  1134. ! For documentation purposes, please also include the native vertical
  1135. ! grid definition from your model (hybrid level coefficients) and the
  1136. ! formula used to calculate pressure.
  1137. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1138. !
  1139. !\\
  1140. !\\
  1141. ! !INTERFACE:
  1142. !
  1143. subroutine RF_GridDef_Init( RF, fdir, model, expid, region, status )
  1144. !
  1145. ! !USES:
  1146. !
  1147. use partools, only : MPI_INFO_NULL, localComm
  1148. use MeteoData, only : global_lli, levi
  1149. !
  1150. ! !OUTPUT PARAMETERS:
  1151. !
  1152. type(TPdumpFile_GridDef), intent(out) :: RF
  1153. !
  1154. ! !INPUT PARAMETERS:
  1155. !
  1156. character(len=*), intent(in) :: fdir
  1157. character(len=*), intent(in) :: model
  1158. character(len=*), intent(in) :: expid
  1159. integer, intent(in) :: region
  1160. integer, intent(out) :: status
  1161. !
  1162. ! !REVISION HISTORY:
  1163. ! 1 Oct 2010 - Achim Strunk -
  1164. ! 10 Jul 2012 - Ph. Le Sager - switch to MDF_NETCDF4
  1165. !
  1166. !EOP
  1167. !------------------------------------------------------------------------
  1168. !BOC
  1169. character(len=*), parameter :: rname = mname//'/RF_GridDef_Init'
  1170. character(len=256) :: fname
  1171. integer :: varid
  1172. integer :: rtype
  1173. ! --- begin -------------------------------------
  1174. call goLabel(rname)
  1175. ! o open file
  1176. ! write filename
  1177. write (fname,'(a,"/",a,a,"_",a,"_",a,".nc")') &
  1178. trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), 'griddef'
  1179. #ifdef MPI
  1180. ! overwrite existing files (clobber), provide MPI stuff:
  1181. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
  1182. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  1183. if (status/=0) then
  1184. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  1185. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  1186. TRACEBACK; status=1; return
  1187. end if
  1188. #else
  1189. ! overwrite existing files (clobber)
  1190. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
  1191. IF_NOTOK_RETURN(status=1)
  1192. #endif
  1193. ! o global attributes
  1194. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title', 'model horizontal definition' , status)
  1195. IF_NOTOK_MDF(fid=RF%ncid)
  1196. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
  1197. IF_NOTOK_MDF(fid=RF%ncid)
  1198. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
  1199. IF_NOTOK_MDF(fid=RF%ncid)
  1200. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
  1201. IF_NOTOK_MDF(fid=RF%ncid)
  1202. ! o define dimensions
  1203. call MDF_Def_Dim( RF%ncid, 'scalar', 1, RF%dimid_scalar , status)
  1204. IF_NOTOK_MDF(fid=RF%ncid)
  1205. call MDF_Def_Dim( RF%ncid, 'lon', global_lli(region)%nlon, RF%dimid_lon , status)
  1206. IF_NOTOK_MDF(fid=RF%ncid)
  1207. call MDF_Def_Dim( RF%ncid, 'lat', global_lli(region)%nlat, RF%dimid_lat , status)
  1208. IF_NOTOK_MDF(fid=RF%ncid)
  1209. call MDF_Def_Dim( RF%ncid, 'lev', levi%nlev, RF%dimid_lev , status)
  1210. IF_NOTOK_MDF(fid=RF%ncid)
  1211. call MDF_Def_Dim( RF%ncid, 'levi', levi%nlev+1, RF%dimid_levi , status)
  1212. IF_NOTOK_MDF(fid=RF%ncid)
  1213. !call MDF_Def_Dim( RF%ncid, 'time', NTS, RF%dimid_time , status)
  1214. !IF_NOTOK_MDF(fid=RF%ncid)
  1215. !call MDF_Def_Dim( RF%ncid, 'datelen', 6, RF%dimid_datelen , status)
  1216. !IF_NOTOK_MDF(fid=RF%ncid)
  1217. ! o define variables
  1218. rtype = MDF_FLOAT
  1219. call MDF_Def_Var( RF%ncid, 'lon', rtype, (/RF%dimid_lon/), varid , status)
  1220. IF_NOTOK_MDF(fid=RF%ncid)
  1221. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1222. IF_NOTOK_MDF(fid=RF%ncid)
  1223. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
  1224. IF_NOTOK_MDF(fid=RF%ncid)
  1225. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'longitude' , status)
  1226. IF_NOTOK_MDF(fid=RF%ncid)
  1227. call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_east' , status)
  1228. IF_NOTOK_MDF(fid=RF%ncid)
  1229. RF%varid_lon = varid
  1230. call MDF_Def_Var( RF%ncid, 'lat', MDF_FLOAT, (/RF%dimid_lat/), varid , status)
  1231. IF_NOTOK_MDF(fid=RF%ncid)
  1232. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1233. IF_NOTOK_MDF(fid=RF%ncid)
  1234. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
  1235. IF_NOTOK_MDF(fid=RF%ncid)
  1236. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'latitude' , status)
  1237. IF_NOTOK_MDF(fid=RF%ncid)
  1238. call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_north' , status)
  1239. IF_NOTOK_MDF(fid=RF%ncid)
  1240. RF%varid_lat = varid
  1241. !call MDF_Def_Var( RF%ncid, 'time', MDF_FLOAT, RF%dimid_time, varid , status)
  1242. !IF_NOTOK_MDF(fid=RF%ncid)
  1243. !call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1244. !IF_NOTOK_MDF(fid=RF%ncid)
  1245. !call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
  1246. !IF_NOTOK_MDF(fid=RF%ncid)
  1247. !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'time' , status)
  1248. !IF_NOTOK_MDF(fid=RF%ncid)
  1249. !call MDF_Put_Att( RF%ncid, varid, 'units', 'days since 1950-01-01 00:00:00' , status)
  1250. !IF_NOTOK_MDF(fid=RF%ncid)
  1251. !call MDF_Put_Att( RF%ncid, varid, 'calender', 'gregorian' , status)
  1252. !IF_NOTOK_MDF(fid=RF%ncid)
  1253. !RF%varid_time = varid
  1254. !call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
  1255. !IF_NOTOK_MDF(fid=RF%ncid)
  1256. !call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1257. !IF_NOTOK_MDF(fid=RF%ncid)
  1258. !call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'date' , status)
  1259. !IF_NOTOK_MDF(fid=RF%ncid)
  1260. !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
  1261. !IF_NOTOK_MDF(fid=RF%ncid)
  1262. !call MDF_Put_Att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
  1263. !IF_NOTOK_MDF(fid=RF%ncid)
  1264. !RF%varid_date = varid
  1265. call MDF_Def_Var( RF%ncid, 'area', MDF_FLOAT, (/RF%dimid_lon,RF%dimid_lat/), varid , status)
  1266. IF_NOTOK_MDF(fid=RF%ncid)
  1267. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1268. IF_NOTOK_MDF(fid=RF%ncid)
  1269. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'grid_cell_area' , status)
  1270. IF_NOTOK_MDF(fid=RF%ncid)
  1271. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'grid-cell area' , status)
  1272. IF_NOTOK_MDF(fid=RF%ncid)
  1273. call MDF_Put_Att( RF%ncid, varid, 'units', 'm2' , status)
  1274. IF_NOTOK_MDF(fid=RF%ncid)
  1275. RF%varid_gridbox_area = varid
  1276. call MDF_Def_Var( RF%ncid, 'a', MDF_FLOAT, (/RF%dimid_lev/), varid , status)
  1277. IF_NOTOK_MDF(fid=RF%ncid)
  1278. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1279. IF_NOTOK_MDF(fid=RF%ncid)
  1280. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
  1281. IF_NOTOK_MDF(fid=RF%ncid)
  1282. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient' , status)
  1283. IF_NOTOK_MDF(fid=RF%ncid)
  1284. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  1285. IF_NOTOK_MDF(fid=RF%ncid)
  1286. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a(k)*p0 + b(k)*ps(n,j,i)' , status)
  1287. IF_NOTOK_MDF(fid=RF%ncid)
  1288. call MDF_Put_Att( RF%ncid, varid, 'comment', 'bottom-up' , status)
  1289. IF_NOTOK_MDF(fid=RF%ncid)
  1290. RF%varid_a = varid
  1291. call MDF_Def_Var( RF%ncid, 'b', mdf_float, (/RF%dimid_lev/), varid , status)
  1292. IF_NOTOK_MDF(fid=RF%ncid)
  1293. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1294. IF_NOTOK_MDF(fid=RF%ncid)
  1295. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
  1296. IF_NOTOK_MDF(fid=RF%ncid)
  1297. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient' , status)
  1298. IF_NOTOK_MDF(fid=RF%ncid)
  1299. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  1300. IF_NOTOK_MDF(fid=RF%ncid)
  1301. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a(k)*p0 + b(k)*ps(n,j,i)' , status)
  1302. IF_NOTOK_MDF(fid=RF%ncid)
  1303. call MDF_Put_Att( RF%ncid, varid, 'comment', 'bottom-up' , status)
  1304. IF_NOTOK_MDF(fid=RF%ncid)
  1305. RF%varid_b = varid
  1306. call MDF_Def_Var( RF%ncid, 'a_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
  1307. IF_NOTOK_MDF(fid=RF%ncid)
  1308. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1309. IF_NOTOK_MDF(fid=RF%ncid)
  1310. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
  1311. IF_NOTOK_MDF(fid=RF%ncid)
  1312. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
  1313. IF_NOTOK_MDF(fid=RF%ncid)
  1314. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  1315. IF_NOTOK_MDF(fid=RF%ncid)
  1316. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  1317. IF_NOTOK_MDF(fid=RF%ncid)
  1318. RF%varid_a_bnds = varid
  1319. call MDF_Def_Var( RF%ncid, 'b_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
  1320. IF_NOTOK_MDF(fid=RF%ncid)
  1321. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1322. IF_NOTOK_MDF(fid=RF%ncid)
  1323. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
  1324. IF_NOTOK_MDF(fid=RF%ncid)
  1325. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
  1326. IF_NOTOK_MDF(fid=RF%ncid)
  1327. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  1328. IF_NOTOK_MDF(fid=RF%ncid)
  1329. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  1330. IF_NOTOK_MDF(fid=RF%ncid)
  1331. RF%varid_b_bnds = varid
  1332. call MDF_Def_Var( RF%ncid, 'p0', mdf_float, (/RF%dimid_scalar/), varid , status)
  1333. IF_NOTOK_MDF(fid=RF%ncid)
  1334. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1335. IF_NOTOK_MDF(fid=RF%ncid)
  1336. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'reference pressure value' , status)
  1337. IF_NOTOK_MDF(fid=RF%ncid)
  1338. call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
  1339. IF_NOTOK_MDF(fid=RF%ncid)
  1340. RF%varid_p0 = varid
  1341. !status = pnf90_def_var( RF%ncid, 'ps', MDF_FLOAT, &
  1342. ! (/RF%dimid_lon,RF%dimid_lat,RF%dimid_time/), varid )
  1343. !IF_NOTOK_MDF(fid=RF%ncid)
  1344. !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'surface pressure' , status)
  1345. !IF_NOTOK_MDF(fid=RF%ncid)
  1346. !call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
  1347. !IF_NOTOK_MDF(fid=RF%ncid)
  1348. !RF%varid_ps = varid
  1349. !status = pnf90_def_var( RF%ncid, 'geo_height', MDF_FLOAT, &
  1350. ! (/RF%dimid_lon,RF%dimid_lat,RF%dimid_lev,RF%dimid_time/), varid )
  1351. !IF_NOTOK_MDF(fid=RF%ncid)
  1352. !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'geopotential height' , status)
  1353. !IF_NOTOK_MDF(fid=RF%ncid)
  1354. !call MDF_Put_Att( RF%ncid, varid, 'units', 'm' , status)
  1355. !IF_NOTOK_MDF(fid=RF%ncid)
  1356. !call MDF_Put_Att( RF%ncid, varid, 'comment', 'bottom-up; lower half level; top value implicit infinity' , status)
  1357. !IF_NOTOK_MDF(fid=RF%ncid)
  1358. !RF%varid_geo_height = varid
  1359. ! o end defintion mode
  1360. call MDF_EndDef( RF%ncid , status)
  1361. IF_NOTOK_MDF(fid=RF%ncid)
  1362. ! no records written yet
  1363. RF%trec = 0
  1364. call goLabel() ; status = 0
  1365. END SUBROUTINE RF_GRIDDEF_INIT
  1366. !EOC
  1367. !--------------------------------------------------------------------------
  1368. ! TM5 !
  1369. !--------------------------------------------------------------------------
  1370. !BOP
  1371. !
  1372. ! !IROUTINE: RF_GridDef_Write
  1373. !
  1374. ! !DESCRIPTION:
  1375. !\\
  1376. !\\
  1377. ! !INTERFACE:
  1378. !
  1379. SUBROUTINE RF_GRIDDEF_WRITE( RF, region, status )
  1380. !
  1381. ! !USES:
  1382. !
  1383. use GO, only : TDate, NewDate, rTotal, operator(-)
  1384. use Grid, only : AreaOper
  1385. use MeteoData, only : global_lli, levi, sp_dat
  1386. !
  1387. ! !INPUT/OUTPUT PARAMETERS:
  1388. !
  1389. type(TPdumpFile_GridDef), intent(inout) :: RF
  1390. !
  1391. ! !INPUT PARAMETERS:
  1392. !
  1393. integer, intent(in) :: region
  1394. !
  1395. ! !OUTPUT PARAMETERS:
  1396. !
  1397. integer, intent(out) :: status
  1398. !
  1399. ! !REVISION HISTORY:
  1400. ! 1 Oct 2010 - Achim Strunk -
  1401. ! 10 Jul 2012 - Ph. Le Sager - switch to MDF_NETCDF4
  1402. !
  1403. !EOP
  1404. !------------------------------------------------------------------------
  1405. !BOC
  1406. character(len=*), parameter :: rname = mname//'/RF_GridDef_Write'
  1407. integer :: imr, jmr, lmr
  1408. real, allocatable :: ll(:,:)
  1409. real :: time
  1410. ! --- begin -------------------------------------
  1411. call goLabel(rname)
  1412. ! grid size
  1413. imr = global_lli(region)%nlon
  1414. jmr = global_lli(region)%nlat
  1415. lmr = levi%nlev
  1416. ! next time record:
  1417. RF%trec = RF%trec + 1
  1418. ! o write data
  1419. if ( RF%trec == 1 ) then
  1420. ! lat/lon field:
  1421. allocate( ll(imr,jmr) )
  1422. call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg, status)
  1423. IF_NOTOK_MDF(fid=RF%ncid)
  1424. call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg, status)
  1425. IF_NOTOK_MDF(fid=RF%ncid)
  1426. ll = 1.0
  1427. call AreaOper( global_lli(region), ll, '*', 'm2', status )
  1428. IF_NOTOK_RETURN(status=1)
  1429. call MDF_Put_Var( RF%ncid, RF%varid_gridbox_area, ll , status)
  1430. IF_NOTOK_MDF(fid=RF%ncid)
  1431. call MDF_Put_Var( RF%ncid, RF%varid_a, levi%fa , status)
  1432. IF_NOTOK_MDF(fid=RF%ncid)
  1433. call MDF_Put_Var( RF%ncid, RF%varid_b, levi%fb , status)
  1434. IF_NOTOK_MDF(fid=RF%ncid)
  1435. call MDF_Put_Var( RF%ncid, RF%varid_a_bnds, levi%a(0:levi%nlev) , status)
  1436. IF_NOTOK_MDF(fid=RF%ncid)
  1437. call MDF_Put_Var( RF%ncid, RF%varid_b_bnds, levi%b(0:levi%nlev) , status)
  1438. IF_NOTOK_MDF(fid=RF%ncid)
  1439. call MDF_Put_Var( RF%ncid, RF%varid_p0, (/1.0/) , status)
  1440. IF_NOTOK_MDF(fid=RF%ncid)
  1441. deallocate( ll )
  1442. end if
  1443. !call MDF_Put_Var( RF%ncid, RF%varid_time, time, index=RF%trec , status)
  1444. !IF_NOTOK_MDF(fid=RF%ncid)
  1445. !call MDF_Put_Var( RF%ncid, RF%varid_date, reshape(real(idate_f),(/6,1/), status), &
  1446. ! start=(/1,RF%trec/), count=(/6,1/) )
  1447. !IF_NOTOK_MDF(fid=RF%ncid)
  1448. !status = pnf90_put_var( RF%ncid, RF%varid_ps, &
  1449. ! reshape(sp_dat(region)%data(1:imr,1:jmr,1:1),(/imr,jmr,1/)), &
  1450. ! start=(/1,1,RF%trec/), count=(/imr,jmr,1/) )
  1451. !IF_NOTOK_MDF(fid=RF%ncid)
  1452. !status = pnf90_put_var( RF%ncid, RF%varid_geo_height, &
  1453. ! reshape(gph_dat(region)%data(1:imr,1:jmr,1:lmr),(/imr,jmr,lmr,1/)), &
  1454. ! start=(/1,1,1,RF%trec/), count=(/imr,jmr,lmr,1/) )
  1455. !IF_NOTOK_MDF(fid=RF%ncid)
  1456. call goLabel()
  1457. status = 0
  1458. END SUBROUTINE RF_GridDef_Write
  1459. !EOC
  1460. !--------------------------------------------------------------------------
  1461. ! TM5 !
  1462. !--------------------------------------------------------------------------
  1463. !BOP
  1464. !
  1465. ! !IROUTINE: RF_GRIDDEF_DONE
  1466. !
  1467. ! !DESCRIPTION: close file-1
  1468. !\\
  1469. !\\
  1470. ! !INTERFACE:
  1471. !
  1472. SUBROUTINE RF_GridDef_Done( RF, status )
  1473. !
  1474. ! !INPUT/OUTPUT PARAMETERS:
  1475. !
  1476. type(TPdumpFile_GridDef), intent(inout) :: RF
  1477. !
  1478. ! !OUTPUT PARAMETERS:
  1479. !
  1480. integer, intent(out) :: status
  1481. !
  1482. ! !REVISION HISTORY:
  1483. ! 1 Oct 2010 - Achim Strunk -
  1484. !
  1485. !EOP
  1486. !------------------------------------------------------------------------
  1487. !BOC
  1488. character(len=*), parameter :: rname = mname//'/RF_GridDef_Done'
  1489. ! --- begin -------------------------------------
  1490. call goLabel(rname)
  1491. call MDF_Close( RF%ncid , status)
  1492. IF_NOTOK_RETURN(status=1)
  1493. call goLabel()
  1494. status = 0
  1495. END SUBROUTINE RF_GRIDDEF_DONE
  1496. !EOC
  1497. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1498. ! FILE2: 3D field of monthly Model pressure [Pa] and temperature [K].
  1499. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1500. !--------------------------------------------------------------------------
  1501. ! TM5 !
  1502. !--------------------------------------------------------------------------
  1503. !BOP
  1504. !
  1505. ! !IROUTINE: RF_TP_INIT
  1506. !
  1507. ! !DESCRIPTION: file-2 : open and define var/att
  1508. !
  1509. !\\
  1510. !\\
  1511. ! !INTERFACE:
  1512. !
  1513. SUBROUTINE RF_TP_Init( RF, fdir, model, expid, region, idate_f, dhour, status )
  1514. !
  1515. ! !USES:
  1516. !
  1517. use partools, only : MPI_INFO_NULL, localComm
  1518. use MeteoData, only : global_lli, levi
  1519. !
  1520. ! !OUTPUT PARAMETERS:
  1521. !
  1522. type(TPdumpFile_TP), intent(out) :: RF
  1523. integer, intent(out) :: status
  1524. !
  1525. ! !INPUT PARAMETERS:
  1526. !
  1527. character(len=*), intent(in) :: fdir
  1528. character(len=*), intent(in) :: model
  1529. character(len=*), intent(in) :: expid
  1530. integer, intent(in) :: region
  1531. integer, intent(in) :: idate_f(6)
  1532. integer, intent(in) :: dhour
  1533. !
  1534. ! !REVISION HISTORY:
  1535. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  1536. ! 7 Aug 2012 - Ph. Le Sager - switch to netcdf-4 thru MDF
  1537. !
  1538. !EOP
  1539. !------------------------------------------------------------------------
  1540. !BOC
  1541. character(len=*), parameter :: rname = mname//'/RF_TP_Init'
  1542. ! --- local ------------------------------------
  1543. character(len=256) :: fname
  1544. integer :: varid, i1, i2, j1, j2
  1545. ! --- begin -------------------------------------
  1546. call goLabel(rname)
  1547. ! store arguments
  1548. RF%dhour = dhour
  1549. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  1550. n_tp_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, mess='TP_Init' )
  1551. if ( n_tp_rec == 0 ) then
  1552. tp_apply = .false.
  1553. status=0
  1554. return
  1555. end if
  1556. ! o open file
  1557. ! write filename
  1558. write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
  1559. trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), 'TP', idate_f(1:3)
  1560. ! open, overwrite existing files (clobber)
  1561. #ifdef MPI
  1562. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
  1563. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  1564. if (status/=0) then
  1565. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  1566. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  1567. TRACEBACK; status=1; return
  1568. end if
  1569. #else
  1570. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
  1571. IF_NOTOK_RETURN(status=1)
  1572. #endif
  1573. ! o global attributes
  1574. call mdf_put_att( RF%ncid, MDF_GLOBAL, 'title', 'model pressure and temperature', status)
  1575. IF_NOTOK_MDF(fid=RF%ncid)
  1576. call mdf_put_att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
  1577. IF_NOTOK_MDF(fid=RF%ncid)
  1578. call mdf_put_att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
  1579. IF_NOTOK_MDF(fid=RF%ncid)
  1580. call mdf_put_att( RF%ncid, MDF_GLOBAL, 'dataset_version', trim(dataset_version) , status)
  1581. IF_NOTOK_MDF(fid=RF%ncid)
  1582. ! o define dimensions
  1583. call mdf_def_dim( RF%ncid, 'lon', global_lli(region)%nlon, RF%dimid_lon , status)
  1584. IF_NOTOK_MDF(fid=RF%ncid)
  1585. call mdf_def_dim( RF%ncid, 'lat', global_lli(region)%nlat, RF%dimid_lat , status)
  1586. IF_NOTOK_MDF(fid=RF%ncid)
  1587. call mdf_def_dim( RF%ncid, 'lev', levi%nlev, RF%dimid_lev , status)
  1588. IF_NOTOK_MDF(fid=RF%ncid)
  1589. call mdf_def_dim( RF%ncid, 'time', n_tp_rec, RF%dimid_time , status)
  1590. IF_NOTOK_MDF(fid=RF%ncid)
  1591. call mdf_def_dim( RF%ncid, 'datelen', 6, RF%dimid_datelen , status)
  1592. IF_NOTOK_MDF(fid=RF%ncid)
  1593. ! o define variables
  1594. call mdf_def_var( RF%ncid, 'lon', MDF_FLOAT, (/RF%dimid_lon/), varid , status)
  1595. IF_NOTOK_MDF(fid=RF%ncid)
  1596. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1597. IF_NOTOK_MDF(fid=RF%ncid)
  1598. call mdf_put_att( RF%ncid, varid, 'standard_name', 'longitude' , status)
  1599. IF_NOTOK_MDF(fid=RF%ncid)
  1600. call mdf_put_att( RF%ncid, varid, 'long_name', 'longitude' , status)
  1601. IF_NOTOK_MDF(fid=RF%ncid)
  1602. call mdf_put_att( RF%ncid, varid, 'units', 'degrees_east' , status)
  1603. IF_NOTOK_MDF(fid=RF%ncid)
  1604. RF%varid_lon = varid
  1605. call mdf_def_var( RF%ncid, 'lat', MDF_FLOAT, (/RF%dimid_lat/), varid , status)
  1606. IF_NOTOK_MDF(fid=RF%ncid)
  1607. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1608. IF_NOTOK_MDF(fid=RF%ncid)
  1609. call mdf_put_att( RF%ncid, varid, 'standard_name', 'latitude' , status)
  1610. IF_NOTOK_MDF(fid=RF%ncid)
  1611. call mdf_put_att( RF%ncid, varid, 'long_name', 'latitude' , status)
  1612. IF_NOTOK_MDF(fid=RF%ncid)
  1613. call mdf_put_att( RF%ncid, varid, 'units', 'degrees_north' , status)
  1614. IF_NOTOK_MDF(fid=RF%ncid)
  1615. RF%varid_lat = varid
  1616. call mdf_def_var( RF%ncid, 'lev', MDF_FLOAT, (/RF%dimid_lev/), varid , status)
  1617. IF_NOTOK_MDF(fid=RF%ncid)
  1618. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1619. IF_NOTOK_MDF(fid=RF%ncid)
  1620. call mdf_put_att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate' , status)
  1621. IF_NOTOK_MDF(fid=RF%ncid)
  1622. call mdf_put_att( RF%ncid, varid, 'long_name', 'level' , status)
  1623. IF_NOTOK_MDF(fid=RF%ncid)
  1624. call mdf_put_att( RF%ncid, varid, 'units', '1' , status)
  1625. IF_NOTOK_MDF(fid=RF%ncid)
  1626. call mdf_put_att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  1627. IF_NOTOK_MDF(fid=RF%ncid)
  1628. RF%varid_lev = varid
  1629. call mdf_def_var( RF%ncid, 'time', MDF_FLOAT, (/RF%dimid_time/), varid , status)
  1630. IF_NOTOK_MDF(fid=RF%ncid)
  1631. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1632. IF_NOTOK_MDF(fid=RF%ncid)
  1633. call mdf_put_att( RF%ncid, varid, 'standard_name', 'time' , status)
  1634. IF_NOTOK_MDF(fid=RF%ncid)
  1635. call mdf_put_att( RF%ncid, varid, 'long_name', 'time' , status)
  1636. IF_NOTOK_MDF(fid=RF%ncid)
  1637. call mdf_put_att( RF%ncid, varid, 'units', 'days since 1950-01-01 00:00:00' , status)
  1638. IF_NOTOK_MDF(fid=RF%ncid)
  1639. call mdf_put_att( RF%ncid, varid, 'calender', 'gregorian' , status)
  1640. IF_NOTOK_MDF(fid=RF%ncid)
  1641. RF%varid_time = varid
  1642. allocate(RF%time(n_tp_rec))
  1643. call mdf_def_var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
  1644. IF_NOTOK_MDF(fid=RF%ncid)
  1645. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1646. IF_NOTOK_MDF(fid=RF%ncid)
  1647. call mdf_put_att( RF%ncid, varid, 'long_name', 'date and time' , status)
  1648. IF_NOTOK_MDF(fid=RF%ncid)
  1649. call mdf_put_att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
  1650. IF_NOTOK_MDF(fid=RF%ncid)
  1651. RF%varid_date = varid
  1652. allocate(RF%date(6,n_tp_rec))
  1653. call mdf_def_var( RF%ncid, 'ps', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
  1654. IF_NOTOK_MDF(fid=RF%ncid)
  1655. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1656. IF_NOTOK_MDF(fid=RF%ncid)
  1657. call mdf_put_att( RF%ncid, varid, 'standard_name', 'surface_air_pressure' , status)
  1658. IF_NOTOK_MDF(fid=RF%ncid)
  1659. call mdf_put_att( RF%ncid, varid, 'long_name', 'surface pressure' , status)
  1660. IF_NOTOK_MDF(fid=RF%ncid)
  1661. call mdf_put_att( RF%ncid, varid, 'units', 'Pa' , status)
  1662. IF_NOTOK_MDF(fid=RF%ncid)
  1663. RF%varid_ps = varid
  1664. call mdf_def_var( RF%ncid, 'orog', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
  1665. IF_NOTOK_MDF(fid=RF%ncid)
  1666. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1667. IF_NOTOK_MDF(fid=RF%ncid)
  1668. call mdf_put_att( RF%ncid, varid, 'standard_name', 'surface_altitude' , status)
  1669. IF_NOTOK_MDF(fid=RF%ncid)
  1670. call mdf_put_att( RF%ncid, varid, 'long_name', 'surface altitude' , status)
  1671. IF_NOTOK_MDF(fid=RF%ncid)
  1672. call mdf_put_att( RF%ncid, varid, 'units', 'm' , status)
  1673. IF_NOTOK_MDF(fid=RF%ncid)
  1674. RF%varid_orog = varid
  1675. call mdf_def_var( RF%ncid, 'surface_temp', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status)
  1676. IF_NOTOK_MDF(fid=RF%ncid)
  1677. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1678. IF_NOTOK_MDF(fid=RF%ncid)
  1679. call mdf_put_att( RF%ncid, varid, 'standard_name', 'surface_temperature' , status)
  1680. IF_NOTOK_MDF(fid=RF%ncid)
  1681. call mdf_put_att( RF%ncid, varid, 'long_name', 'surface temperature' , status)
  1682. IF_NOTOK_MDF(fid=RF%ncid)
  1683. call mdf_put_att( RF%ncid, varid, 'units', 'K' , status)
  1684. IF_NOTOK_MDF(fid=RF%ncid)
  1685. call mdf_put_att( RF%ncid, varid, 'comment', &
  1686. '2m temperature from MARS archive or IFS model (grib 167, 2T)' , status)
  1687. IF_NOTOK_MDF(fid=RF%ncid)
  1688. RF%varid_surface_temp = varid
  1689. allocate( RF%data2d(i1:i2, j1:j2, n_tp_rec, 3) )
  1690. call mdf_def_var( RF%ncid, 'geopotential', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), &
  1691. varid, status)
  1692. IF_NOTOK_MDF(fid=RF%ncid)
  1693. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1694. IF_NOTOK_MDF(fid=RF%ncid)
  1695. call mdf_put_att( RF%ncid, varid, 'standard_name', 'geopotential' , status)
  1696. IF_NOTOK_MDF(fid=RF%ncid)
  1697. call mdf_put_att( RF%ncid, varid, 'long_name', 'geopotential' , status)
  1698. IF_NOTOK_MDF(fid=RF%ncid)
  1699. call mdf_put_att( RF%ncid, varid, 'units', 'm2 s-2' , status)
  1700. IF_NOTOK_MDF(fid=RF%ncid)
  1701. call mdf_put_att( RF%ncid, varid, 'comment', 'at mid levels' , status)
  1702. IF_NOTOK_MDF(fid=RF%ncid)
  1703. RF%varid_geop = varid
  1704. call mdf_def_var( RF%ncid, 'pressure', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
  1705. IF_NOTOK_MDF(fid=RF%ncid)
  1706. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1707. IF_NOTOK_MDF(fid=RF%ncid)
  1708. call mdf_put_att( RF%ncid, varid, 'standard_name', 'pressure' , status)
  1709. IF_NOTOK_MDF(fid=RF%ncid)
  1710. call mdf_put_att( RF%ncid, varid, 'long_name', 'pressure' , status)
  1711. IF_NOTOK_MDF(fid=RF%ncid)
  1712. call mdf_put_att( RF%ncid, varid, 'units', 'Pa' , status)
  1713. IF_NOTOK_MDF(fid=RF%ncid)
  1714. call mdf_put_att( RF%ncid, varid, 'comment', 'at mid levels' , status)
  1715. IF_NOTOK_MDF(fid=RF%ncid)
  1716. RF%varid_pressure = varid
  1717. call mdf_def_var( RF%ncid, 'temp', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
  1718. IF_NOTOK_MDF(fid=RF%ncid)
  1719. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1720. IF_NOTOK_MDF(fid=RF%ncid)
  1721. call mdf_put_att( RF%ncid, varid, 'standard_name', 'air_temperature' , status)
  1722. IF_NOTOK_MDF(fid=RF%ncid)
  1723. call mdf_put_att( RF%ncid, varid, 'long_name', 'temperature' , status)
  1724. IF_NOTOK_MDF(fid=RF%ncid)
  1725. call mdf_put_att( RF%ncid, varid, 'units', 'K' , status)
  1726. IF_NOTOK_MDF(fid=RF%ncid)
  1727. call mdf_put_att( RF%ncid, varid, 'comment', 'bottom-up; full levels' , status)
  1728. IF_NOTOK_MDF(fid=RF%ncid)
  1729. RF%varid_temp = varid
  1730. call mdf_def_var( RF%ncid, 'specific_humidity', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), &
  1731. varid, status)
  1732. IF_NOTOK_MDF(fid=RF%ncid)
  1733. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1734. IF_NOTOK_MDF(fid=RF%ncid)
  1735. call mdf_put_att( RF%ncid, varid, 'standard_name', 'specific_humidity' , status)
  1736. IF_NOTOK_MDF(fid=RF%ncid)
  1737. call mdf_put_att( RF%ncid, varid, 'long_name', 'specific humidity' , status)
  1738. IF_NOTOK_MDF(fid=RF%ncid)
  1739. call mdf_put_att( RF%ncid, varid, 'units', 'kg kg-1' , status)
  1740. IF_NOTOK_MDF(fid=RF%ncid)
  1741. call mdf_put_att( RF%ncid, varid, 'comment', 'mass fraction of water vapor in moist air; (kg water)/(kg air)' , status)
  1742. IF_NOTOK_MDF(fid=RF%ncid)
  1743. RF%varid_humid = varid
  1744. call mdf_def_var( RF%ncid, 'U', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
  1745. IF_NOTOK_MDF(fid=RF%ncid)
  1746. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1747. IF_NOTOK_MDF(fid=RF%ncid)
  1748. call mdf_put_att( RF%ncid, varid, 'standard_name', 'eastward_wind' , status)
  1749. IF_NOTOK_MDF(fid=RF%ncid)
  1750. call mdf_put_att( RF%ncid, varid, 'long_name', 'zonal wind' , status)
  1751. IF_NOTOK_MDF(fid=RF%ncid)
  1752. call mdf_put_att( RF%ncid, varid, 'units', 'm s-1' , status)
  1753. IF_NOTOK_MDF(fid=RF%ncid)
  1754. call mdf_put_att( RF%ncid, varid, 'comment', 'computed from mass fluxes through grid box boundaries' , status)
  1755. IF_NOTOK_MDF(fid=RF%ncid)
  1756. RF%varid_u = varid
  1757. call mdf_def_var( RF%ncid, 'V', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
  1758. IF_NOTOK_MDF(fid=RF%ncid)
  1759. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1760. IF_NOTOK_MDF(fid=RF%ncid)
  1761. call mdf_put_att( RF%ncid, varid, 'standard_name', 'northward_wind' , status)
  1762. IF_NOTOK_MDF(fid=RF%ncid)
  1763. call mdf_put_att( RF%ncid, varid, 'long_name', 'meridional wind' , status)
  1764. IF_NOTOK_MDF(fid=RF%ncid)
  1765. call mdf_put_att( RF%ncid, varid, 'units', 'm s-1' , status)
  1766. IF_NOTOK_MDF(fid=RF%ncid)
  1767. call mdf_put_att( RF%ncid, varid, 'comment', 'computed from mass fluxes through grid box boundaries' , status)
  1768. IF_NOTOK_MDF(fid=RF%ncid)
  1769. RF%varid_v = varid
  1770. call mdf_def_var( RF%ncid, 'W', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
  1771. IF_NOTOK_MDF(fid=RF%ncid)
  1772. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  1773. IF_NOTOK_MDF(fid=RF%ncid)
  1774. call mdf_put_att( RF%ncid, varid, 'long_name', 'vertical wind velocity' , status)
  1775. IF_NOTOK_MDF(fid=RF%ncid)
  1776. call mdf_put_att( RF%ncid, varid, 'units', 'm s-1' , status)
  1777. IF_NOTOK_MDF(fid=RF%ncid)
  1778. call mdf_put_att( RF%ncid, varid, 'comment', 'computed from mass fluxes through grid box boundaries' , status)
  1779. IF_NOTOK_MDF(fid=RF%ncid)
  1780. RF%varid_w = varid
  1781. allocate( RF%data3d(i1:i2, j1:j2, levi%nlev, n_tp_rec, 7) )
  1782. ! o end defintion mode
  1783. call mdf_enddef( RF%ncid , status)
  1784. IF_NOTOK_MDF(fid=RF%ncid)
  1785. ! o
  1786. ! no records written yet
  1787. RF%trec = 0
  1788. call goLabel()
  1789. ! ok
  1790. status = 0
  1791. END SUBROUTINE RF_TP_Init
  1792. !EOC
  1793. !--------------------------------------------------------------------------
  1794. ! TM5 !
  1795. !--------------------------------------------------------------------------
  1796. !BOP
  1797. !
  1798. ! !IROUTINE: RF_TP_Write
  1799. !
  1800. ! !DESCRIPTION: store records, and if last time step write data to file
  1801. !\\
  1802. !\\
  1803. ! !INTERFACE:
  1804. !
  1805. SUBROUTINE RF_TP_Write( RF, region, idate_f, status )
  1806. !
  1807. ! !USES:
  1808. !
  1809. use Binas , only : grav
  1810. use Phys , only : GeoPotentialHeight
  1811. use Grid , only : FPressure, HPressure
  1812. use GO , only : TDate, NewDate, rTotal, operator(-)
  1813. use partools , only : myid, root
  1814. use MeteoData , only : global_lli, lli, levi
  1815. use MeteoData , only : sp_dat, temper_dat, humid_dat, pu_dat, pv_dat, mfw_dat, gph_dat, oro_dat, t2m_dat
  1816. use MeteoData , only : m_dat
  1817. use global_data, only : mass_dat
  1818. !
  1819. ! !INPUT/OUTPUT PARAMETERS:
  1820. !
  1821. type(TPdumpFile_TP), intent(inout) :: RF
  1822. !
  1823. ! !INPUT PARAMETERS:
  1824. !
  1825. integer, intent(in) :: region
  1826. integer, intent(in) :: idate_f(6)
  1827. !
  1828. ! !OUTPUT PARAMETERS:
  1829. !
  1830. integer, intent(out) :: status
  1831. !
  1832. ! !REVISION HISTORY:
  1833. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  1834. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  1835. !
  1836. !EOP
  1837. !------------------------------------------------------------------------
  1838. !BOC
  1839. character(len=*), parameter :: rname = mname//'/RF_TP_Write'
  1840. ! --- local ------------------------------------
  1841. integer :: i, j, l, i1, i2, j1, j2
  1842. integer :: imr, jmr, lmr, klm
  1843. real :: lev(levi%nlev)
  1844. type(TDate) :: t, t0
  1845. real :: time
  1846. real, allocatable :: field3d(:,:,:)
  1847. real :: p_hlev(0:levi%nlev)
  1848. ! --- begin -------------------------------------
  1849. ! for multiple of dhour only ...
  1850. if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
  1851. status=0; return
  1852. end if
  1853. call goLabel(rname)
  1854. ! grid size
  1855. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  1856. imr=i2-i1+1
  1857. jmr=j2-j1+1
  1858. lmr = levi%nlev
  1859. ! next time record:
  1860. RF%trec = RF%trec + 1
  1861. ! time since reftime:
  1862. t0 = NewDate( time6=time_reftime6 )
  1863. t = NewDate( time6=idate_f )
  1864. time = rTotal( t - t0, 'day' )
  1865. if(okdebug)then
  1866. write(gol,*) "RF_TP_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
  1867. end if
  1868. ! o write data
  1869. if ( RF%trec == 1 ) then
  1870. call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
  1871. IF_NOTOK_MDF(fid=RF%ncid)
  1872. call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
  1873. IF_NOTOK_MDF(fid=RF%ncid)
  1874. do l = 1, lmr
  1875. lev(l) = real(l)
  1876. end do
  1877. call MDF_Put_Var( RF%ncid, RF%varid_lev, lev , status)
  1878. IF_NOTOK_MDF(fid=RF%ncid)
  1879. end if
  1880. ! temporary storage for 3D fields
  1881. allocate( field3d(i1:i2,j1:j2,1:lmr) ) ; field3d = 0.
  1882. !-------- FILL DIAGNOSTIC ARRAYS
  1883. RF%time(RF%trec) = time
  1884. RF%date(:,RF%trec) = real(idate_f)
  1885. RF%data2d(:,:,RF%trec,1) = sp_dat(region)%data(i1:i2,j1:j2,1)
  1886. RF%data2d(:,:,RF%trec,2) = oro_dat(region)%data(i1:i2,j1:j2,1)
  1887. RF%data2d(:,:,RF%trec,3) = t2m_dat(region)%data(i1:i2,j1:j2,1)
  1888. ! o geopotential
  1889. ! fill mid level geopotential:
  1890. do j = j1, j2
  1891. do i = i1, i2
  1892. ! half level pressures
  1893. call HPressure( levi, sp_dat(region)%data(i,j,1), p_hlev, status )
  1894. IF_NOTOK_RETURN(status=1)
  1895. ! mid level gph (m)
  1896. call GeoPotentialHeight( lmr, p_hlev, temper_dat(region)%data(i,j,:), &
  1897. humid_dat(region)%data(i,j,:), oro_dat(region)%data(i,j,1)/grav, &
  1898. field3d(i,j,:) ) ! m
  1899. end do
  1900. end do
  1901. ! multiply with gravity for correct unit:
  1902. field3d = field3d * grav ! m2/s2
  1903. RF%data3d(:,:,:,RF%trec,1) = field3d
  1904. ! o pressure
  1905. ! fill mid level pressure
  1906. call FPressure( levi, sp_dat(region)%data(i1:i2,j1:j2,1), field3d, status )
  1907. IF_NOTOK_RETURN(status=1)
  1908. RF%data3d(:,:,:,RF%trec,2) = field3d
  1909. ! o temperature
  1910. RF%data3d(:,:,:,RF%trec,3) = temper_dat(region)%data(i1:i2,j1:j2,1:lmr)
  1911. ! o specific humidity
  1912. RF%data3d(:,:,:,RF%trec,4) = humid_dat(region)%data(i1:i2,j1:j2,1:lmr)
  1913. ! o wind fields
  1914. CALL UPDATE_HALO( dgrid(region), pu_dat(region)%data, pu_dat(region)%halo, status)
  1915. IF_NOTOK_RETURN(status=1)
  1916. CALL UPDATE_HALO( dgrid(region), pv_dat(region)%data, pv_dat(region)%halo, status)
  1917. IF_NOTOK_RETURN(status=1)
  1918. ! average U wind
  1919. field3d = 0.5 * ( pu_dat(region)%data(i1-1:i2-1,j1:j2,1:lmr) + pu_dat(region)%data(i1:i2,j1:j2,1:lmr) ) &
  1920. / m_dat(region)%data(i1:i2,j1:j2,1:lmr) ! 1/s
  1921. do j = j1, j2
  1922. field3d(:,j,:) = field3d(:,j,:) * lli(region)%dx(j-j1+1) ! m/s
  1923. end do
  1924. RF%data3d(:,:,:,RF%trec,5) = field3d
  1925. ! average V wind:
  1926. field3d = 0.5 * ( pv_dat(region)%data(i1:i2,j1-1:j2-1,1:lmr) + pv_dat(region)%data(i1:i2,j1:j2,1:lmr) ) &
  1927. / m_dat(region)%data(i1:i2,j1:j2,1:lmr) ! 1/s
  1928. field3d = field3d * lli(region)%dy ! m/s
  1929. RF%data3d(:,:,:,RF%trec,6) = field3d
  1930. ! from downward massflux to upward average W wind:
  1931. field3d = 0.5 * ( mfw_dat(region)%data(i1:i2,j1:j2,0:lmr-1) + mfw_dat(region)%data(i1:i2,j1:j2,1:lmr) ) &
  1932. / m_dat(region)%data(i1:i2,j1:j2,1:lmr) ! 1/s
  1933. do l = 1, lmr
  1934. field3d(:,:,l) = - 1.0 * field3d(:,:,l) * &
  1935. abs( gph_dat(region)%data(i1:i2,j1:j2,l+1) - gph_dat(region)%data(i1:i2,j1:j2,l) ) ! m/s
  1936. end do
  1937. RF%data3d(:,:,:,RF%trec,7) = field3d
  1938. !-------- WRITE ARRAYS
  1939. if ( RF%trec == n_tp_rec ) then
  1940. ! time
  1941. call MDF_Put_Var( RF%ncid, RF%varid_time, RF%time, status)!, start=(/1/), count=(/n_tp_rec/))
  1942. IF_NOTOK_MDF(fid=RF%ncid)
  1943. ! date
  1944. call MDF_Put_Var( RF%ncid, RF%varid_date, RF%date, status )!, &
  1945. ! start=(/1,1/), count=(/6,1/) )
  1946. IF_NOTOK_MDF(fid=RF%ncid)
  1947. ! surface pressure
  1948. call MDF_Put_Var( RF%ncid, RF%varid_ps, RF%data2d(:,:,:,1), status, start=(/i1,j1,1/), count=(/imr,jmr,n_tp_rec/) )
  1949. IF_NOTOK_MDF(fid=RF%ncid)
  1950. ! orography (in m!)
  1951. call MDF_Put_Var( RF%ncid, RF%varid_orog, RF%data2d(:,:,:,2), status, start=(/i1,j1,1/), count=(/imr,jmr,n_tp_rec/) )
  1952. IF_NOTOK_MDF(fid=RF%ncid)
  1953. ! surface temperature = 2m temperature
  1954. call MDF_Put_Var( RF%ncid, RF%varid_surface_temp, RF%data2d(:,:,:,3), status, start=(/i1,j1,1/) ) !, count=(/imr,jmr,1/) )
  1955. IF_NOTOK_MDF(fid=RF%ncid)
  1956. ! geopotential
  1957. call MDF_Put_Var( RF%ncid, RF%varid_geop, RF%data3d(:,:,:,:,1), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,n_tp_rec/))
  1958. IF_NOTOK_MDF(fid=RF%ncid)
  1959. ! pressure
  1960. call MDF_Put_Var( RF%ncid, RF%varid_pressure, RF%data3d(:,:,:,:,2), status, start=(/i1,j1,1,1/), &
  1961. count=(/imr,jmr,lmr,n_tp_rec/))
  1962. IF_NOTOK_MDF(fid=RF%ncid)
  1963. ! temperature
  1964. call MDF_Put_Var( RF%ncid, RF%varid_temp, RF%data3d(:,:,:,:,3), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,n_tp_rec/))
  1965. IF_NOTOK_MDF(fid=RF%ncid)
  1966. ! specific humidity
  1967. call MDF_Put_Var( RF%ncid, RF%varid_humid, RF%data3d(:,:,:,:,4), status, start=(/i1,j1,1,1/),count=(/imr,jmr,lmr,n_tp_rec/))
  1968. IF_NOTOK_MDF(fid=RF%ncid)
  1969. ! winds
  1970. call MDF_Put_Var( RF%ncid, RF%varid_u, RF%data3d(:,:,:,:,5), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,n_tp_rec/) )
  1971. IF_NOTOK_MDF(fid=RF%ncid)
  1972. call MDF_Put_Var( RF%ncid, RF%varid_v, RF%data3d(:,:,:,:,6), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,n_tp_rec/) )
  1973. IF_NOTOK_MDF(fid=RF%ncid)
  1974. call MDF_Put_Var( RF%ncid, RF%varid_w, RF%data3d(:,:,:,:,7), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,n_tp_rec/) )
  1975. IF_NOTOK_MDF(fid=RF%ncid)
  1976. end if
  1977. ! Done
  1978. deallocate( field3d )
  1979. call goLabel()
  1980. status = 0
  1981. END SUBROUTINE RF_TP_Write
  1982. !EOC
  1983. !--------------------------------------------------------------------------
  1984. ! TM5 !
  1985. !--------------------------------------------------------------------------
  1986. !BOP
  1987. !
  1988. ! !IROUTINE: RF_TP_Done
  1989. !
  1990. ! !DESCRIPTION: close file #2
  1991. !\\
  1992. !\\
  1993. ! !INTERFACE:
  1994. !
  1995. subroutine RF_TP_Done( RF, status )
  1996. !
  1997. ! !INPUT/OUTPUT PARAMETERS:
  1998. !
  1999. type(TPdumpFile_TP), intent(inout) :: RF
  2000. !
  2001. ! !OUTPUT PARAMETERS:
  2002. !
  2003. integer, intent(out) :: status
  2004. !
  2005. ! !REVISION HISTORY:
  2006. ! 1 Oct 2010 - Achim Strunk -
  2007. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  2008. !
  2009. !EOP
  2010. !------------------------------------------------------------------------
  2011. !BOC
  2012. character(len=*), parameter :: rname = mname//'/RF_TP_Done'
  2013. ! --- begin -------------------------------------
  2014. call goLabel(rname)
  2015. call MDF_Close( RF%ncid , status)
  2016. IF_NOTOK_RETURN(status=1)
  2017. deallocate( rf%time, rf%date, rf%data2d, rf%data3d )
  2018. call goLabel() ; status = 0
  2019. end subroutine RF_TP_Done
  2020. !EOC
  2021. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2022. ! FILE3: 3D fields for O3, CO, CH4, ... Volume Mixing Ratios
  2023. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2024. !--------------------------------------------------------------------------
  2025. ! TM5 !
  2026. !--------------------------------------------------------------------------
  2027. !BOP
  2028. !
  2029. ! !IROUTINE: RF_VMR_Init
  2030. !
  2031. ! !DESCRIPTION: open and define variables/attribute for file #3
  2032. !\\
  2033. !\\
  2034. ! !INTERFACE:
  2035. !
  2036. subroutine RF_VMR_Init( RF, fdir, model, expid, filetype, region, &
  2037. idate_f, dhour, tracer_names, status )
  2038. !
  2039. ! !USES:
  2040. !
  2041. use Binas, only : xmair
  2042. use GO, only : goReadFromLine, goUpCase
  2043. use chem_param, only : ntrace, names, ra
  2044. use partools, only : PAR_BROADCAST, MPI_INFO_NULL, localComm
  2045. use MeteoData, only : global_lli, lli, levi, sp_dat
  2046. use dims, only : xbeg, xend, ybeg, yend, dx, dy, dz, xref, yref, zref
  2047. use dims, only : zbeg, zend
  2048. !
  2049. ! !INPUT/OUTPUT PARAMETERS:
  2050. !
  2051. type(TPdumpFile_VMR), intent(inout) :: RF
  2052. !
  2053. ! !INPUT PARAMETERS:
  2054. !
  2055. character(len=*), intent(in) :: fdir
  2056. character(len=*), intent(in) :: model
  2057. character(len=*), intent(in) :: expid
  2058. character(len=*), intent(in) :: filetype
  2059. integer, intent(in) :: region
  2060. integer, intent(in) :: idate_f(6)
  2061. real, intent(in) :: dhour
  2062. character(len=*), intent(in) :: tracer_names
  2063. !
  2064. ! !OUTPUT PARAMETERS:
  2065. !
  2066. integer, intent(out) :: status
  2067. !
  2068. ! !REVISION HISTORY:
  2069. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  2070. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  2071. ! 15 Apr 2014 - Ph. Le Sager - tropomi add-ons
  2072. ! 8 Oct 2014 - H. Eskes - tropomi add-ons
  2073. !
  2074. !EOP
  2075. !------------------------------------------------------------------------
  2076. !BOC
  2077. character(len=*), parameter :: rname = mname//'/RF_VMR_Init'
  2078. ! --- local ------------------------------------
  2079. character(len=256) :: fname, history, sysdate, model_meteo
  2080. integer :: varid, i1, i2, j1, j2
  2081. integer, dimension(8) :: isysdate
  2082. character(len=256) :: trnames
  2083. character(len=8) :: trname, tmname
  2084. integer :: k, itr, posend, pospoint
  2085. integer :: imr, jmr, lmr, si, ei, ix, jy
  2086. character(len=32) :: varname_spec
  2087. character(len=5) :: zone
  2088. character(len=64) :: cf_medium_stnd, cf_medium_long
  2089. character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
  2090. character(len=64) :: cf_spec_stnd, cf_spec_long
  2091. character(len=4) :: cf_enti_type
  2092. character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
  2093. character(len=512) :: comment
  2094. character(len=6) :: csize
  2095. integer, dimension(6) :: idate_f_end, idate_create
  2096. type(TDate) :: date_f_end, date_create
  2097. ! --- begin -------------------------------------
  2098. call goLabel(rname)
  2099. ! store arguments
  2100. RF%dhour = dhour
  2101. RF%dsec = int(dhour*3600.)
  2102. RF%tracer_names = tracer_names
  2103. ! Test that dsec is multiple of dynamic-step/2 (nread in sec)
  2104. if (((RF%dsec*2)/nread < 1).or.(modulo(RF%dsec,nread/2)/=0))then
  2105. write(gol,*) "timeseries timestep should be a multiple of (dynamic_timestep)/2"; call goErr
  2106. TRACEBACK; status=1; return
  2107. end if
  2108. ! size
  2109. imr = global_lli(region)%nlon
  2110. jmr = global_lli(region)%nlat
  2111. lmr = levi%nlev
  2112. ! number of time steps
  2113. rf%n_rec = GET_N_TIME_RECORDS( idate_f, rf%dsec, mess='VMR_Init' )
  2114. ! degenerated cases (eg, very short runs)
  2115. if ( rf%n_rec == 0 ) then
  2116. rf%apply = .false.
  2117. status=0
  2118. return
  2119. end if
  2120. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  2121. ! set tracer index for requested tracers:
  2122. write (gol,'("selected tracers for VMR output:")'); call goPr
  2123. ! initialise RF
  2124. RF%ntr = 0
  2125. #ifdef with_m7
  2126. RF%lpmx = .false.
  2127. RF%sizepmx = -1.0
  2128. #endif
  2129. RF%itr = -1
  2130. trnames = tracer_names
  2131. do
  2132. ! empty ?
  2133. if ( len_trim(trnames) == 0 ) exit
  2134. ! next number:
  2135. if ( RF%ntr == ntrace ) then
  2136. write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
  2137. TRACEBACK; status=1; return
  2138. end if
  2139. RF%ntr = RF%ntr + 1
  2140. ! extract leading name:
  2141. call goReadFromLine( trnames, trname, status, sep=' ' )
  2142. IF_NOTOK_RETURN(status=1)
  2143. #ifdef with_m7
  2144. ! ---------------------------
  2145. ! check for PMx
  2146. ! ---------------------------
  2147. if( strlowercase(trname(1:2)) == 'pm' ) then
  2148. RF%lpmx(RF%ntr) = .true.
  2149. RF%itr (RF%ntr) = -1
  2150. ! paste size to real
  2151. read(trname(3:len_trim(trname)), * ) RF%sizepmx(RF%ntr)
  2152. else
  2153. #endif
  2154. ! convert to tm5 name:
  2155. select case ( trim(strlowercase(trname)) )
  2156. case ( 'hcho' ) ; tmname = 'CH2O'
  2157. case ( 'rn', 'radon' ) ; tmname = 'Rn222'
  2158. case ( 'pb', 'lead' ) ; tmname = 'Pb210'
  2159. case default ; tmname = trname
  2160. end select
  2161. ! --------------------------------
  2162. ! NOy and M7 are special cases ...
  2163. ! --------------------------------
  2164. select case ( trim(strlowercase(tmname)) )
  2165. case( 'noy' )
  2166. ! defined as ntrace+1
  2167. RF%itr(RF%ntr) = iNOy
  2168. write (gol,'(" * ",a10)') trim(trname); call goPr
  2169. #ifdef with_m7
  2170. case( 'tso4' )
  2171. ! defined as ntrace+2
  2172. RF%itr(RF%ntr) = iSO4
  2173. write (gol,'(" * ",a10)') trim(trname); call goPr
  2174. case( 'tbc' )
  2175. ! defined as ntrace+3
  2176. RF%itr(RF%ntr) = iBC
  2177. write (gol,'(" * ",a10)') trim(trname); call goPr
  2178. case( 'tpom' )
  2179. ! defined as ntrace+4
  2180. RF%itr(RF%ntr) = iPOM
  2181. write (gol,'(" * ",a10)') trim(trname); call goPr
  2182. case( 'tss' )
  2183. ! defined as ntrace+5
  2184. RF%itr(RF%ntr) = iSS
  2185. write (gol,'(" * ",a10)') trim(trname); call goPr
  2186. case( 'tdu' )
  2187. ! defined as ntrace+6
  2188. RF%itr(RF%ntr) = iDU
  2189. write (gol,'(" * ",a10)') trim(trname); call goPr
  2190. #endif
  2191. case default
  2192. ! --------------------------------
  2193. ! `regular` constituents
  2194. ! --------------------------------
  2195. ! loop over all names:
  2196. RF%itr(RF%ntr) = -1
  2197. do itr = 1, ntrace
  2198. ! case indendent match ?
  2199. if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
  2200. write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4)') itr, trim(trname), trim(names(itr)), ra(itr); call goPr
  2201. RF%itr(RF%ntr) = itr
  2202. exit
  2203. end if
  2204. end do
  2205. end select
  2206. ! not found ?
  2207. if ( RF%itr(RF%ntr) < 0 ) then
  2208. write (gol,'("tracer name not supported:")'); call goPr
  2209. write (gol,'(" list all : ",a)') trim(tracer_names); call goPr
  2210. write (gol,'(" list element : ",i3)') RF%ntr; call goPr
  2211. write (gol,'(" pdump name : ",a)') trim(trname); call goPr
  2212. write (gol,'(" tm5 name : ",a)') trim(tmname); call goPr
  2213. write (gol,'(" tm5 tracers : ")'); call goPr
  2214. do itr = 1, ntrace
  2215. write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
  2216. end do
  2217. TRACEBACK; status=1; return
  2218. end if ! RF%itr
  2219. #ifdef with_m7
  2220. end if ! pmx
  2221. #endif
  2222. ! store pdump name:
  2223. RF%name_tr(RF%ntr) = tmname
  2224. end do
  2225. ! empty file ?
  2226. if ( RF%ntr < 1 ) then
  2227. write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
  2228. TRACEBACK; status=1; return
  2229. end if
  2230. ! o open file
  2231. ! write filename
  2232. #ifdef tropomi
  2233. ! define start/stop of output, and run date
  2234. date_f_end = NewDate( time6=idate_f ) + IncrDate(hour=24)
  2235. call Get( date_f_end, time6=idate_f_end )
  2236. if ( isRoot ) then
  2237. date_create = SystemDate()
  2238. call Get( date_create, time6=idate_create )
  2239. endif
  2240. call PAR_BROADCAST(idate_create, status)
  2241. IF_NOTOK_RETURN(status=1)
  2242. date_create = SystemDate()
  2243. call Get( date_create, time6=idate_create )
  2244. write (tropomi_date_start, '(i4.4,i2.2,i2.2,"T",i2.2,i2.2,i2.2)') idate_f
  2245. write (tropomi_date_stop, '(i4.4,i2.2,i2.2,"T",i2.2,i2.2,i2.2)') idate_f_end
  2246. write (tropomi_date_create,'(i4.4,i2.2,i2.2,"T",i2.2,i2.2,i2.2)') idate_create
  2247. ! write filename according to tropomi convention
  2248. write (fname,'(a,"/",a,"_",a,"_",a,".nc")') &
  2249. trim(fdir), trim(tropomi_dataset_name), tropomi_date_start, tropomi_date_stop
  2250. #else
  2251. write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
  2252. trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
  2253. #endif
  2254. ! open:
  2255. #ifdef MPI
  2256. ! overwrite existing files (clobber), provide MPI stuff:
  2257. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
  2258. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  2259. if (status/=0) then
  2260. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  2261. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  2262. TRACEBACK; status=1; return
  2263. end if
  2264. #else
  2265. ! overwrite existing files (clobber)
  2266. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
  2267. IF_NOTOK_RETURN(status=1)
  2268. #endif
  2269. ! o global attributes
  2270. #ifdef tropomi
  2271. ! H. Eskes: Extra attributes for TROPOMI
  2272. ! Conventions = "CF-1.6"
  2273. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'Conventions', 'CF-1.6' , status)
  2274. IF_NOTOK_MDF(fid=RF%ncid)
  2275. ! validity_start = "20132305T120000" (zoals in filenaam)
  2276. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'validity_start', tropomi_date_start , status)
  2277. IF_NOTOK_MDF(fid=RF%ncid)
  2278. ! validity_stop = "20132405T000000"
  2279. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'validity_stop', tropomi_date_stop , status)
  2280. IF_NOTOK_MDF(fid=RF%ncid)
  2281. ! creation_date = "20142909T124905"
  2282. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'creation_date', tropomi_date_create , status)
  2283. IF_NOTOK_MDF(fid=RF%ncid)
  2284. ! version = TM5 version string.
  2285. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'version', trim(tropomi_tm5_version) , status)
  2286. IF_NOTOK_MDF(fid=RF%ncid)
  2287. ! institution = "KNMI"
  2288. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution', trim(tropomi_institution) , status)
  2289. IF_NOTOK_MDF(fid=RF%ncid)
  2290. ! reference = TM5 reference (journal article or so)
  2291. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'reference', trim(tropomi_tm5_reference) , status)
  2292. IF_NOTOK_MDF(fid=RF%ncid)
  2293. ! contact = email address of volunteer.
  2294. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'contact', trim(tropomi_authoremail) , status)
  2295. IF_NOTOK_MDF(fid=RF%ncid)
  2296. ! dataset_name = "S5P_NRTI_AUX_CTMFCT" of "S5P_OFFL_AUX_CTMANA"
  2297. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_name', trim(tropomi_dataset_name) , status)
  2298. IF_NOTOK_MDF(fid=RF%ncid)
  2299. #endif
  2300. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'mixing ratios & concentrations' , status )
  2301. IF_NOTOK_MDF(fid=RF%ncid)
  2302. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status )
  2303. IF_NOTOK_MDF(fid=RF%ncid)
  2304. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status )
  2305. IF_NOTOK_MDF(fid=RF%ncid)
  2306. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'file_version_number', trim(outfileversnr) , status )
  2307. IF_NOTOK_MDF(fid=RF%ncid)
  2308. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'im' , imr , status )
  2309. IF_NOTOK_MDF(fid=RF%ncid)
  2310. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'jm' , jmr , status )
  2311. IF_NOTOK_MDF(fid=RF%ncid)
  2312. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'lm' , lmr , status )
  2313. IF_NOTOK_MDF(fid=RF%ncid)
  2314. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dx' , dx/xref(region) , status )
  2315. IF_NOTOK_MDF(fid=RF%ncid)
  2316. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dy' , dy/yref(region) , status )
  2317. IF_NOTOK_MDF(fid=RF%ncid)
  2318. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dz' , dz/zref(region) , status )
  2319. IF_NOTOK_MDF(fid=RF%ncid)
  2320. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'xbeg' , xbeg(region) , status )
  2321. IF_NOTOK_MDF(fid=RF%ncid)
  2322. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'xend' , xend(region) , status )
  2323. IF_NOTOK_MDF(fid=RF%ncid)
  2324. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'ybeg' , ybeg(region) , status )
  2325. IF_NOTOK_MDF(fid=RF%ncid)
  2326. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'yend' , yend(region) , status )
  2327. IF_NOTOK_MDF(fid=RF%ncid)
  2328. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'zbeg' , zbeg(region) , status )
  2329. IF_NOTOK_MDF(fid=RF%ncid)
  2330. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'zend' , zend(region) , status )
  2331. IF_NOTOK_MDF(fid=RF%ncid)
  2332. ! Meteo attribute
  2333. if (trim(meteo_class)=='ei') then
  2334. model_meteo='analysis (ERA-Interim)'
  2335. elseif (trim(meteo_class)=='od') then
  2336. model_meteo='forecast (IFS)'
  2337. elseif (trim(meteo_class)=='ifs62') then
  2338. model_meteo='EC-Earth (ifs 62L)'
  2339. elseif (trim(meteo_class)=='ifs91') then
  2340. model_meteo='EC-Earth (ifs 91L)'
  2341. else
  2342. write (gol,'("Meteo Model not known !")'); call goErr
  2343. TRACEBACK; status=1; return
  2344. endif
  2345. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'meteo_model', trim(model_meteo), status )
  2346. IF_NOTOK_MDF(fid=RF%ncid)
  2347. ! History attribute for audit trail: date, time of day, user name, program name
  2348. call date_and_time(values=isysdate, zone=zone)
  2349. write (sysdate, '(i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2," ",a)') &
  2350. isysdate(1), isysdate(2), isysdate(3), isysdate(5), isysdate(6), isysdate(7), zone
  2351. write(history,'("Created ",a," by ",a," with TM5.")') trim(sysdate),trim(dataset_author)
  2352. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'history', trim(history), status )
  2353. IF_NOTOK_MDF(fid=RF%ncid)
  2354. ! o define dimensions
  2355. call MDF_Def_Dim( RF%ncid, 'lon', imr, RF%dimid_lon , status)
  2356. IF_NOTOK_MDF(fid=RF%ncid)
  2357. call MDF_Def_Dim( RF%ncid, 'lat', jmr, RF%dimid_lat , status)
  2358. IF_NOTOK_MDF(fid=RF%ncid)
  2359. call MDF_Def_Dim( RF%ncid, 'lev', levi%nlev, RF%dimid_lev , status)
  2360. IF_NOTOK_MDF(fid=RF%ncid)
  2361. call MDF_Def_Dim( RF%ncid, 'levi', levi%nlev+1, RF%dimid_levi , status)
  2362. IF_NOTOK_MDF(fid=RF%ncid)
  2363. call MDF_Def_Dim( RF%ncid, 'time', rf%n_rec, RF%dimid_time , status)
  2364. IF_NOTOK_MDF(fid=RF%ncid)
  2365. call MDF_Def_Dim( RF%ncid, 'datelen', 6, RF%dimid_datelen , status)
  2366. IF_NOTOK_MDF(fid=RF%ncid)
  2367. ! o define variables
  2368. call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
  2369. IF_NOTOK_MDF(fid=RF%ncid)
  2370. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2371. IF_NOTOK_MDF(fid=RF%ncid)
  2372. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
  2373. IF_NOTOK_MDF(fid=RF%ncid)
  2374. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'longitude' , status)
  2375. IF_NOTOK_MDF(fid=RF%ncid)
  2376. call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_east' , status)
  2377. IF_NOTOK_MDF(fid=RF%ncid)
  2378. RF%varid_lon = varid
  2379. call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
  2380. IF_NOTOK_MDF(fid=RF%ncid)
  2381. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2382. IF_NOTOK_MDF(fid=RF%ncid)
  2383. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
  2384. IF_NOTOK_MDF(fid=RF%ncid)
  2385. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'latitude' , status)
  2386. IF_NOTOK_MDF(fid=RF%ncid)
  2387. call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_north' , status)
  2388. IF_NOTOK_MDF(fid=RF%ncid)
  2389. RF%varid_lat = varid
  2390. #ifdef tropomi
  2391. call MDF_Def_Var( RF%ncid, 'hyai', mdf_float, (/RF%dimid_levi/), varid , status)
  2392. IF_NOTOK_MDF(fid=RF%ncid)
  2393. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2394. IF_NOTOK_MDF(fid=RF%ncid)
  2395. call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
  2396. IF_NOTOK_MDF(fid=RF%ncid)
  2397. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid A coefficient at layer interfaces' , status)
  2398. IF_NOTOK_MDF(fid=RF%ncid)
  2399. RF%varid_hyai = varid
  2400. #else
  2401. call MDF_Def_Var( RF%ncid, 'a_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
  2402. IF_NOTOK_MDF(fid=RF%ncid)
  2403. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2404. IF_NOTOK_MDF(fid=RF%ncid)
  2405. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
  2406. IF_NOTOK_MDF(fid=RF%ncid)
  2407. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
  2408. IF_NOTOK_MDF(fid=RF%ncid)
  2409. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  2410. IF_NOTOK_MDF(fid=RF%ncid)
  2411. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  2412. IF_NOTOK_MDF(fid=RF%ncid)
  2413. RF%varid_a_bnds = varid
  2414. #endif
  2415. #ifdef tropomi
  2416. call MDF_Def_Var( RF%ncid, 'hybi', mdf_float, (/RF%dimid_levi/), varid , status)
  2417. IF_NOTOK_MDF(fid=RF%ncid)
  2418. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2419. IF_NOTOK_MDF(fid=RF%ncid)
  2420. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  2421. IF_NOTOK_MDF(fid=RF%ncid)
  2422. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid B coefficient at layer interfaces' , status)
  2423. IF_NOTOK_MDF(fid=RF%ncid)
  2424. RF%varid_hybi = varid
  2425. #else
  2426. call MDF_Def_Var( RF%ncid, 'b_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
  2427. IF_NOTOK_MDF(fid=RF%ncid)
  2428. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2429. IF_NOTOK_MDF(fid=RF%ncid)
  2430. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
  2431. IF_NOTOK_MDF(fid=RF%ncid)
  2432. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
  2433. IF_NOTOK_MDF(fid=RF%ncid)
  2434. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  2435. IF_NOTOK_MDF(fid=RF%ncid)
  2436. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  2437. IF_NOTOK_MDF(fid=RF%ncid)
  2438. RF%varid_b_bnds = varid
  2439. #endif
  2440. #ifdef tropomi
  2441. call MDF_Def_Var( RF%ncid, 'hyam', mdf_float, (/RF%dimid_lev/), varid , status)
  2442. IF_NOTOK_MDF(fid=RF%ncid)
  2443. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2444. IF_NOTOK_MDF(fid=RF%ncid)
  2445. call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
  2446. IF_NOTOK_MDF(fid=RF%ncid)
  2447. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid A coefficient at layer midpoints' , status)
  2448. IF_NOTOK_MDF(fid=RF%ncid)
  2449. RF%varid_hyam = varid
  2450. call MDF_Def_Var( RF%ncid, 'hybm', mdf_float, (/RF%dimid_lev/), varid , status)
  2451. IF_NOTOK_MDF(fid=RF%ncid)
  2452. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2453. IF_NOTOK_MDF(fid=RF%ncid)
  2454. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  2455. IF_NOTOK_MDF(fid=RF%ncid)
  2456. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid B coefficient at layer midpoints' , status)
  2457. IF_NOTOK_MDF(fid=RF%ncid)
  2458. RF%varid_hybm = varid
  2459. #endif
  2460. call MDF_Def_Var( RF%ncid, 'lev', mdf_float, (/RF%dimid_lev/), varid , status)
  2461. IF_NOTOK_MDF(fid=RF%ncid)
  2462. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2463. IF_NOTOK_MDF(fid=RF%ncid)
  2464. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate' , status)
  2465. IF_NOTOK_MDF(fid=RF%ncid)
  2466. #ifdef tropomi
  2467. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid level at layer midpoints' , status)
  2468. IF_NOTOK_MDF(fid=RF%ncid)
  2469. call MDF_Put_Att( RF%ncid, varid, 'units', 'level' , status)
  2470. IF_NOTOK_MDF(fid=RF%ncid)
  2471. call mdf_put_att( RF%ncid, varid, 'positive', 'down' , status)
  2472. IF_NOTOK_MDF(fid=RF%ncid)
  2473. call MDF_Put_Att( RF%ncid, varid, 'formula', 'hyam hybm (mlev=hyam+hybm*ps)' , status)
  2474. IF_NOTOK_MDF(fid=RF%ncid)
  2475. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'ap: hyam b: hybm ps: ps' , status)
  2476. IF_NOTOK_MDF(fid=RF%ncid)
  2477. #else
  2478. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'level' , status)
  2479. IF_NOTOK_MDF(fid=RF%ncid)
  2480. call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
  2481. IF_NOTOK_MDF(fid=RF%ncid)
  2482. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  2483. IF_NOTOK_MDF(fid=RF%ncid)
  2484. #endif
  2485. RF%varid_lev = varid
  2486. call MDF_Def_Var( RF%ncid, 'time', mdf_double, (/RF%dimid_time/), varid , status)
  2487. IF_NOTOK_MDF(fid=RF%ncid)
  2488. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2489. IF_NOTOK_MDF(fid=RF%ncid)
  2490. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
  2491. IF_NOTOK_MDF(fid=RF%ncid)
  2492. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'time' , status)
  2493. IF_NOTOK_MDF(fid=RF%ncid)
  2494. call MDF_Put_Att( RF%ncid, varid, 'units', 'days since 1950-01-01 00:00:00' , status)
  2495. IF_NOTOK_MDF(fid=RF%ncid)
  2496. call MDF_Put_Att( RF%ncid, varid, 'calender', 'gregorian' , status)
  2497. IF_NOTOK_MDF(fid=RF%ncid)
  2498. RF%varid_time = varid
  2499. allocate(RF%time(rf%n_rec))
  2500. call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
  2501. IF_NOTOK_MDF(fid=RF%ncid)
  2502. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2503. IF_NOTOK_MDF(fid=RF%ncid)
  2504. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
  2505. IF_NOTOK_MDF(fid=RF%ncid)
  2506. call MDF_Put_Att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
  2507. IF_NOTOK_MDF(fid=RF%ncid)
  2508. RF%varid_date = varid
  2509. allocate(RF%date(6,rf%n_rec))
  2510. call MDF_Def_Var( RF%ncid, 'ps', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
  2511. IF_NOTOK_MDF(fid=RF%ncid)
  2512. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2513. IF_NOTOK_MDF(fid=RF%ncid)
  2514. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'surface_air_pressure' , status)
  2515. IF_NOTOK_MDF(fid=RF%ncid)
  2516. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'surface pressure' , status)
  2517. IF_NOTOK_MDF(fid=RF%ncid)
  2518. call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
  2519. IF_NOTOK_MDF(fid=RF%ncid)
  2520. RF%varid_ps = varid
  2521. allocate( RF%sp(i1:i2, j1:j2, rf%n_rec) )
  2522. #ifndef tropomi
  2523. call MDF_Def_Var( RF%ncid, 't', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status )
  2524. IF_NOTOK_MDF(fid=RF%ncid)
  2525. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2526. IF_NOTOK_MDF(fid=RF%ncid)
  2527. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'air_temperature' , status)
  2528. IF_NOTOK_MDF(fid=RF%ncid)
  2529. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'temperature' , status)
  2530. IF_NOTOK_MDF(fid=RF%ncid)
  2531. call MDF_Put_Att( RF%ncid, varid, 'units', 'K' , status)
  2532. IF_NOTOK_MDF(fid=RF%ncid)
  2533. call MDF_put_att( RF%ncid, varid, 'comment', 'bottom-up; full levels' , status)
  2534. IF_NOTOK_MDF(fid=RF%ncid)
  2535. RF%varid_temp = varid
  2536. allocate( RF%data3d_t(i1:i2, j1:j2, levi%nlev, rf%n_rec) )
  2537. #endif
  2538. #ifdef tropomi
  2539. ! Extra temperature field output
  2540. ! with compression - crash
  2541. !call MDF_Def_Var( RF%ncid, 't', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status, compression=1, deflate_level=4)
  2542. call MDF_Def_Var( RF%ncid, 't', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
  2543. IF_NOTOK_MDF(fid=RF%ncid)
  2544. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2545. IF_NOTOK_MDF(fid=RF%ncid)
  2546. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'air_temperature' , status)
  2547. IF_NOTOK_MDF(fid=RF%ncid)
  2548. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'temperature' , status)
  2549. IF_NOTOK_MDF(fid=RF%ncid)
  2550. call MDF_Put_Att( RF%ncid, varid, 'units', 'K' , status)
  2551. IF_NOTOK_MDF(fid=RF%ncid)
  2552. call MDF_put_att( RF%ncid, varid, 'comment', 'bottom-up; full levels' , status)
  2553. IF_NOTOK_MDF(fid=RF%ncid)
  2554. RF%varid_temp = varid
  2555. allocate( RF%data3d_t(i1:i2, j1:j2, levi%nlev, rf%n_rec) )
  2556. ! Extra surface elevation output, retrieved from GPH (meteo.f90) and g0 (binas.f90) following WGS84?
  2557. call MDF_Def_Var( RF%ncid, 'surface_altitude', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat/), varid, status)
  2558. IF_NOTOK_MDF(fid=RF%ncid)
  2559. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2560. IF_NOTOK_MDF(fid=RF%ncid)
  2561. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'surface_altitude' , status)
  2562. IF_NOTOK_MDF(fid=RF%ncid)
  2563. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'surface altitude of TM5 grid' , status)
  2564. IF_NOTOK_MDF(fid=RF%ncid)
  2565. call MDF_Put_Att( RF%ncid, varid, 'units', 'm' , status)
  2566. IF_NOTOK_MDF(fid=RF%ncid)
  2567. call MDF_put_att( RF%ncid, varid, 'comment', 'ECMWF interpolated orography' , status)
  2568. IF_NOTOK_MDF(fid=RF%ncid)
  2569. RF%varid_hgt = varid
  2570. allocate( RF%data2d_hgt(i1:i2, j1:j2) )
  2571. ! Extra tropopause level output, retrieved from GPH and temperature (meteo.f90)
  2572. call MDF_Def_Var( RF%ncid, 'tropopause_layer_index', MDF_INT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status)
  2573. IF_NOTOK_MDF(fid=RF%ncid)
  2574. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  2575. IF_NOTOK_MDF(fid=RF%ncid)
  2576. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'tropopause_layer_index' , status)
  2577. IF_NOTOK_MDF(fid=RF%ncid)
  2578. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'index of the highest model layer in the troposphere' , status)
  2579. IF_NOTOK_MDF(fid=RF%ncid)
  2580. call MDF_Put_Att( RF%ncid, varid, 'units', '-' , status)
  2581. IF_NOTOK_MDF(fid=RF%ncid)
  2582. call MDF_put_att( RF%ncid, varid, 'comment', 'Based on WMO temperature gradient method' , status)
  2583. IF_NOTOK_MDF(fid=RF%ncid)
  2584. RF%varid_ltropo = varid
  2585. allocate( RF%data2d_ltropo(i1:i2, j1:j2, rf%n_rec) )
  2586. #endif
  2587. ! loop over tracer to be written:
  2588. do k = 1, RF%ntr
  2589. #ifdef with_m7
  2590. if( RF%lpmx(k) ) then
  2591. ! get diameter
  2592. write(csize,'(F5.1)') RF%sizepmx(k)
  2593. ! remove leading blanks
  2594. csize = adjustl(csize)
  2595. pospoint = index(csize,'.')
  2596. posend = len_trim(csize)
  2597. ! CF standard name for concentration/mixing ratio/column:
  2598. RF%varid_type(k) = 'conc'
  2599. varname_spec = 'pm'//csize(1:pospoint-1)//'p'//csize(pospoint+1:posend)
  2600. cf_spec_stnd = 'particulate_matter_'//trim(csize)
  2601. cf_spec_long = 'particulate matter diameter le '//trim(csize)//' micrometers'
  2602. cf_enti_stnd = 'concentration'
  2603. cf_enti_unit = 'kg m-3 '
  2604. cf_enti_long = 'mass per volume'
  2605. else
  2606. #endif
  2607. ! ----------------------------
  2608. ! setting defaults (gas phase)
  2609. ! ----------------------------
  2610. ! CF standard name for concentration/mixing ratio/column:
  2611. cf_enti_stnd = 'mole_fraction'
  2612. #ifdef tropomi
  2613. cf_enti_unit = '1'
  2614. #else
  2615. cf_enti_unit = 'mole mole-1'
  2616. #endif
  2617. cf_enti_long = 'volume mixing ratio'
  2618. cf_medium_stnd = 'in_air'
  2619. cf_medium_long = 'in humid air'
  2620. RF%varid_type(k) = 'mixr'
  2621. ! global tracer index
  2622. itr = RF%itr(k)
  2623. ! no comment yet
  2624. comment = ''
  2625. ! standard names from CF conventions:
  2626. select case ( strlowercase(RF%name_tr(k)) )
  2627. case ( 'co' )
  2628. varname_spec = 'co'
  2629. cf_spec_stnd = 'carbon_monoxide'
  2630. cf_spec_long = 'CO'
  2631. case ( 'o3' )
  2632. varname_spec = 'o3'
  2633. cf_spec_stnd = 'ozone'
  2634. cf_spec_long = 'O3'
  2635. case ( 'o3s' )
  2636. varname_spec = 'o3s'
  2637. cf_spec_stnd = 'ozone_from_stratosphere'
  2638. cf_spec_long = 'O3s'
  2639. case ( 'no' )
  2640. varname_spec = 'no'
  2641. cf_spec_stnd = 'nitrogen_monoxide'
  2642. cf_spec_long = 'NO'
  2643. case ( 'no2' )
  2644. varname_spec = 'no2'
  2645. cf_spec_stnd = 'nitrogen_dioxide'
  2646. cf_spec_long = 'NO2'
  2647. case ( 'noy' )
  2648. varname_spec = 'noy'
  2649. cf_spec_stnd = 'nitrogen_oxides'
  2650. cf_spec_long = 'NOy'
  2651. comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
  2652. 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
  2653. case ( 'ch2o', 'choh' )
  2654. varname_spec = 'ch2o'
  2655. cf_spec_stnd = 'formaldehyde'
  2656. cf_spec_long = 'CH2O'
  2657. case ( 'so2' )
  2658. varname_spec = 'so2'
  2659. cf_spec_stnd = 'sulfur_dioxide'
  2660. cf_spec_long = 'SO2'
  2661. case( 'h2so4' )
  2662. varname_spec = 'h2so4'
  2663. cf_spec_stnd = 'sulfuric_acid_g'
  2664. cf_spec_long = 'H2SO4 (g)'
  2665. !!$ case ( 'so4' )
  2666. !!$ varname_spec = 'so4'
  2667. !!$ cf_spec_stnd = 'sulfate_as_sulfate_dry_aerosol'
  2668. !!$ cf_spec_long = 'SO4'
  2669. case ( 'ch4' )
  2670. varname_spec = 'ch4'
  2671. cf_spec_stnd = 'methane'
  2672. cf_spec_long = 'CH4'
  2673. case ( 'oh' )
  2674. varname_spec = 'oh'
  2675. cf_spec_stnd = 'hydroxyl_radical'
  2676. cf_spec_long = 'OH'
  2677. case ( 'h2o2' )
  2678. varname_spec = 'h2o2'
  2679. cf_spec_stnd = 'hydrogen_peroxide'
  2680. cf_spec_long = 'H2O2'
  2681. case ( 'hno3' )
  2682. varname_spec = 'hno3'
  2683. cf_spec_stnd = 'nitric_acid'
  2684. cf_spec_long = 'HNO3'
  2685. case ( 'hno4' )
  2686. varname_spec = 'hno4'
  2687. cf_spec_stnd = 'peroxonitric_acid'
  2688. cf_spec_long = 'HNO4'
  2689. case ( 'n2o5' )
  2690. varname_spec = 'n2o5'
  2691. cf_spec_stnd = 'nitrogen_pentoxide'
  2692. cf_spec_long = 'N2O5'
  2693. case ( 'par' )
  2694. varname_spec = 'par'
  2695. cf_spec_stnd = 'paraffinic_carbon_atoms'
  2696. cf_spec_long = 'PAR'
  2697. case ( 'eth' )
  2698. varname_spec = 'eth'
  2699. cf_spec_stnd = 'ethylene'
  2700. cf_spec_long = 'ETH'
  2701. case ( 'ole' )
  2702. varname_spec = 'ole'
  2703. cf_spec_stnd = 'olefinic_carbon_bonds'
  2704. cf_spec_long = 'OLE'
  2705. case ( 'ald2' )
  2706. varname_spec = 'ald2'
  2707. cf_spec_stnd = 'acetaldehyde_and_higher_aldehydes'
  2708. cf_spec_long = 'ALD2'
  2709. case ( 'mgly' )
  2710. varname_spec = 'mgly'
  2711. cf_spec_stnd = 'methylglyoxal'
  2712. cf_spec_long = 'MGLY'
  2713. case ( 'isop' )
  2714. varname_spec = 'isop'
  2715. cf_spec_stnd = 'isoprene'
  2716. cf_spec_long = 'ISOP'
  2717. case ( 'nh3' )
  2718. varname_spec = 'nh3'
  2719. cf_spec_stnd = 'ammonia'
  2720. cf_spec_long = 'NH3'
  2721. case ( 'ORGNTR','orgntr' )
  2722. varname_spec = 'orgntr'
  2723. cf_spec_stnd = 'organic_nitrate'
  2724. cf_spec_long = 'ORGNTR'
  2725. case ( 'pan' )
  2726. varname_spec = 'pan'
  2727. cf_spec_stnd = 'peroxyacetyl_nitrate'
  2728. cf_spec_long = 'PAN'
  2729. case ( 'terp' )
  2730. varname_spec = 'terp'
  2731. cf_spec_stnd = 'terpene'
  2732. cf_spec_long = 'TERP'
  2733. case ( 'elvoc' )
  2734. varname_spec = 'elvoc'
  2735. cf_spec_stnd = 'extremely low volatile OC'
  2736. cf_spec_long = 'ELVOC'
  2737. case ( 'svoc' )
  2738. varname_spec = 'svoc'
  2739. cf_spec_stnd = 'semi volatile OC'
  2740. cf_spec_long = 'SVOC'
  2741. case ( 'rn', 'radon', 'rn222' )
  2742. varname_spec = 'rn'
  2743. cf_spec_stnd = 'radon'
  2744. cf_spec_long = 'Rn'
  2745. case ( 'pb', 'lead', 'pb210' )
  2746. varname_spec = 'pb'
  2747. cf_spec_stnd = 'lead'
  2748. cf_spec_long = 'Pb'
  2749. #ifdef with_m7
  2750. ! Sulphate
  2751. case( 'tso4' )
  2752. RF%varid_type(k) = 'conc'
  2753. varname_spec = 'so4'
  2754. cf_spec_stnd = 'total_sulphate_aerosol'
  2755. cf_spec_long = 'SO4'
  2756. cf_enti_stnd = 'concentration'
  2757. cf_enti_unit = 'kg m-3 '
  2758. cf_enti_long = 'mass per volume'
  2759. ! Black Carbon
  2760. case( 'tbc' )
  2761. RF%varid_type(k) = 'conc'
  2762. varname_spec = 'bc'
  2763. cf_spec_stnd = 'total_black_carbon_aerosol'
  2764. cf_spec_long = 'BC'
  2765. cf_enti_stnd = 'concentration'
  2766. cf_enti_unit = 'kg m-3 '
  2767. cf_enti_long = 'mass per volume'
  2768. ! Particulate Organic Matter
  2769. case( 'tpom' )
  2770. RF%varid_type(k) = 'conc'
  2771. varname_spec = 'pom'
  2772. cf_spec_stnd = 'total_particulate_organic_matter_aerosol'
  2773. cf_spec_long = 'POM'
  2774. cf_enti_stnd = 'concentration'
  2775. cf_enti_unit = 'kg m-3 '
  2776. cf_enti_long = 'mass per volume'
  2777. ! Sea Salt
  2778. case( 'tss' )
  2779. RF%varid_type(k) = 'conc'
  2780. varname_spec = 'ss'
  2781. cf_spec_stnd = 'total_sea_salt_aerosol'
  2782. cf_spec_long = 'SS'
  2783. cf_enti_stnd = 'concentration'
  2784. cf_enti_unit = 'kg m-3 '
  2785. cf_enti_long = 'mass per volume'
  2786. ! Dust
  2787. case( 'tdu' )
  2788. RF%varid_type(k) = 'conc'
  2789. varname_spec = 'du'
  2790. cf_spec_stnd = 'total_dust_aerosol'
  2791. cf_spec_long = 'SS'
  2792. cf_enti_stnd = 'concentration'
  2793. cf_enti_unit = 'kg m-3 '
  2794. cf_enti_long = 'mass per volume'
  2795. ! Nucleation Soluble (nus): number, SO4
  2796. case ( 'nus_n' )
  2797. RF%varid_type(k) = 'numb'
  2798. varname_spec = 'nus_n'
  2799. cf_spec_stnd = 'number_wet_nucleation'
  2800. cf_spec_long = 'Number_nus'
  2801. cf_enti_stnd = 'number'
  2802. cf_enti_unit = '1.'
  2803. cf_enti_long = ''
  2804. case ( 'so4nus' )
  2805. RF%varid_type(k) = 'conc'
  2806. varname_spec = 'so4nus'
  2807. cf_spec_stnd = 'sulphate_wet_nucleation'
  2808. cf_spec_long = 'SO4_nus'
  2809. cf_enti_stnd = 'concentration'
  2810. cf_enti_unit = 'kg m-3 '
  2811. cf_enti_long = 'mass per volume'
  2812. case ( 'soanus' )
  2813. RF%varid_type(k) = 'conc'
  2814. varname_spec = 'soanus'
  2815. cf_spec_stnd = 'SOA_wet_nucleation'
  2816. cf_spec_long = 'SOA_nus'
  2817. cf_enti_stnd = 'concentration'
  2818. cf_enti_unit = 'kg m-3 '
  2819. cf_enti_long = 'mass per volume'
  2820. ! Aitken Soluble (ais): number, SO4, BC, POM
  2821. case ( 'ais_n' )
  2822. RF%varid_type(k) = 'numb'
  2823. varname_spec = 'ais_n'
  2824. cf_spec_stnd = 'number_wet_aitken'
  2825. cf_spec_long = 'Number_ais'
  2826. cf_enti_stnd = 'number'
  2827. cf_enti_unit = '1.'
  2828. cf_enti_long = ''
  2829. case ( 'so4ais' )
  2830. RF%varid_type(k) = 'conc'
  2831. varname_spec = 'so4ais'
  2832. cf_spec_stnd = 'sulphate_wet_aitken'
  2833. cf_spec_long = 'SO4_ais'
  2834. cf_enti_stnd = 'concentration'
  2835. cf_enti_unit = 'kg m-3 '
  2836. cf_enti_long = 'mass per volume'
  2837. case ( 'bcais' )
  2838. RF%varid_type(k) = 'conc'
  2839. varname_spec = 'bcais'
  2840. cf_spec_stnd = 'black_carbon_wet_aitken'
  2841. cf_spec_long = 'BC_ais'
  2842. cf_enti_stnd = 'concentration'
  2843. cf_enti_unit = 'kg m-3 '
  2844. cf_enti_long = 'mass per volume'
  2845. case ( 'pomais' )
  2846. RF%varid_type(k) = 'conc'
  2847. varname_spec = 'pomais'
  2848. cf_spec_stnd = 'particulate_organic_matter_wet_aitken'
  2849. cf_spec_long = 'POM_ais'
  2850. cf_enti_stnd = 'concentration'
  2851. cf_enti_unit = 'kg m-3 '
  2852. cf_enti_long = 'mass per volume'
  2853. case ( 'soaais' )
  2854. RF%varid_type(k) = 'conc'
  2855. varname_spec = 'soaais'
  2856. cf_spec_stnd = 'SOA_dry_Aitken'
  2857. cf_spec_long = 'SOA_ais'
  2858. cf_enti_stnd = 'concentration'
  2859. cf_enti_unit = 'kg m-3 '
  2860. cf_enti_long = 'mass per volume'
  2861. ! Accumulation Soluble (acs): number, SO4, BC, POM, SS, DU
  2862. case ( 'acs_n' )
  2863. RF%varid_type(k) = 'numb'
  2864. varname_spec = 'acs_n'
  2865. cf_spec_stnd = 'number_wet_accumulation'
  2866. cf_spec_long = 'Number_acs'
  2867. cf_enti_stnd = 'number'
  2868. cf_enti_unit = '1.'
  2869. cf_enti_long = ''
  2870. case ( 'so4acs' )
  2871. RF%varid_type(k) = 'conc'
  2872. varname_spec = 'so4acs'
  2873. cf_spec_stnd = 'sulphate_wet_accumulation'
  2874. cf_spec_long = 'SO4_acs'
  2875. cf_enti_stnd = 'concentration'
  2876. cf_enti_unit = 'kg m-3 '
  2877. cf_enti_long = 'mass per volume'
  2878. case ( 'bcacs' )
  2879. RF%varid_type(k) = 'conc'
  2880. varname_spec = 'bcacs'
  2881. cf_spec_stnd = 'black_carbon_wet_accumulation'
  2882. cf_spec_long = 'BC_acs'
  2883. cf_enti_stnd = 'concentration'
  2884. cf_enti_unit = 'kg m-3 '
  2885. cf_enti_long = 'mass per volume'
  2886. case ( 'pomacs' )
  2887. RF%varid_type(k) = 'conc'
  2888. varname_spec = 'pomacs'
  2889. cf_spec_stnd = 'particulate_organic_matter_wet_accumulation'
  2890. cf_spec_long = 'POM_acs'
  2891. cf_enti_stnd = 'concentration'
  2892. cf_enti_unit = 'kg m-3 '
  2893. cf_enti_long = 'mass per volume'
  2894. case ( 'ssacs' )
  2895. RF%varid_type(k) = 'conc'
  2896. varname_spec = 'ssacs'
  2897. cf_spec_stnd = 'seasalt_wet_accumulation'
  2898. cf_spec_long = 'SS_acs'
  2899. cf_enti_stnd = 'concentration'
  2900. cf_enti_unit = 'kg m-3 '
  2901. cf_enti_long = 'mass per volume'
  2902. case ( 'duacs' )
  2903. RF%varid_type(k) = 'conc'
  2904. varname_spec = 'duacs'
  2905. cf_spec_stnd = 'dust_wet_accumulation'
  2906. cf_spec_long = 'DU_acs'
  2907. cf_enti_stnd = 'concentration'
  2908. cf_enti_unit = 'kg m-3 '
  2909. cf_enti_long = 'mass per volume'
  2910. case ( 'soaacs' )
  2911. RF%varid_type(k) = 'conc'
  2912. varname_spec = 'soaacs'
  2913. cf_spec_stnd = 'SOA_dry_Accumulation'
  2914. cf_spec_long = 'SOA_acs'
  2915. cf_enti_stnd = 'concentration'
  2916. cf_enti_unit = 'kg m-3 '
  2917. cf_enti_long = 'mass per volume'
  2918. ! Coarse Soluble (cos): number, SO4, BC, POM, SS, DU
  2919. case ( 'cos_n' )
  2920. RF%varid_type(k) = 'numb'
  2921. varname_spec = 'cos_n'
  2922. cf_spec_stnd = 'number_wet_coarse'
  2923. cf_spec_long = 'Number_cos'
  2924. cf_enti_stnd = 'number'
  2925. cf_enti_unit = '1.'
  2926. cf_enti_long = ''
  2927. case ( 'so4cos' )
  2928. RF%varid_type(k) = 'conc'
  2929. varname_spec = 'so4cos'
  2930. cf_spec_stnd = 'sulphate_wet_coarse'
  2931. cf_spec_long = 'SO4_cos'
  2932. cf_enti_stnd = 'concentration'
  2933. cf_enti_unit = 'kg m-3 '
  2934. cf_enti_long = 'mass per volume'
  2935. case ( 'bccos' )
  2936. RF%varid_type(k) = 'conc'
  2937. varname_spec = 'bccos'
  2938. cf_spec_stnd = 'black_carbon_wet_coarse'
  2939. cf_spec_long = 'BC_cos'
  2940. cf_enti_stnd = 'concentration'
  2941. cf_enti_unit = 'kg m-3 '
  2942. cf_enti_long = 'mass per volume'
  2943. case ( 'pomcos' )
  2944. RF%varid_type(k) = 'conc'
  2945. varname_spec = 'pomcos'
  2946. cf_spec_stnd = 'particulate_organic_matter_wet_coarse'
  2947. cf_spec_long = 'POM_cos'
  2948. cf_enti_stnd = 'concentration'
  2949. cf_enti_unit = 'kg m-3 '
  2950. cf_enti_long = 'mass per volume'
  2951. case ( 'sscos' )
  2952. RF%varid_type(k) = 'conc'
  2953. varname_spec = 'sscos'
  2954. cf_spec_stnd = 'seasalt_wet_coarse'
  2955. cf_spec_long = 'SS_cos'
  2956. cf_enti_stnd = 'concentration'
  2957. cf_enti_unit = 'kg m-3 '
  2958. cf_enti_long = 'mass per volume'
  2959. case ( 'ducos' )
  2960. RF%varid_type(k) = 'conc'
  2961. varname_spec = 'ducos'
  2962. cf_spec_stnd = 'dust_wet_coarse'
  2963. cf_spec_long = 'DU_cos'
  2964. cf_enti_stnd = 'concentration'
  2965. cf_enti_unit = 'kg m-3 '
  2966. cf_enti_long = 'mass per volume'
  2967. case ( 'soacos' )
  2968. RF%varid_type(k) = 'conc'
  2969. varname_spec = 'soacos'
  2970. cf_spec_stnd = 'SOA_dry_coarse'
  2971. cf_spec_long = 'SOA_cos'
  2972. cf_enti_stnd = 'concentration'
  2973. cf_enti_unit = 'kg m-3 '
  2974. cf_enti_long = 'mass per volume'
  2975. ! Aitken Insoluble (aii): number, BC, POM
  2976. case ( 'aii_n' )
  2977. RF%varid_type(k) = 'numb'
  2978. varname_spec = 'aii_n'
  2979. cf_spec_stnd = 'number_dry_aitken'
  2980. cf_spec_long = 'Number_aii'
  2981. cf_enti_stnd = 'number'
  2982. cf_enti_unit = '1.'
  2983. cf_enti_long = ''
  2984. case ( 'bcaii' )
  2985. RF%varid_type(k) = 'conc'
  2986. varname_spec = 'bcaii'
  2987. cf_spec_stnd = 'black_carbon_dry_aitken'
  2988. cf_spec_long = 'BC_aii'
  2989. cf_enti_stnd = 'concentration'
  2990. cf_enti_unit = 'kg m-3 '
  2991. cf_enti_long = 'mass per volume'
  2992. case ( 'pomaii' )
  2993. RF%varid_type(k) = 'conc'
  2994. varname_spec = 'pomaii'
  2995. cf_spec_stnd = 'particulate_organic_matter_dry_aitken'
  2996. cf_spec_long = 'POM_aii'
  2997. cf_enti_stnd = 'concentration'
  2998. cf_enti_unit = 'kg m-3 '
  2999. cf_enti_long = 'mass per volume'
  3000. case ( 'soaaii' )
  3001. RF%varid_type(k) = 'conc'
  3002. varname_spec = 'soaaii'
  3003. cf_spec_stnd = 'SOA_dry_Aitken'
  3004. cf_spec_long = 'SOA_aii'
  3005. cf_enti_stnd = 'concentration'
  3006. cf_enti_unit = 'kg m-3 '
  3007. cf_enti_long = 'mass per volume'
  3008. ! Accumulation Insoluble (aci): number, DU
  3009. case ( 'aci_n' )
  3010. RF%varid_type(k) = 'numb'
  3011. varname_spec = 'aci_n'
  3012. cf_spec_stnd = 'number_dry_accumulation'
  3013. cf_spec_long = 'Number_aci'
  3014. cf_enti_stnd = 'number'
  3015. cf_enti_unit = '1.'
  3016. cf_enti_long = ''
  3017. case ( 'duaci' )
  3018. RF%varid_type(k) = 'conc'
  3019. varname_spec = 'duaci'
  3020. cf_spec_stnd = 'dust_dry_accumulation'
  3021. cf_spec_long = 'DU_aci'
  3022. cf_enti_stnd = 'concentration'
  3023. cf_enti_unit = 'kg m-3 '
  3024. cf_enti_long = 'mass per volume'
  3025. ! Coarse Insoluble (coi): number, DU
  3026. case ( 'coi_n' )
  3027. RF%varid_type(k) = 'numb'
  3028. varname_spec = 'coi_n'
  3029. cf_spec_stnd = 'number_dry_coarse'
  3030. cf_spec_long = 'Number_coi'
  3031. cf_enti_stnd = 'number'
  3032. cf_enti_unit = '1.'
  3033. cf_enti_long = ''
  3034. case ( 'ducoi' )
  3035. RF%varid_type(k) = 'conc'
  3036. varname_spec = 'ducoi'
  3037. cf_spec_stnd = 'dust_dry_coarse'
  3038. cf_spec_long = 'DU_coi'
  3039. cf_enti_stnd = 'concentration'
  3040. cf_enti_unit = 'kg m-3 '
  3041. cf_enti_long = 'mass per volume'
  3042. #endif
  3043. case ( 'nh4' )
  3044. RF%varid_type(k) = 'conc'
  3045. varname_spec = 'nh4'
  3046. cf_spec_stnd = 'ammonium_as_ammonium_dry_aerosol'
  3047. cf_spec_long = 'NH4'
  3048. cf_enti_stnd = 'concentration'
  3049. cf_enti_unit = 'kg m-3 '
  3050. cf_enti_long = 'mass per volume'
  3051. case ( 'no3_a' )
  3052. RF%varid_type(k) = 'conc'
  3053. varname_spec = 'no3'
  3054. cf_spec_stnd = 'nitrate_as_nitrate_dry_aerosol'
  3055. cf_spec_long = 'NO3'
  3056. cf_enti_stnd = 'concentration'
  3057. cf_enti_unit = 'kg m-3 '
  3058. cf_enti_long = 'mass per volume'
  3059. !!$ case ( 'bc' )
  3060. !!$ varname_spec = 'bc'
  3061. !!$ cf_spec_stnd = 'black_carbon_dry_aerosol'
  3062. !!$ cf_spec_long = 'BC'
  3063. !!$ case ( 'BCS', 'bcs' )
  3064. !!$ varname_spec = 'bcs'
  3065. !!$ cf_spec_stnd = 'hydrophilic_black_carbon_dry_aerosol'
  3066. !!$ cf_spec_long = 'BC(aq)'
  3067. !!$ case ( 'POM', 'pom' )
  3068. !!$ varname_spec = 'om'
  3069. !!$ cf_spec_stnd = 'organic_carbon_as_particulate_organic_matter_dry_aerosol'
  3070. !!$ cf_spec_long = 'OM'
  3071. !!$ case ( 'SS1_N', 'ss1_n' )
  3072. !!$ varname_spec = 'ss1_n'
  3073. !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode1_number'
  3074. !!$ cf_spec_long = 'SS1_n'
  3075. !!$ case ( 'SS1_M', 'ss1_m' )
  3076. !!$ varname_spec = 'ss1_m'
  3077. !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode1_mass'
  3078. !!$ cf_spec_long = 'SS1_m'
  3079. !!$ case ( 'SS2_N', 'ss2_n' )
  3080. !!$ varname_spec = 'ss2_n'
  3081. !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode2_number'
  3082. !!$ cf_spec_long = 'SS2_n'
  3083. !!$ case ( 'SS2_M', 'ss2_m' )
  3084. !!$ varname_spec = 'ss2_m'
  3085. !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode2_mass'
  3086. !!$ cf_spec_long = 'SS2_m'
  3087. !!$ case ( 'SS3_N', 'ss3_n' )
  3088. !!$ varname_spec = 'ss3_n'
  3089. !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode3_number'
  3090. !!$ cf_spec_long = 'SS3_n'
  3091. !!$ case ( 'SS3_M', 'ss3_m' )
  3092. !!$ varname_spec = 'ss3_m'
  3093. !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode3_mass'
  3094. !!$ cf_spec_long = 'SS3_m'
  3095. !!$ case ( 'DUST2_N', 'dust2_n' )
  3096. !!$ varname_spec = 'dust2_n'
  3097. !!$ cf_spec_stnd = 'dust_dry_aerosol_mode2_number'
  3098. !!$ cf_spec_long = 'DUST2_n'
  3099. !!$ case ( 'DUST2_M', 'dust2_m' )
  3100. !!$ varname_spec = 'dust2_m'
  3101. !!$ cf_spec_stnd = 'dust_dry_aerosol_mode2_madust'
  3102. !!$ cf_spec_long = 'DUST2_m'
  3103. !!$ case ( 'DUST3_N', 'dust3_n' )
  3104. !!$ varname_spec = 'dust3_n'
  3105. !!$ cf_spec_stnd = 'dust_dry_aerosol_mode3_number'
  3106. !!$ cf_spec_long = 'DUST3_n'
  3107. !!$ case ( 'DUST3_M', 'dust3_m' )
  3108. !!$ varname_spec = 'dust3_m'
  3109. !!$ cf_spec_stnd = 'dust_dry_aerosol_mode3_madust'
  3110. !!$ cf_spec_long = 'DUST3_m'
  3111. case default
  3112. write (gol,'("do not know how to match tracer with CF standard names : ",a)') RF%name_tr(k); call goErr
  3113. TRACEBACK; status=1; return
  3114. end select
  3115. #ifdef with_m7
  3116. end if ! RF%lpmx(k)
  3117. #endif
  3118. ! define variable:
  3119. call MDF_Def_Var( RF%ncid, trim(varname_spec), MDF_FLOAT, &
  3120. (/RF%dimid_lon,RF%dimid_lat,RF%dimid_lev,RF%dimid_time/), varid, status )
  3121. IF_NOTOK_MDF(fid=RF%ncid)
  3122. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3123. IF_NOTOK_MDF(fid=RF%ncid)
  3124. ! total names:
  3125. cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)//'_'//trim(cf_medium_stnd)
  3126. cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)//' '//trim(cf_medium_long)
  3127. cf_name_unit = trim(cf_enti_unit)
  3128. ! write attributes:
  3129. call MDF_Put_Att( RF%ncid, varid, 'standard_name', trim(cf_name_stnd) , status)
  3130. IF_NOTOK_MDF(fid=RF%ncid)
  3131. call MDF_Put_Att( RF%ncid, varid, 'long_name', trim(cf_name_long) , status)
  3132. IF_NOTOK_MDF(fid=RF%ncid)
  3133. call MDF_Put_Att( RF%ncid, varid, 'units', trim(cf_name_unit) , status)
  3134. IF_NOTOK_MDF(fid=RF%ncid)
  3135. ! moleweights; ra from chem_param is in g/mol .
  3136. if ( itr <= ntrace .and. itr > 0 ) then
  3137. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
  3138. IF_NOTOK_MDF(fid=RF%ncid)
  3139. else
  3140. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
  3141. IF_NOTOK_MDF(fid=RF%ncid)
  3142. end if
  3143. call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
  3144. IF_NOTOK_MDF(fid=RF%ncid)
  3145. call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
  3146. IF_NOTOK_MDF(fid=RF%ncid)
  3147. if ( len_trim(comment) > 0 ) then
  3148. call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment), status)
  3149. IF_NOTOK_MDF(fid=RF%ncid)
  3150. end if
  3151. ! store varid
  3152. RF%varid_tr(k) = varid
  3153. end do
  3154. ! storage
  3155. allocate(rf%data3d(i1:i2,j1:j2,lmr,rf%n_rec,rf%ntr))
  3156. ! o end defintion mode
  3157. call MDF_EndDef( RF%ncid , status)
  3158. IF_NOTOK_MDF(fid=RF%ncid)
  3159. ! o
  3160. ! no records written yet
  3161. RF%trec = 0
  3162. call goLabel()
  3163. status = 0
  3164. END SUBROUTINE RF_VMR_Init
  3165. !EOC
  3166. !--------------------------------------------------------------------------
  3167. ! TM5 !
  3168. !--------------------------------------------------------------------------
  3169. !BOP
  3170. !
  3171. ! !IROUTINE: RF_VMR_Write
  3172. !
  3173. ! !DESCRIPTION:
  3174. !\\
  3175. !\\
  3176. ! !INTERFACE:
  3177. !
  3178. SUBROUTINE RF_VMR_Write( RF, region, idate_f, status )
  3179. !
  3180. ! !USES:
  3181. !
  3182. use Binas, only : xmair
  3183. use GO, only : TDate, NewDate, rTotal, operator(-)
  3184. use binas, only : Rgas
  3185. use chem_param, only : ntrace, ntracet, fscale, ra
  3186. use tracer_data, only : mass_dat, chem_dat
  3187. use Grid, only : FPressure
  3188. use MeteoData, only : global_lli, levi, m_dat, sp_dat, temper_dat
  3189. #ifdef tropomi
  3190. use MeteoData, only : gph_dat
  3191. use toolbox, only : ltropo, lvlpress
  3192. #endif
  3193. #ifdef with_m7
  3194. use calc_pm, only : PMx_Integrate_3d
  3195. #endif
  3196. !
  3197. ! !INPUT/OUTPUT PARAMETERS:
  3198. !
  3199. type(TPdumpFile_VMR), intent(inout) :: RF
  3200. !
  3201. ! !INPUT PARAMETERS:
  3202. !
  3203. integer, intent(in) :: region
  3204. integer, intent(in) :: idate_f(6)
  3205. !
  3206. ! !OUTPUT PARAMETERS:
  3207. !
  3208. integer, intent(out) :: status
  3209. !
  3210. ! !REVISION HISTORY:
  3211. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  3212. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  3213. ! 2 Oct 2012 - Ph. Le Sager - adapted for lat-lon mpi decomp
  3214. ! - no more sub-regions available
  3215. !
  3216. ! !REMARKS:
  3217. ! (1)
  3218. !
  3219. !EOP
  3220. !------------------------------------------------------------------------
  3221. !BOC
  3222. character(len=*), parameter :: rname = mname//'/RF_VMR_Write'
  3223. ! --- local ------------------------------------
  3224. integer :: imr, jmr, lmr, i1, i2, j1, j2, i, j
  3225. real, allocatable :: lev(:)
  3226. integer :: l
  3227. type(TDate) :: t, t0
  3228. real :: time
  3229. integer :: k, itr, dsec
  3230. integer :: k_comp, itr_comp
  3231. integer :: ims, ime, jms, jme, lms, lme
  3232. integer :: gimr, gjmr, glmr
  3233. real, allocatable :: compo_k(:,:,:)
  3234. real, allocatable :: field_k(:,:,:)
  3235. real, allocatable :: pres3d(:,:,:), pmx(:,:,:)
  3236. integer :: numtrac
  3237. integer :: listtrac(10)
  3238. ! --- begin -------------------------------------
  3239. ! for multiple of timestep only ...
  3240. dsec = idate_f(4)*3600 + idate_f(5)*60 + idate_f(6)
  3241. if ( modulo(dsec,RF%dsec) /= 0 ) then
  3242. status=0; return
  3243. end if
  3244. call goLabel(rname)
  3245. ! grid sizes
  3246. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  3247. imr=i2-i1+1
  3248. jmr=j2-j1+1
  3249. lmr = levi%nlev
  3250. gimr = global_lli(region)%nlon
  3251. gjmr = global_lli(region)%nlat
  3252. ! yet to change ??
  3253. lms = 1
  3254. lme = levi%nlev
  3255. lmr = levi%nlev
  3256. glmr = levi%nlev
  3257. #ifdef with_m7
  3258. ! get helping pressure field in 3d
  3259. allocate( pres3d(i1:i2,j1:j2,lmr) )
  3260. ! fill mid level pressure
  3261. call FPressure( levi, sp_dat(region)%data(i1:i2,j1:j2,1), pres3d, status )
  3262. IF_NOTOK_RETURN(status=1)
  3263. #endif
  3264. ! next time record:
  3265. RF%trec = RF%trec + 1
  3266. if(isRoot.and.okdebug)then
  3267. write(gol,*) "RF_VMR_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
  3268. end if
  3269. ! time since 1950-1-1 00:00
  3270. t0 = NewDate( time6=time_reftime6 )
  3271. t = NewDate( time6=idate_f )
  3272. time = rTotal( t - t0, 'day' )
  3273. ! only once ...
  3274. if ( RF%trec == 1 ) then
  3275. ! write longitudes:
  3276. call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
  3277. IF_NOTOK_MDF(fid=RF%ncid)
  3278. ! write latitudes:
  3279. call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
  3280. IF_NOTOK_MDF(fid=RF%ncid)
  3281. ! write level indices:
  3282. allocate( lev(lmr) )
  3283. do l = lms, lme
  3284. lev(l) = real(l)
  3285. end do
  3286. call MDF_Put_Var( RF%ncid, RF%varid_lev, lev , status)
  3287. IF_NOTOK_MDF(fid=RF%ncid)
  3288. deallocate(lev)
  3289. #ifdef tropomi
  3290. ! As and Bs interfaces
  3291. call MDF_Put_Var( RF%ncid, RF%varid_hyai, levi%a(0:levi%nlev) , status)
  3292. IF_NOTOK_MDF(fid=RF%ncid)
  3293. call MDF_Put_Var( RF%ncid, RF%varid_hybi, levi%b(0:levi%nlev) , status)
  3294. IF_NOTOK_MDF(fid=RF%ncid)
  3295. ! As and Bs mid-level (full level)
  3296. call MDF_Put_Var( RF%ncid, RF%varid_hyam, levi%fa(1:levi%nlev) , status)
  3297. IF_NOTOK_MDF(fid=RF%ncid)
  3298. call MDF_Put_Var( RF%ncid, RF%varid_hybm, levi%fb(1:levi%nlev) , status)
  3299. IF_NOTOK_MDF(fid=RF%ncid)
  3300. #else
  3301. ! As and Bs
  3302. call MDF_Put_Var( RF%ncid, RF%varid_a_bnds, levi%a(0:levi%nlev) , status)
  3303. IF_NOTOK_MDF(fid=RF%ncid)
  3304. call MDF_Put_Var( RF%ncid, RF%varid_b_bnds, levi%b(0:levi%nlev) , status)
  3305. IF_NOTOK_MDF(fid=RF%ncid)
  3306. #endif
  3307. end if ! first record
  3308. RF%time(RF%trec) = time
  3309. RF%date(:,RF%trec) = real(idate_f)
  3310. RF%sp(:,:,RF%trec) = sp_dat(region)%data(i1:i2,j1:j2,1)
  3311. #ifdef tropomi
  3312. ! copy of temperature field
  3313. RF%data3d_t(:,:,:,RF%trec) = temper_dat(region)%data(i1:i2,j1:j2,1:lmr)
  3314. ! orography: copy of lowest interface gph field. gph in the model is in "m", at interfaces, and gph(1)=oro
  3315. ! only once ...
  3316. if ( RF%trec == 1 ) then
  3317. RF%data2d_hgt(:,:) = gph_dat(region)%data(i1:i2,j1:j2,1)
  3318. end if
  3319. ! compute highest tropopause layer index
  3320. do i = i1, i2
  3321. do j = j1, j2
  3322. RF%data2d_ltropo(i,j,RF%trec) = ltropo(region,temper_dat(region)%data(i,j,1:lmr),gph_dat(region)%data(i,j,1:lmr+1),lmr)
  3323. end do
  3324. end do
  3325. #endif
  3326. ! loop over all tracers to be written:
  3327. do k = 1, RF%ntr
  3328. ! global tracer index:
  3329. itr = RF%itr(k)
  3330. #ifdef with_m7
  3331. ! ---------------------
  3332. ! particulate matter
  3333. ! ---------------------
  3334. if( RF%lpmx(k) ) then
  3335. allocate( pmx( i1:i2, j1:j2, 1:lmr ) ) ; pmx = 0.0
  3336. call PMx_Integrate_3d( region, RF%sizepmx(k), pmx, status )
  3337. IF_NOTOK_RETURN(status=1)
  3338. rf%data3d(:,:,:, rf%trec, k) = pmx
  3339. ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
  3340. ! reshape( pmx(i1:i2,j1:j2,lms:lme), (/imr,jmr,lmr,1/) ), status &
  3341. ! start=(/i1,j1,1,RF%trec/), count=(/imr,jmr,lmr,1/) )
  3342. deallocate( pmx )
  3343. else
  3344. #endif
  3345. ! ---------
  3346. ! transported or chemistry only ?
  3347. ! ---------
  3348. select case( itr )
  3349. case( 1:ntracet )
  3350. ! ----------------------------------------------------
  3351. ! distinguish between mixing ratios and concentrations
  3352. ! ----------------------------------------------------
  3353. select case( RF%varid_type(k) )
  3354. case( 'conc' )
  3355. ! write slab of concentrations
  3356. ! m(trace) pressure xm(trace)
  3357. ! C = -------- * fscale * ----------- * ---------
  3358. ! m(air) temperature Rgas
  3359. ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
  3360. ! reshape( mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr) / &
  3361. ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
  3362. ! pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
  3363. ! Rgas, (/imr,jmr,lmr,1/) ), &
  3364. ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
  3365. #ifdef with_m7
  3366. rf%data3d(:,:,:, rf%trec, k) = mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr) / &
  3367. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
  3368. pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
  3369. Rgas
  3370. #else
  3371. write(gol,*)"Not using m7 - did not expected to be here."; call goErr
  3372. write(gol,*)" - make pres3d available"; call goErr
  3373. status=1; TRACEBACK; return
  3374. #endif
  3375. case( 'mixr' )
  3376. ! write slab of volume mixing ratios
  3377. ! m(trace)
  3378. ! X = -------- * fscale
  3379. ! m(air)
  3380. ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
  3381. ! reshape( mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr)/ &
  3382. ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr), &
  3383. ! (/imr,jmr,lmr,1/) ), &
  3384. ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
  3385. rf%data3d(:,:,:, rf%trec, k) = mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr)/ &
  3386. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr)
  3387. case( 'numb' )
  3388. ! write slab of concentrations
  3389. ! number(trace) pressure #/gridcell Pa*K*mol
  3390. ! C = ------------- * molmass_air * ---------------- = ------------- * kg/mol *-----------
  3391. ! m(air) temperature*Rgas kg/gridcell K*J
  3392. #ifdef with_m7
  3393. rf%data3d(:,:,:, rf%trec, k) = mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr) / &
  3394. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
  3395. pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
  3396. Rgas
  3397. #else
  3398. write(gol,*)"Not using m7 - did not expected to be here."; call goErr
  3399. write(gol,*)" - make pres3d available"; call goErr
  3400. status=1; TRACEBACK; return
  3401. #endif
  3402. case default
  3403. write (gol,'("no such unit type",a)') RF%varid_type(k); call goErr
  3404. status=1
  3405. end select
  3406. ! IF_NOTOK_MDF(fid=RF%ncid)
  3407. ! ---------
  3408. case( ntracet+1:ntrace )
  3409. ! ---------
  3410. ! ----------------------------------------------------
  3411. ! distinguish between mixing ratios and concentrations
  3412. ! ----------------------------------------------------
  3413. select case( RF%varid_type(k) )
  3414. case( 'conc' )
  3415. ! write slab of concentrations
  3416. ! m(trace) pressure xm(trace)
  3417. ! C = -------- * fscale * ----------- * ---------
  3418. ! m(air) temperature Rgas
  3419. ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
  3420. ! reshape( chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr) / &
  3421. ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
  3422. ! pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
  3423. ! Rgas, (/imr,jmr,lmr,1/) ), &
  3424. ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
  3425. #ifdef with_m7
  3426. rf%data3d(:,:,:, rf%trec, k) = chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr) / &
  3427. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
  3428. pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
  3429. Rgas
  3430. #else
  3431. write(gol,*)"Not using m7 - did not expected to be here."; call goErr
  3432. write(gol,*)" - make pres3d available"; call goErr
  3433. status=1; TRACEBACK; return
  3434. #endif
  3435. case( 'mixr' )
  3436. ! write slab of volume mixing ratios
  3437. ! m(trace)
  3438. ! X = -------- * fscale
  3439. ! m(air)
  3440. ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
  3441. ! reshape( chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr)/ &
  3442. ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr), &
  3443. ! (/imr,jmr,lmr,1/) ), &
  3444. ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
  3445. rf%data3d(:,:,:, rf%trec, k) = chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr)/ &
  3446. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr)
  3447. case default
  3448. write (gol,'("no such unit type",a)') RF%varid_type(k); call goErr
  3449. status=1
  3450. end select
  3451. IF_NOTOK_MDF(fid=RF%ncid)
  3452. ! ---------
  3453. ! NOy and others (M7)
  3454. ! ---------
  3455. #ifdef with_m7
  3456. case( iNOy, iSO4, iBC, iPOM, iSS, iDU )
  3457. #else
  3458. case( iNOy )
  3459. #endif
  3460. listtrac(:) = -999
  3461. select case( itr )
  3462. case( iNOy ); numtrac = nNOyt; listtrac(1:nNOyt) = iNOyt
  3463. #ifdef with_m7
  3464. case( iSO4 ); numtrac = nSO4t; listtrac(1:nSO4t) = iSO4t
  3465. case( iBC ); numtrac = nBCt ; listtrac(1:nBCt ) = iBCt
  3466. case( iPOM ); numtrac = nPOMt; listtrac(1:nPOMt) = iPOMt
  3467. case( iSS ); numtrac = nSSt ; listtrac(1:nSSt ) = iSSt
  3468. case( iDU ); numtrac = nDUt ; listtrac(1:nDUt ) = iDUt
  3469. #endif
  3470. end select
  3471. ! mole fraction = sum of mole fractions of components
  3472. ! storage for sum of components (distributed over levels):
  3473. allocate( Compo_k(i1:i2,j1:j2,lmr) )
  3474. ! 3d fields with all levels or local levels only:
  3475. allocate( field_k(i1:i2,j1:j2,lmr) )
  3476. ! loop over transported components:
  3477. Compo_k = 0.0
  3478. do k_comp = 1, numtrac
  3479. ! no more components??
  3480. if( listtrac(k_comp) < 0 ) exit
  3481. ! global tracer index:
  3482. itr_comp = listtrac(k_comp)
  3483. ! check ...
  3484. if ( itr_comp > ntracet ) then
  3485. write (gol,'("index of NOy component does not represent a transported tracer : ",i3)') itr_comp; call goErr
  3486. TRACEBACK; status=1; return
  3487. end if
  3488. ! ----------------------------------------------------
  3489. ! distinguish between mixing ratios and concentrations
  3490. ! ----------------------------------------------------
  3491. select case( RF%varid_type(k) )
  3492. case( 'conc' )
  3493. ! calculate concentrations
  3494. ! m(trace) pressure xm(trace)
  3495. ! C = -------- * fscale * ----------- * ---------
  3496. ! m(air) temperature Rgas
  3497. #ifdef with_m7
  3498. field_k = mass_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr_comp) / &
  3499. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * &
  3500. xmair * 1.E-03 * pres3d(i1:i2,j1:j2,1:lmr) / &
  3501. temper_dat(region)%data(i1:i2,j1:j2,1:lmr) / Rgas
  3502. #else
  3503. write(gol,*)"Not using m7 - did not expected to be here."; call goErr
  3504. write(gol,*)" - make pres3d available"; call goErr
  3505. status=1; TRACEBACK; return
  3506. #endif
  3507. case( 'mixr' )
  3508. ! m(trace)
  3509. ! X = -------- * fscale
  3510. ! m(air)
  3511. field_k = mass_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr_comp) / &
  3512. m_dat(region)%data(i1:i2,j1:j2,lms:lme) * &
  3513. fscale(itr_comp)
  3514. case default
  3515. write (gol,'("no such unit type",a)') RF%varid_type(k); call goErr
  3516. TRACEBACK; status=1; return
  3517. end select
  3518. ! add contribution of this component:
  3519. Compo_k = Compo_k + field_k
  3520. end do
  3521. ! write slab of volume mixing ratio's:
  3522. ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
  3523. ! reshape( Compo_k, (/imr,jmr,lmr,1/) ), &
  3524. ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
  3525. ! IF_NOTOK_MDF(fid=RF%ncid)
  3526. rf%data3d(:,:,:, rf%trec, k) = Compo_k
  3527. ! clear
  3528. deallocate( Compo_k )
  3529. deallocate( field_k )
  3530. ! -------------------
  3531. case default
  3532. ! -------------------
  3533. write (gol,'("strange tracer index requested : ",i6)') itr; call goErr
  3534. TRACEBACK; status=1; return
  3535. end select
  3536. #ifdef with_m7
  3537. endif
  3538. #endif
  3539. end do ! tracer
  3540. !----------------
  3541. ! WRITE
  3542. !----------------
  3543. if ( RF%trec == rf%n_rec ) then
  3544. call MDF_Put_Var( RF%ncid, RF%varid_time, rf%time, status)
  3545. IF_NOTOK_MDF(fid=RF%ncid)
  3546. call MDF_Put_Var( RF%ncid, RF%varid_date, rf%date, status)
  3547. IF_NOTOK_MDF(fid=RF%ncid)
  3548. ! surface presure
  3549. call MDF_Put_Var( RF%ncid, RF%varid_ps, rf%sp, status, start=(/i1,j1,1/) )
  3550. IF_NOTOK_MDF(fid=RF%ncid)
  3551. ! temperature (3d)
  3552. call MDF_Put_Var( RF%ncid, RF%varid_temp, RF%data3d_t(:,:,:,:), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,RF%n_rec/) )
  3553. IF_NOTOK_MDF(fid=RF%ncid)
  3554. #ifdef tropomi
  3555. if ( isRoot ) then
  3556. write (gol,'(a,2i4)') 'PDUMP - writing fields T, hgt, ltropo, no2, so2, hcho; trec, n_rec ', RF%trec, rf%n_rec
  3557. call goPr
  3558. end if
  3559. ! temperature (3d)
  3560. call MDF_Put_Var( RF%ncid, RF%varid_temp, RF%data3d_t(:,:,:,:), status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,RF%n_rec/) )
  3561. IF_NOTOK_MDF(fid=RF%ncid)
  3562. ! surface altitude (2d)
  3563. call MDF_Put_Var( RF%ncid, RF%varid_hgt, RF%data2d_hgt(:,:), status, start=(/i1,j1/), count=(/imr,jmr/) )
  3564. IF_NOTOK_MDF(fid=RF%ncid)
  3565. ! highest tropopause level (2d)
  3566. call MDF_Put_Var( RF%ncid, RF%varid_ltropo, RF%data2d_ltropo(:,:,:), status, start=(/i1,j1,1/), count=(/imr,jmr,RF%n_rec/) )
  3567. IF_NOTOK_MDF(fid=RF%ncid)
  3568. #endif
  3569. ! vmr
  3570. do k = 1, RF%ntr
  3571. call MDF_Put_Var( RF%ncid, RF%varid_tr(k), RF%data3d(:,:,:,:,k), status, start=(/i1,j1,1,1/) )
  3572. IF_NOTOK_MDF(fid=RF%ncid)
  3573. end do
  3574. end if
  3575. !----------------
  3576. ! DONE
  3577. !----------------
  3578. #ifdef with_m7
  3579. deallocate(pres3d)
  3580. #endif
  3581. call goLabel()
  3582. status = 0
  3583. END SUBROUTINE RF_VMR_Write
  3584. !EOC
  3585. !--------------------------------------------------------------------------
  3586. ! TM5 !
  3587. !--------------------------------------------------------------------------
  3588. !BOP
  3589. !
  3590. ! !IROUTINE: RF_VMR_Done
  3591. !
  3592. ! !DESCRIPTION: close file #3
  3593. !\\
  3594. !\\
  3595. ! !INTERFACE:
  3596. !
  3597. SUBROUTINE RF_VMR_Done( RF, status )
  3598. !
  3599. ! !INPUT/OUTPUT PARAMETERS:
  3600. !
  3601. type(TPdumpFile_VMR), intent(inout) :: RF
  3602. !
  3603. ! !OUTPUT PARAMETERS:
  3604. !
  3605. integer, intent(out) :: status
  3606. !
  3607. ! !REVISION HISTORY:
  3608. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  3609. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  3610. !
  3611. !EOP
  3612. !------------------------------------------------------------------------
  3613. !BOC
  3614. character(len=*), parameter :: rname = mname//'/RF_VMR_Done'
  3615. ! --- begin -------------------------------------
  3616. call goLabel(rname)
  3617. call MDF_Close( RF%ncid, status )
  3618. IF_NOTOK_RETURN(status=1)
  3619. deallocate(rf%date, rf%time, rf%sp, rf%data3d )
  3620. deallocate(rf%data3d_t)
  3621. #ifdef tropomi
  3622. deallocate(rf%data2d_hgt)
  3623. deallocate(rf%data2d_ltropo)
  3624. #endif
  3625. call goLabel() ; status = 0
  3626. END SUBROUTINE RF_VMR_Done
  3627. !EOC
  3628. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  3629. ! FILE: 2D LT output
  3630. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  3631. !--------------------------------------------------------------------------
  3632. ! TM5 !
  3633. !--------------------------------------------------------------------------
  3634. !BOP
  3635. !
  3636. ! !IROUTINE: RF_LT_Init
  3637. !
  3638. ! !DESCRIPTION:
  3639. !\\
  3640. !\\
  3641. ! !INTERFACE:
  3642. !
  3643. subroutine RF_LT_Init( RF, fdir, model, expid, filetype, region, &
  3644. idate_f, local_time, tracer_names, status )
  3645. !
  3646. ! !USES:
  3647. !
  3648. use Binas, only : xmair
  3649. use GO, only : goReadFromLine, goUpCase
  3650. use GO, only : NewDate
  3651. use dims, only : im, jm
  3652. use chem_param, only : ntrace, names, ra
  3653. use partools, only : MPI_INFO_NULL, localComm
  3654. use MeteoData, only : global_lli, levi, sp_dat, Set
  3655. !
  3656. ! !OUTPUT PARAMETERS:
  3657. !
  3658. type(TPdumpFile_LT), intent(out) :: RF
  3659. !
  3660. ! !INPUT PARAMETERS:
  3661. !
  3662. character(len=*), intent(in) :: fdir
  3663. character(len=*), intent(in) :: model
  3664. character(len=*), intent(in) :: expid
  3665. character(len=*), intent(in) :: filetype
  3666. integer, intent(in) :: region
  3667. integer, intent(in) :: idate_f(6)
  3668. integer, intent(in) :: local_time
  3669. character(len=*), intent(in) :: tracer_names
  3670. integer, intent(out) :: status
  3671. !
  3672. ! !REVISION HISTORY:
  3673. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  3674. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  3675. !
  3676. !EOP
  3677. !------------------------------------------------------------------------
  3678. !BOC
  3679. character(len=*), parameter :: rname = mname//'/RF_LT_Init'
  3680. ! --- local ------------------------------------
  3681. character(len=256) :: fname
  3682. integer :: varid
  3683. integer :: imr, jmr, lmr
  3684. character(len=256) :: trnames
  3685. character(len=8) :: trname, tmname
  3686. character(len=3) :: cwavel
  3687. integer :: k, itr, i1, i2, j1, j2
  3688. character(len=32) :: varname, varname_enti, varname_spec
  3689. character(len=64) :: cf_medium_stnd, cf_medium_long
  3690. character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
  3691. character(len=64) :: cf_spec_stnd, cf_spec_long
  3692. character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
  3693. character(len=512) :: comment
  3694. ! --- begin -------------------------------------
  3695. call goLabel(rname)
  3696. ! store arguments
  3697. RF%local_time = local_time
  3698. RF%tracer_names = tracer_names
  3699. ! set tracer index for requested tracers:
  3700. write (gol,'("selected tracers for LT output:")'); call goPr
  3701. RF%ntr = 0
  3702. #ifdef with_m7
  3703. RF%laod = .false.
  3704. RF%wavel = -1.0
  3705. #endif
  3706. RF%itr = -1
  3707. trnames = tracer_names
  3708. do
  3709. ! empty ?
  3710. if ( len_trim(trnames) == 0 ) exit
  3711. ! next number:
  3712. if ( RF%ntr == ntrace ) then
  3713. write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
  3714. TRACEBACK; status=1; return
  3715. end if
  3716. RF%ntr = RF%ntr + 1
  3717. ! extract leading name:
  3718. call goReadFromLine( trnames, trname, status, sep=' ' )
  3719. IF_NOTOK_RETURN(status=1)
  3720. #ifdef with_m7
  3721. ! ---------------------------
  3722. ! check for AOD
  3723. ! ---------------------------
  3724. if( strlowercase(trname(1:3)) == 'aod' ) then
  3725. RF%laod(RF%ntr) = .true.
  3726. RF%itr (RF%ntr) = -1
  3727. ! paste size to real
  3728. read(trname(5:len_trim(trname)), * ) RF%wavel(RF%ntr)
  3729. else
  3730. #endif
  3731. ! convert to tm5 name:
  3732. select case ( trim(strlowercase(trname)) )
  3733. case ( 'hcho' ) ; tmname = 'CH2O'
  3734. case ( 'rn', 'radon' ) ; tmname = 'Rn222'
  3735. case ( 'pb', 'lead' ) ; tmname = 'Pb210'
  3736. case default ; tmname = trname
  3737. end select
  3738. ! NOy is a special ...
  3739. select case ( trim(strlowercase(tmname)) )
  3740. case ( 'NOy' )
  3741. ! defined as ntrace+1
  3742. RF%itr(RF%ntr) = iNOy
  3743. write (gol,'(" * ",a10)') trim(trname); call goPr
  3744. case default
  3745. ! loop over all names:
  3746. RF%itr(RF%ntr) = -1
  3747. do itr = 1, ntrace
  3748. ! case indendent match ?
  3749. if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
  3750. write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4)') itr, trim(trname), trim(names(itr)), ra(itr); call goPr
  3751. RF%itr(RF%ntr) = itr
  3752. exit
  3753. end if
  3754. end do
  3755. end select ! not found ?
  3756. if ( RF%itr(RF%ntr) < 0 ) then
  3757. write (gol,'("tracer name not supported:")'); call goPr
  3758. write (gol,'(" list all : ",a)') trim(tracer_names); call goPr
  3759. write (gol,'(" list element : ",i3)') RF%ntr; call goPr
  3760. write (gol,'(" pdump name : ",a)') trim(trname); call goPr
  3761. write (gol,'(" tm5 name : ",a)') trim(tmname); call goPr
  3762. write (gol,'(" tm5 tracers : ")'); call goPr
  3763. do itr = 1, ntrace
  3764. write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
  3765. end do
  3766. TRACEBACK; status=1; return
  3767. end if
  3768. #ifdef with_m7
  3769. end if ! aod
  3770. #endif
  3771. ! store pdump name:
  3772. RF%name_tr(RF%ntr) = trname
  3773. end do
  3774. ! empty file ?
  3775. if ( RF%ntr < 1 ) then
  3776. write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
  3777. TRACEBACK; status=1; return
  3778. end if
  3779. ! grid size
  3780. imr = global_lli(region)%nlon
  3781. jmr = global_lli(region)%nlat
  3782. lmr = levi%nlev
  3783. ! o open file
  3784. ! write filename
  3785. write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
  3786. trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
  3787. ! open:
  3788. #ifdef MPI
  3789. ! overwrite existing files (clobber), provide MPI stuff:
  3790. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
  3791. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  3792. if (status/=0) then
  3793. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  3794. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  3795. TRACEBACK; status=1; return
  3796. end if
  3797. #else
  3798. ! overwrite existing files (clobber)
  3799. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
  3800. IF_NOTOK_RETURN(status=1)
  3801. #endif
  3802. ! o global attributes
  3803. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'local time output' , status)
  3804. IF_NOTOK_MDF(fid=RF%ncid)
  3805. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
  3806. IF_NOTOK_MDF(fid=RF%ncid)
  3807. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
  3808. IF_NOTOK_MDF(fid=RF%ncid)
  3809. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
  3810. IF_NOTOK_MDF(fid=RF%ncid)
  3811. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'file_version_number', trim(outfileversnr) , status)
  3812. IF_NOTOK_MDF(fid=RF%ncid)
  3813. ! o define dimensions
  3814. call MDF_Def_Dim( RF%ncid, 'lon' , global_lli(region)%nlon, RF%dimid_lon , status)
  3815. IF_NOTOK_MDF(fid=RF%ncid)
  3816. call MDF_Def_Dim( RF%ncid, 'lat' , global_lli(region)%nlat, RF%dimid_lat , status)
  3817. IF_NOTOK_MDF(fid=RF%ncid)
  3818. call MDF_Def_Dim( RF%ncid, 'lev' , levi%nlev , RF%dimid_lev , status)
  3819. IF_NOTOK_MDF(fid=RF%ncid)
  3820. call MDF_Def_Dim( RF%ncid, 'time' , 1 , RF%dimid_time , status)
  3821. IF_NOTOK_MDF(fid=RF%ncid)
  3822. call MDF_Def_Dim( RF%ncid, 'datelen', 6 , RF%dimid_datelen, status)
  3823. IF_NOTOK_MDF(fid=RF%ncid)
  3824. ! o define variables
  3825. call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
  3826. IF_NOTOK_MDF(fid=RF%ncid)
  3827. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3828. IF_NOTOK_MDF(fid=RF%ncid)
  3829. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
  3830. IF_NOTOK_MDF(fid=RF%ncid)
  3831. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'longitude' , status)
  3832. IF_NOTOK_MDF(fid=RF%ncid)
  3833. call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_east', status)
  3834. IF_NOTOK_MDF(fid=RF%ncid)
  3835. RF%varid_lon = varid
  3836. call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
  3837. IF_NOTOK_MDF(fid=RF%ncid)
  3838. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3839. IF_NOTOK_MDF(fid=RF%ncid)
  3840. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
  3841. IF_NOTOK_MDF(fid=RF%ncid)
  3842. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'latitude' , status)
  3843. IF_NOTOK_MDF(fid=RF%ncid)
  3844. call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_north', status)
  3845. IF_NOTOK_MDF(fid=RF%ncid)
  3846. RF%varid_lat = varid
  3847. call MDF_Def_Var( RF%ncid, 'lev', mdf_float, (/RF%dimid_lev/), varid , status)
  3848. IF_NOTOK_MDF(fid=RF%ncid)
  3849. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3850. IF_NOTOK_MDF(fid=RF%ncid)
  3851. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate' , status)
  3852. IF_NOTOK_MDF(fid=RF%ncid)
  3853. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'level' , status)
  3854. IF_NOTOK_MDF(fid=RF%ncid)
  3855. call MDF_Put_Att( RF%ncid, varid, 'units' , '1' , status)
  3856. IF_NOTOK_MDF(fid=RF%ncid)
  3857. call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a_bnds(k)*p0 + b_bnds(k)*ps(n,j,i)' , status)
  3858. IF_NOTOK_MDF(fid=RF%ncid)
  3859. RF%varid_lev = varid
  3860. call MDF_Def_Var( RF%ncid, 'time', mdf_float, (/RF%dimid_time/), varid , status)
  3861. IF_NOTOK_MDF(fid=RF%ncid)
  3862. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3863. IF_NOTOK_MDF(fid=RF%ncid)
  3864. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
  3865. IF_NOTOK_MDF(fid=RF%ncid)
  3866. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'time' , status)
  3867. IF_NOTOK_MDF(fid=RF%ncid)
  3868. call MDF_Put_Att( RF%ncid, varid, 'units' , 'days since 1950-01-01 00:00:00', status)
  3869. IF_NOTOK_MDF(fid=RF%ncid)
  3870. call MDF_Put_Att( RF%ncid, varid, 'calender' , 'gregorian' , status)
  3871. IF_NOTOK_MDF(fid=RF%ncid)
  3872. RF%varid_time = varid
  3873. call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
  3874. IF_NOTOK_MDF(fid=RF%ncid)
  3875. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3876. IF_NOTOK_MDF(fid=RF%ncid)
  3877. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
  3878. IF_NOTOK_MDF(fid=RF%ncid)
  3879. call MDF_Put_Att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
  3880. IF_NOTOK_MDF(fid=RF%ncid)
  3881. RF%varid_date = varid
  3882. call MDF_Def_Var( RF%ncid, 'ps', MDF_FLOAT, &
  3883. (/RF%dimid_lon,RF%dimid_lat,RF%dimid_time/), varid, status )
  3884. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  3885. IF_NOTOK_MDF(fid=RF%ncid)
  3886. IF_NOTOK_MDF(fid=RF%ncid)
  3887. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'surface_air_pressure', status)
  3888. IF_NOTOK_MDF(fid=RF%ncid)
  3889. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'surface pressure' , status)
  3890. IF_NOTOK_MDF(fid=RF%ncid)
  3891. call MDF_Put_Att( RF%ncid, varid, 'units' , 'Pa' , status)
  3892. IF_NOTOK_MDF(fid=RF%ncid)
  3893. RF%varid_ps = varid
  3894. ! CF standard name for medium:
  3895. cf_medium_stnd = 'in_air' ; cf_medium_long = 'in humid air'
  3896. ! loop over tracer to be written:
  3897. do k = 1, RF%ntr
  3898. #ifdef with_m7
  3899. if( RF%laod(k) ) then
  3900. ! get diameter
  3901. write(cwavel,'(I3)') RF%wavel(k)
  3902. ! Aerosol Optical Depth (AOD):
  3903. varname_spec = 'AOD@'//trim(cwavel)
  3904. cf_spec_stnd = 'AOD at '//trim(cwavel)//'nm'
  3905. cf_spec_long = 'aerosol optical depth at '//trim(cwavel)//' nanometer'
  3906. cf_enti_stnd = 'aerosol_optical_depth'
  3907. cf_enti_unit = '1'
  3908. cf_enti_long = 'aerosol optical depth'
  3909. else
  3910. #endif
  3911. ! global tracer index
  3912. itr = RF%itr(k)
  3913. ! ~~ local time species info
  3914. ! CF standard name for concentration/mixing ratio/column:
  3915. cf_enti_stnd = 'mole_fraction'
  3916. cf_enti_unit = 'mole mole-1'
  3917. cf_enti_long = 'volume mixing ratio'
  3918. ! start of dataset name:
  3919. varname_enti = 'dry'
  3920. ! no comment yet
  3921. comment = ''
  3922. ! standard names from CF conventions:
  3923. select case ( RF%name_tr(k) )
  3924. case ( 'CO', 'co' )
  3925. varname_spec = 'co'
  3926. cf_spec_stnd = 'carbon_monoxide'
  3927. cf_spec_long = 'CO'
  3928. case ( 'O3', 'o3' )
  3929. varname_spec = 'o3'
  3930. cf_spec_stnd = 'ozone'
  3931. cf_spec_long = 'O3'
  3932. case ( 'O3s', 'o3s' )
  3933. varname_spec = 'o3s'
  3934. cf_spec_stnd = 'ozone_from_stratosphere'
  3935. cf_spec_long = 'O3s'
  3936. case ( 'NO', 'no' )
  3937. varname_spec = 'no'
  3938. cf_spec_stnd = 'nitrogen_monoxide'
  3939. cf_spec_long = 'NO'
  3940. case ( 'NO2', 'no2' )
  3941. varname_spec = 'no2'
  3942. cf_spec_stnd = 'nitrogen_dioxide'
  3943. cf_spec_long = 'NO2'
  3944. case ( 'NOy', 'noy' )
  3945. varname_spec = 'noy'
  3946. cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
  3947. cf_spec_long = 'NOy'
  3948. comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
  3949. 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
  3950. case ( 'CH2O', 'ch2o', 'CHOH', 'choh' )
  3951. varname_spec = 'ch2o'
  3952. cf_spec_stnd = 'formaldehyde'
  3953. cf_spec_long = 'CH2O'
  3954. case ( 'SO2', 'so2' )
  3955. varname_spec = 'so2'
  3956. cf_spec_stnd = 'sulfur_dioxide'
  3957. cf_spec_long = 'SO2'
  3958. case ( 'CH4', 'ch4' )
  3959. varname_spec = 'ch4'
  3960. cf_spec_stnd = 'methane'
  3961. cf_spec_long = 'CH4'
  3962. case ( 'OH', 'oh' )
  3963. varname_spec = 'oh'
  3964. cf_spec_stnd = 'hydroxyl_radical'
  3965. cf_spec_long = 'OH'
  3966. case ( 'H2O2', 'h2o2' )
  3967. varname_spec = 'h2o2'
  3968. cf_spec_stnd = 'hydrogen_peroxide'
  3969. cf_spec_long = 'H2O2'
  3970. case ( 'HNO3', 'hno3' )
  3971. varname_spec = 'hno3'
  3972. cf_spec_stnd = 'nitric_acid'
  3973. cf_spec_long = 'HNO3'
  3974. case ( 'NH3', 'nh3' )
  3975. varname_spec = 'nh3'
  3976. cf_spec_stnd = 'ammonia'
  3977. cf_spec_long = 'NH3'
  3978. case ( 'NH4', 'nh4' )
  3979. varname_spec = 'nh4'
  3980. cf_spec_stnd = 'ammonium'
  3981. cf_spec_long = 'NH4'
  3982. case ( 'ORGNTR','orgntr' )
  3983. varname_spec = 'orgntr'
  3984. cf_spec_stnd = 'organic_nitrate'
  3985. cf_spec_long = 'ORGNTR'
  3986. case ( 'PAN', 'pan' )
  3987. varname_spec = 'pan'
  3988. cf_spec_stnd = 'peroxyacetyl_nitrate'
  3989. cf_spec_long = 'PAN'
  3990. case ( 'Rn', 'rn', 'Radon', 'radon' )
  3991. varname_spec = 'rn'
  3992. cf_spec_stnd = 'radon'
  3993. cf_spec_long = 'Rn'
  3994. case ( 'Pb', 'pb', 'Lead', 'lead' )
  3995. varname_spec = 'pb'
  3996. cf_spec_stnd = 'lead'
  3997. cf_spec_long = 'Pb'
  3998. case default
  3999. write (gol,'("do not know how to match tracer with CF standard names : ",a)') RF%name_tr(k); call goPr
  4000. TRACEBACK; status=1; return
  4001. end select
  4002. #ifdef with_m7
  4003. end if ! RF%laod(k)
  4004. #endif
  4005. ! define variable:
  4006. call MDF_Def_Var( RF%ncid, trim(varname_spec), MDF_FLOAT, &
  4007. (/RF%dimid_lon,RF%dimid_lat,RF%dimid_lev,RF%dimid_time/), varid, status )
  4008. IF_NOTOK_MDF(fid=RF%ncid)
  4009. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4010. IF_NOTOK_MDF(fid=RF%ncid)
  4011. ! total names:
  4012. cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)//'_'//trim(cf_medium_stnd)
  4013. cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)//' '//trim(cf_medium_long)
  4014. cf_name_unit = trim(cf_enti_unit)
  4015. ! write attributes:
  4016. call MDF_Put_Att( RF%ncid, varid, 'standard_name', trim(cf_name_stnd) , status)
  4017. IF_NOTOK_MDF(fid=RF%ncid)
  4018. call MDF_Put_Att( RF%ncid, varid, 'long_name', trim(cf_name_long) , status)
  4019. IF_NOTOK_MDF(fid=RF%ncid)
  4020. call MDF_Put_Att( RF%ncid, varid, 'units', trim(cf_name_unit) , status)
  4021. IF_NOTOK_MDF(fid=RF%ncid)
  4022. if ( itr <= ntrace .and. itr > 0 ) then
  4023. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
  4024. IF_NOTOK_MDF(fid=RF%ncid)
  4025. else
  4026. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
  4027. IF_NOTOK_MDF(fid=RF%ncid)
  4028. end if
  4029. call MDF_Put_Att( RF%ncid, varid, 'moleweight_air', xmair*1e3 , status)
  4030. IF_NOTOK_MDF(fid=RF%ncid)
  4031. call MDF_Put_Att( RF%ncid, varid, 'moleweight_unit', 'kg mole-1' , status)
  4032. IF_NOTOK_MDF(fid=RF%ncid)
  4033. if ( len_trim(comment) > 0 ) then
  4034. call MDF_Put_Att( RF%ncid, varid, 'comment', trim(comment) , status)
  4035. IF_NOTOK_MDF(fid=RF%ncid)
  4036. end if
  4037. ! store varid
  4038. RF%varid_tr(k) = varid
  4039. end do
  4040. ! o end defintion mode
  4041. call MDF_EndDef( RF%ncid , status)
  4042. IF_NOTOK_MDF(fid=RF%ncid)
  4043. ! no records written yet
  4044. RF%trec = 0
  4045. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  4046. allocate(RF%accu (i1:i2, j1:j2, 1:lmr, RF%ntr)) ; RF%accu = 0
  4047. allocate(RF%naccu (i1:i2, RF%ntr )) ; RF%naccu = 0
  4048. allocate(RF%p_accu (i1:i2, j1:j2 )) ; RF%p_accu = 0
  4049. allocate(RF%np_accu(i1:i2 )) ; RF%np_accu = 0
  4050. call goLabel()
  4051. status = 0
  4052. END SUBROUTINE RF_LT_Init
  4053. !EOC
  4054. !--------------------------------------------------------------------------
  4055. ! TM5 !
  4056. !--------------------------------------------------------------------------
  4057. !BOP
  4058. !
  4059. ! !IROUTINE: RF_LT_Write
  4060. !
  4061. ! !DESCRIPTION: does not write anything, just get
  4062. !\\
  4063. !\\
  4064. ! !INTERFACE:
  4065. !
  4066. SUBROUTINE RF_LT_Write( RF, region, idate_f, status )
  4067. !
  4068. ! !USES:
  4069. !
  4070. use GO, only : TDate, NewDate, Set, iTotal, rTotal, operator(-), wrtgol
  4071. use chem_param, only : ntrace, ntracet, fscale
  4072. use tracer_data, only : mass_dat, chem_dat
  4073. use MeteoData, only : global_lli, levi, m_dat, sp_dat
  4074. !
  4075. ! !INPUT/OUTPUT PARAMETERS:
  4076. !
  4077. type(TPdumpFile_LT), intent(inout) :: RF
  4078. !
  4079. ! !INPUT PARAMETERS:
  4080. !
  4081. integer, intent(in) :: region
  4082. integer, intent(in) :: idate_f(6)
  4083. !
  4084. ! !OUTPUT PARAMETERS:
  4085. !
  4086. integer, intent(out) :: status
  4087. !
  4088. ! !REVISION HISTORY:
  4089. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  4090. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  4091. !
  4092. !EOP
  4093. !------------------------------------------------------------------------
  4094. !BOC
  4095. character(len=*), parameter :: rname = mname//'/RF_LT_Write'
  4096. ! --- local ------------------------------------
  4097. integer :: imr, jmr, lmr, gimr, i1, i2, j1, j2
  4098. real, allocatable :: lev(:)
  4099. real, allocatable :: field_out(:,:,:)
  4100. real, allocatable :: field_out_b(:,:)
  4101. integer :: l, ls, le
  4102. type(TDate) :: t, t0
  4103. real :: time
  4104. real :: dt_sec
  4105. integer :: i, j, k, itr
  4106. integer(kind=8) :: itau
  4107. integer :: loctim, gridboxtimestep
  4108. integer :: iloctim,itautoday,ilon
  4109. integer :: icomp, itr_loc, ncells, window
  4110. ! --- begin -------------------------------------
  4111. ! for multiple of dhour only ...
  4112. ! if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
  4113. ! status=0; return
  4114. ! end if
  4115. call goLabel(rname)
  4116. ! grid size
  4117. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  4118. imr=i2-i1+1
  4119. jmr=j2-j1+1
  4120. gimr = global_lli(region)%nlon
  4121. ! gjmr = global_lli(region)%nlat
  4122. lmr = levi%nlev
  4123. ! next time record:
  4124. RF%trec = RF%trec + 1
  4125. if(okdebug)then
  4126. write(gol,*) "RF_LT_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
  4127. end if
  4128. ! grid index offsets for GMT and local time
  4129. loctim=RF%local_time
  4130. if( loctim < 0 ) loctim=loctim+24*3600
  4131. ! time since 1950-1-1 00:00
  4132. t0 = NewDate( time6=time_reftime6 )
  4133. t = NewDate( time6=idate_f )
  4134. call SET( t, hour=0, min=0, sec=0 )
  4135. time = rTotal( t - t0, 'day' ) + loctim / 86400.
  4136. !
  4137. ! ~~ time, grid
  4138. !
  4139. ! only once ...
  4140. if ( RF%trec == 1 ) then
  4141. ! write longitudes:
  4142. call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
  4143. IF_NOTOK_MDF(fid=RF%ncid)
  4144. ! write latitudes:
  4145. call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
  4146. IF_NOTOK_MDF(fid=RF%ncid)
  4147. ! write level indices:
  4148. allocate( lev(lmr) )
  4149. do l = 1, lmr
  4150. lev(l) = real(l)
  4151. end do
  4152. call MDF_Put_Var( RF%ncid, RF%varid_lev, lev , status)
  4153. IF_NOTOK_MDF(fid=RF%ncid)
  4154. deallocate(lev)
  4155. ! time:
  4156. call MDF_Put_Var( RF%ncid, RF%varid_time, (/time/) , status, start=(/RF%trec/))
  4157. IF_NOTOK_MDF(fid=RF%ncid)
  4158. ! date:
  4159. call MDF_Put_Var( RF%ncid, RF%varid_date, reshape(real(idate_f),(/6,1/)), status, &
  4160. start=(/1,1/), count=(/6,1/) )
  4161. IF_NOTOK_MDF(fid=RF%ncid)
  4162. end if ! first record
  4163. !
  4164. ! local time
  4165. !
  4166. if ( RF%trec > 1 ) then ! do not accumulate fields on 00:00
  4167. ! grid index offsets for GMT and local time
  4168. loctim=RF%local_time
  4169. if( loctim < 0 ) loctim=loctim+24*3600
  4170. gridboxtimestep=24*3600/gimr
  4171. itau = idate_f(4)*3600+idate_f(5)*60+idate_f(6)
  4172. itautoday= nint(real(mod(itau,24*3600)*gimr)/real(24*3600))
  4173. iloctim = nint(real(loctim *gimr)/real(24*3600))
  4174. ! determine longitude index wrt Greenwich from difference (local time - GMT)
  4175. ! also process neigboring longitudes (i-2 , i-1 , i , i+1 , i+2) depending on
  4176. ! number of longitudinal grid cells
  4177. ncells = ceiling( gimr / 24. )
  4178. window = ceiling( ncells / 2. )
  4179. do ilon = 1, ncells
  4180. i = 1 + mod( gimr + gimr/2 + iloctim - itautoday + (ilon - window),gimr )
  4181. if (i .ge. i1 .and. i.le. i2) then
  4182. RF%p_accu(i,j1:j2)= RF%p_accu(i,j1:j2)+sp_dat(region)%data(i,j1:j2,1)
  4183. RF%np_accu(i)= RF%np_accu(i)+1
  4184. ! loop over tracers to be written:
  4185. do k = 1, RF%ntr
  4186. ! global tracer index:
  4187. itr = RF%itr(k)
  4188. !!$#ifdef with_m7
  4189. !!$
  4190. !!$ ! ---------------------
  4191. !!$ ! AOD
  4192. !!$ ! ---------------------
  4193. !!$ if( RF%laod(k) ) then
  4194. !!$
  4195. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4196. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4197. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4198. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4199. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4200. !!$ allocate( ....... ) )
  4201. !!$
  4202. !!$ call PMx_Integrate_3d( region, RF%sizepmx(k), pmx, status )
  4203. !!$ IF_NOTOK_RETURN(status=1)
  4204. !!$
  4205. !!$ ! root only:
  4206. !!$ if ( myid == root ) then
  4207. !!$
  4208. !!$ status = pnf90_put_var( RF%ncid, RF%varid_tr(k), &
  4209. !!$ reshape( pmx(ims:ime,jms:jme,lms:lme), (/imr,jmr,lmr,1/) ), &
  4210. !!$ start=(/1,1,1,RF%trec/), count=(/imr,jmr,lmr,1/) )
  4211. !!$
  4212. !!$ end if
  4213. !!$
  4214. !!$ deallocate( ............. )
  4215. !!$
  4216. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4217. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4218. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4219. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4220. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4221. !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
  4222. !!$ else
  4223. !!$
  4224. !!$#endif
  4225. ! transported or chemistry only ?
  4226. if ( (itr >= 1) .and. (itr <= ntracet) ) then
  4227. RF%accu(i,j1:j2,1:lmr,k)= RF%accu(i,j1:j2,1:lmr,k)+&
  4228. (mass_dat(region)%rm(i,j1:j2,1:lmr,itr)/ &
  4229. m_dat(region)%data(i,j1:j2,1:lmr))*fscale(itr)
  4230. RF%naccu(i,k)=RF%naccu(i,k)+1
  4231. else if ( (itr >= ntracet+1) .and. (itr <= ntrace) ) then
  4232. RF%accu(i,j1:j2,1:lmr,k)= RF%accu(i,j1:j2,1:lmr,k)+&
  4233. (chem_dat(region)%rm(i,j1:j2,1:lmr,itr)/ &
  4234. m_dat(region)%data(i,j1:j2,1:lmr))*fscale(itr)
  4235. RF%naccu(i,k)=RF%naccu(i,k)+1
  4236. end if
  4237. enddo
  4238. endif
  4239. enddo
  4240. endif ! do not accumulate fields on 00:00
  4241. call goLabel(); status = 0
  4242. END SUBROUTINE RF_LT_Write
  4243. !EOC
  4244. !--------------------------------------------------------------------------
  4245. ! TM5 !
  4246. !--------------------------------------------------------------------------
  4247. !BOP
  4248. !
  4249. ! !IROUTINE: RF_LT_Done
  4250. !
  4251. ! !DESCRIPTION: write final data, then close file #4
  4252. !\\
  4253. !\\
  4254. ! !INTERFACE:
  4255. !
  4256. SUBROUTINE RF_LT_Done( RF, region, status )
  4257. !
  4258. ! !USES:
  4259. !
  4260. use MeteoData, only : global_lli, levi
  4261. !
  4262. ! !INPUT/OUTPUT PARAMETERS:
  4263. !
  4264. type(TPdumpFile_LT), intent(inout) :: RF
  4265. !
  4266. ! !INPUT PARAMETERS:
  4267. !
  4268. integer, intent(in) :: region
  4269. !
  4270. ! !OUTPUT PARAMETERS:
  4271. !
  4272. integer, intent(out) :: status
  4273. !
  4274. ! !REVISION HISTORY:
  4275. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  4276. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  4277. ! - move averaging & writing here
  4278. !
  4279. !EOP
  4280. !------------------------------------------------------------------------
  4281. !BOC
  4282. character(len =*), parameter :: rname = mname//'/RF_LT_Done'
  4283. integer :: imr, jmr
  4284. real, allocatable :: field_out(:,:,:)
  4285. real, allocatable :: field_out_b(:,:)
  4286. integer :: i, ls, le, k, itr, i1, i2, j1, j2, lmr
  4287. ! --- begin -------------------------------------
  4288. call goLabel(rname)
  4289. !---------------------
  4290. ! average & write data
  4291. !---------------------
  4292. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  4293. imr=i2-i1+1
  4294. jmr=j2-j1+1
  4295. lmr = levi%nlev
  4296. allocate(field_out_b(i1:i2,j1:j2)); field_out_b = 0.0
  4297. do i = i1, i2
  4298. if (RF%np_accu(i).gt.0) then
  4299. field_out_b(i,:) =RF%p_accu(i,:)/RF%np_accu(i)
  4300. endif
  4301. enddo
  4302. call MDF_Put_Var( RF%ncid, RF%varid_ps, reshape(field_out_b(i1:i2,j1:j2), &
  4303. (/imr,jmr,1/) ), status, start=(/i1,j1,1/), count=(/imr,jmr,1/) )
  4304. IF_NOTOK_MDF(fid=RF%ncid)
  4305. deallocate(field_out_b)
  4306. TRACERS: do k = 1, RF%ntr
  4307. ! global tracer index:
  4308. itr = RF%itr(k)
  4309. if ( (itr >= 1) .and. (itr <= ntrace) ) then
  4310. ! normalize fields, if necessary
  4311. allocate(field_out(i1:i2,j1:j2,1:lmr)); field_out = 0.0
  4312. do i = i1,i2
  4313. if (RF%naccu(i,k).gt.0) then
  4314. field_out(i,:,1:lmr) =RF%accu(i,:,1:lmr,k)/RF%naccu(i,k)
  4315. endif
  4316. enddo
  4317. ! write fields:
  4318. call MDF_Put_Var( RF%ncid, RF%varid_tr(k) , &
  4319. reshape(field_out(i1:i2,j1:j2,1:lmr) , &
  4320. (/imr,jmr,lmr,1/) ) , &
  4321. status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,1/) )
  4322. IF_NOTOK_MDF(fid=RF%ncid)
  4323. deallocate(field_out)
  4324. endif
  4325. end do TRACERS
  4326. !---------------------
  4327. ! DONE
  4328. !---------------------
  4329. call MDF_Close( RF%ncid , status)
  4330. IF_NOTOK_RETURN(status=1)
  4331. deallocate(RF%accu)
  4332. deallocate(RF%naccu)
  4333. deallocate(RF%p_accu)
  4334. deallocate(RF%np_accu)
  4335. call goLabel() ; status = 0
  4336. END SUBROUTINE RF_LT_Done
  4337. !EOC
  4338. #ifdef with_budgets
  4339. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  4340. ! FILE ##5 : 2D dry and wet deposition fields
  4341. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  4342. !--------------------------------------------------------------------------
  4343. ! TM5 !
  4344. !--------------------------------------------------------------------------
  4345. !BOP
  4346. !
  4347. ! !IROUTINE: RF_DEPS_Init
  4348. !
  4349. ! !DESCRIPTION:
  4350. !\\
  4351. !\\
  4352. ! !INTERFACE:
  4353. !
  4354. subroutine RF_DEPS_Init( RF, fdir, model, expid, filetype, region, &
  4355. idate_f, dhour, tracer_names, status )
  4356. !
  4357. ! !USES:
  4358. !
  4359. use Binas, only : xmair
  4360. use GO, only : goReadFromLine, goUpCase
  4361. use GO, only : NewDate
  4362. use dims, only : im, jm
  4363. use chem_param, only : ntrace, names, ra
  4364. use partools, only : MPI_INFO_NULL, localComm
  4365. use MeteoData, only : global_lli, levi
  4366. !
  4367. ! !OUTPUT PARAMETERS:
  4368. !
  4369. type(TPdumpFile_DEPS), intent(out) :: RF
  4370. integer, intent(out) :: status
  4371. !
  4372. ! !INPUT PARAMETERS:
  4373. !
  4374. character(len=*), intent(in) :: fdir
  4375. character(len=*), intent(in) :: model
  4376. character(len=*), intent(in) :: expid
  4377. character(len=*), intent(in) :: filetype
  4378. integer, intent(in) :: region
  4379. integer, intent(in) :: idate_f(6)
  4380. integer, intent(in) :: dhour
  4381. character(len=*), intent(in) :: tracer_names
  4382. !
  4383. ! !REVISION HISTORY:
  4384. ! 1 Oct 2010 - Achim Strunk - retor -> pdump
  4385. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  4386. !
  4387. !EOP
  4388. !------------------------------------------------------------------------
  4389. !BOC
  4390. character(len=*), parameter :: rname = mname//'/RF_DEPS_Init'
  4391. ! --- local ------------------------------------
  4392. character(len=256) :: fname
  4393. integer :: varid
  4394. character(len=256) :: trnames
  4395. character(len=8) :: trname, tmname
  4396. integer :: k, itr
  4397. character(len=32) :: varname, varname_enti, varname_spec
  4398. character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
  4399. character(len=64) :: cf_spec_stnd, cf_spec_long
  4400. character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
  4401. character(len=512) :: comment
  4402. logical :: with_wdep
  4403. integer :: imr, jmr, i1, i2, j1, j2
  4404. ! --- begin -------------------------------------
  4405. call goLabel(rname)
  4406. ! -- store arguments, init var
  4407. RF%dhour = dhour
  4408. RF%tracer_names = tracer_names
  4409. RF%ntr = 0
  4410. trnames = tracer_names
  4411. ! -- get dims
  4412. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  4413. imr=i2-i1+1
  4414. jmr=j2-j1+1
  4415. ! Switch to default .false., requires an extra call to PDUMP_Files_Write2 in OUTPUT_PDUMP_DONE
  4416. n_deps_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, mess='DPS_Init' )
  4417. !n_deps_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, .true., 'DPS_Init' )
  4418. if ( n_deps_rec == 0 ) then ! degenerated case
  4419. deps_apply = .false.
  4420. status=0
  4421. return
  4422. end if
  4423. ! -- tracer index for requested tracers:
  4424. if ( len_trim(trnames) == 0 ) then
  4425. deps_apply = .false.
  4426. write (gol,'("WARNING - NO tracers selected for depositions output!")') ; call goPr
  4427. write (gol,'(" - deps_apply set to False.")' ) ; call goPr
  4428. status=0
  4429. return
  4430. else
  4431. write (gol,'("selected tracers for depositions output:")'); call goPr
  4432. end if
  4433. do
  4434. if ( len_trim(trnames) == 0 ) exit
  4435. ! next number:
  4436. if ( RF%ntr == ntrace ) then
  4437. write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
  4438. TRACEBACK; status=1; return
  4439. end if
  4440. RF%ntr = RF%ntr + 1
  4441. ! extract leading name:
  4442. call goReadFromLine( trnames, trname, status, sep=' ' )
  4443. IF_NOTOK_RETURN(status=1)
  4444. ! store pdump name:
  4445. RF%name_tr(RF%ntr) = trname
  4446. ! convert to tm5 name:
  4447. select case ( trname )
  4448. case ( 'HCHO' ) ; tmname = 'CH2O'
  4449. case ( 'Rn', 'Radon' ) ; tmname = 'Rn222'
  4450. case ( 'Pb', 'Lead' ) ; tmname = 'Pb210'
  4451. case default ; tmname = trname
  4452. end select
  4453. ! wet deposition ?
  4454. with_wdep = .false.
  4455. select case ( trname )
  4456. case ( 'HNO3' ) ; with_wdep = .true.
  4457. case ( 'NOy' ) ; with_wdep = .true.
  4458. case ( 'NH3' ) ; with_wdep = .true.
  4459. case ( 'NH4' ) ; with_wdep = .true.
  4460. case ( 'SO4' ) ; with_wdep = .true.
  4461. end select
  4462. RF%with_wdep(RF%ntr) = with_wdep
  4463. ! NOy is a special ...
  4464. select case ( tmname )
  4465. case ( 'NOy' )
  4466. ! defined as ntrace+1
  4467. RF%itr(RF%ntr) = iNOy
  4468. write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4,"; wdep : ",l1)') &
  4469. -1,trim(trname), '*', -1.0, with_wdep; call goPr
  4470. case default
  4471. ! loop over all names:
  4472. RF%itr(RF%ntr) = -1
  4473. do itr = 1, ntrace
  4474. ! case indendent match ?
  4475. if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
  4476. write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4," ; wdep : ",l1)') &
  4477. itr, trim(trname), trim(names(itr)), ra(itr), with_wdep; call goPr
  4478. RF%itr(RF%ntr) = itr
  4479. exit
  4480. end if
  4481. end do
  4482. end select
  4483. ! not found ?
  4484. if ( RF%itr(RF%ntr) < 0 ) then
  4485. write (gol,'("tracer name not supported:") ') ; call goPr
  4486. write (gol,'(" list all : ",a) ') trim(tracer_names) ; call goPr
  4487. write (gol,'(" list element : ",i3) ') RF%ntr ; call goPr
  4488. write (gol,'(" pdump name : ",a) ') trim(trname) ; call goPr
  4489. write (gol,'(" tm5 name : ",a) ') trim(tmname) ; call goPr
  4490. write (gol,'(" tm5 tracers : ") ') ; call goPr
  4491. do itr = 1, ntrace
  4492. write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
  4493. end do
  4494. TRACEBACK; status=1; return
  4495. end if
  4496. end do
  4497. ! empty file ?
  4498. if ( RF%ntr < 1 ) then
  4499. write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
  4500. TRACEBACK; status=1; return
  4501. end if
  4502. ! allocate storage:
  4503. allocate( RF%ddep_budget(imr,jmr,RF%ntr) ) ; RF%ddep_budget = 0.0
  4504. allocate( RF%wdep_budget(imr,jmr,RF%ntr) ) ; RF%wdep_budget = 0.0
  4505. ! store current time (when budgets are reset):
  4506. RF%t0_budget = NewDate(time6=idate_f)
  4507. ! o open file
  4508. write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
  4509. trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
  4510. #ifdef MPI
  4511. ! overwrite existing files (clobber), provide MPI stuff:
  4512. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
  4513. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  4514. if (status/=0) then
  4515. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  4516. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  4517. TRACEBACK; status=1; return
  4518. end if
  4519. #else
  4520. ! overwrite existing files (clobber)
  4521. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
  4522. IF_NOTOK_RETURN(status=1)
  4523. #endif
  4524. ! o global attributes
  4525. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'dry and wet deposition' , status)
  4526. IF_NOTOK_MDF(fid=RF%ncid)
  4527. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
  4528. IF_NOTOK_MDF(fid=RF%ncid)
  4529. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
  4530. IF_NOTOK_MDF(fid=RF%ncid)
  4531. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
  4532. IF_NOTOK_MDF(fid=RF%ncid)
  4533. ! o define dimensions
  4534. call MDF_Def_Dim( RF%ncid, 'lon' , global_lli(region)%nlon, RF%dimid_lon , status)
  4535. IF_NOTOK_MDF(fid=RF%ncid)
  4536. call MDF_Def_Dim( RF%ncid, 'lat' , global_lli(region)%nlat, RF%dimid_lat , status)
  4537. IF_NOTOK_MDF(fid=RF%ncid)
  4538. call MDF_Def_Dim( RF%ncid, 'time' , n_deps_rec , RF%dimid_time , status)
  4539. IF_NOTOK_MDF(fid=RF%ncid)
  4540. call MDF_Def_Dim( RF%ncid, 'datelen', 6 , RF%dimid_datelen, status)
  4541. IF_NOTOK_MDF(fid=RF%ncid)
  4542. ! o define variables
  4543. call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
  4544. IF_NOTOK_MDF(fid=RF%ncid)
  4545. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4546. IF_NOTOK_MDF(fid=RF%ncid)
  4547. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
  4548. IF_NOTOK_MDF(fid=RF%ncid)
  4549. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'longitude' , status)
  4550. IF_NOTOK_MDF(fid=RF%ncid)
  4551. call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_east', status)
  4552. IF_NOTOK_MDF(fid=RF%ncid)
  4553. RF%varid_lon = varid
  4554. call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
  4555. IF_NOTOK_MDF(fid=RF%ncid)
  4556. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4557. IF_NOTOK_MDF(fid=RF%ncid)
  4558. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
  4559. IF_NOTOK_MDF(fid=RF%ncid)
  4560. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'latitude' , status)
  4561. IF_NOTOK_MDF(fid=RF%ncid)
  4562. call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_north', status)
  4563. IF_NOTOK_MDF(fid=RF%ncid)
  4564. RF%varid_lat = varid
  4565. call MDF_Def_Var( RF%ncid, 'time', mdf_float, (/RF%dimid_time/), varid , status)
  4566. IF_NOTOK_MDF(fid=RF%ncid)
  4567. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4568. IF_NOTOK_MDF(fid=RF%ncid)
  4569. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
  4570. IF_NOTOK_MDF(fid=RF%ncid)
  4571. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'time' , status)
  4572. IF_NOTOK_MDF(fid=RF%ncid)
  4573. call MDF_Put_Att( RF%ncid, varid, 'units' , 'days since 1950-01-01 00:00:00', status)
  4574. IF_NOTOK_MDF(fid=RF%ncid)
  4575. call MDF_Put_Att( RF%ncid, varid, 'calender' , 'gregorian' , status)
  4576. IF_NOTOK_MDF(fid=RF%ncid)
  4577. RF%varid_time = varid
  4578. call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
  4579. IF_NOTOK_MDF(fid=RF%ncid)
  4580. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4581. IF_NOTOK_MDF(fid=RF%ncid)
  4582. call MDF_Put_Att( RF%ncid, varid , 'long_name', 'date and time' , status)
  4583. IF_NOTOK_MDF(fid=RF%ncid)
  4584. call MDF_Put_Att( RF%ncid, varid , 'units' , 'year, month, day, hour, minute, second', status)
  4585. IF_NOTOK_MDF(fid=RF%ncid)
  4586. RF%varid_date = varid
  4587. call MDF_Def_Var( RF%ncid, 'accum', mdf_float , (/RF%dimid_time/) , varid, status)
  4588. IF_NOTOK_MDF(fid=RF%ncid)
  4589. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4590. IF_NOTOK_MDF(fid=RF%ncid)
  4591. call MDF_Put_Att( RF%ncid, varid , 'long_name', 'length of accumulated time interval', status)
  4592. IF_NOTOK_MDF(fid=RF%ncid)
  4593. call MDF_Put_Att( RF%ncid, varid , 'units' , 'second' , status)
  4594. IF_NOTOK_MDF(fid=RF%ncid)
  4595. RF%varid_accum = varid
  4596. allocate( RF%time(n_deps_rec) )
  4597. allocate( RF%date(6,n_deps_rec) )
  4598. allocate( RF%dt(n_deps_rec) )
  4599. ! loop over tracer to be written:
  4600. do k = 1, RF%ntr
  4601. ! global tracer index
  4602. itr = RF%itr(k)
  4603. ! ~~ dry deposition
  4604. ! CF standard name for concentration/mixing ratio/column:
  4605. cf_enti_stnd = 'surface_dry_deposition_mole_flux'
  4606. cf_enti_unit = 'mole m-2 s-1'
  4607. cf_enti_long = 'dry deposition of '
  4608. ! start of dataset name:
  4609. varname_enti = 'dry'
  4610. ! no comment yet
  4611. comment = ''
  4612. ! standard names from CF conventions:
  4613. select case ( RF%name_tr(k) )
  4614. case ( 'CO', 'co' )
  4615. varname_spec = 'co'
  4616. cf_spec_stnd = 'carbon_monoxide'
  4617. cf_spec_long = 'CO'
  4618. case ( 'O3', 'o3' )
  4619. varname_spec = 'o3'
  4620. cf_spec_stnd = 'ozone'
  4621. cf_spec_long = 'O3'
  4622. case ( 'O3s', 'o3s' )
  4623. varname_spec = 'o3s'
  4624. cf_spec_stnd = 'ozone_from_stratosphere'
  4625. cf_spec_long = 'O3s'
  4626. case ( 'NO', 'no' )
  4627. varname_spec = 'no'
  4628. cf_spec_stnd = 'nitrogen_monoxide'
  4629. cf_spec_long = 'NO'
  4630. case ( 'NO2', 'no2' )
  4631. varname_spec = 'no2'
  4632. cf_spec_stnd = 'nitrogen_dioxide'
  4633. cf_spec_long = 'NO2'
  4634. case ( 'NOy', 'noy' )
  4635. varname_spec = 'noy'
  4636. cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
  4637. cf_spec_long = 'NOy'
  4638. comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
  4639. 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
  4640. case ( 'CH2O', 'ch2o', 'CHOH', 'choh' )
  4641. varname_spec = 'ch2o'
  4642. cf_spec_stnd = 'formaldehyde'
  4643. cf_spec_long = 'CH2O'
  4644. case ( 'SO2', 'so2' )
  4645. varname_spec = 'so2'
  4646. cf_spec_stnd = 'sulfur_dioxide'
  4647. cf_spec_long = 'SO2'
  4648. case ( 'CH4', 'ch4' )
  4649. varname_spec = 'ch4'
  4650. cf_spec_stnd = 'methane'
  4651. cf_spec_long = 'CH4'
  4652. case ( 'OH', 'oh' )
  4653. varname_spec = 'oh'
  4654. cf_spec_stnd = 'hydroxyl_radical'
  4655. cf_spec_long = 'OH'
  4656. case ( 'H2O2', 'h2o2' )
  4657. varname_spec = 'h2o2'
  4658. cf_spec_stnd = 'hydrogen_peroxide'
  4659. cf_spec_long = 'H2O2'
  4660. case ( 'HNO3', 'hno3' )
  4661. varname_spec = 'hno3'
  4662. cf_spec_stnd = 'nitric_acid'
  4663. cf_spec_long = 'HNO3'
  4664. case ( 'NH3', 'nh3' )
  4665. varname_spec = 'nh3'
  4666. cf_spec_stnd = 'ammonia'
  4667. cf_spec_long = 'NH3'
  4668. case ( 'ORGNTR','orgntr' )
  4669. varname_spec = 'orgntr'
  4670. cf_spec_stnd = 'organic_nitrate'
  4671. cf_spec_long = 'ORGNTR'
  4672. case ( 'NH4', 'nh4' )
  4673. varname_spec = 'nh4'
  4674. cf_spec_stnd = 'ammonium'
  4675. cf_spec_long = 'NH4'
  4676. case ( 'PAN', 'pan' )
  4677. varname_spec = 'pan'
  4678. cf_spec_stnd = 'peroxyacetyl_nitrate'
  4679. cf_spec_long = 'PAN'
  4680. case ( 'Rn', 'rn', 'Radon', 'radon' )
  4681. varname_spec = 'rn'
  4682. cf_spec_stnd = 'radon'
  4683. cf_spec_long = 'Rn'
  4684. case ( 'Pb', 'pb', 'Lead', 'lead' )
  4685. varname_spec = 'pb'
  4686. cf_spec_stnd = 'lead'
  4687. cf_spec_long = 'Pb'
  4688. case default
  4689. write (gol,'("do not know how to match tracer with CF standard names : ",a)') RF%name_tr(k); call goErr
  4690. TRACEBACK; status=1; return
  4691. end select
  4692. write (varname,'(a,"_",a)') trim(varname_enti), trim(varname_spec)
  4693. ! define variable:
  4694. call MDF_Def_Var( RF%ncid, trim(varname), MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
  4695. IF_NOTOK_MDF(fid=RF%ncid)
  4696. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4697. IF_NOTOK_MDF(fid=RF%ncid)
  4698. ! total names:
  4699. cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)
  4700. cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)
  4701. cf_name_unit = trim(cf_enti_unit)
  4702. ! write attributes:
  4703. call MDF_Put_Att( RF%ncid , varid, 'standard_name' , trim(cf_name_stnd), status)
  4704. IF_NOTOK_MDF(fid=RF%ncid)
  4705. call MDF_Put_Att( RF%ncid , varid, 'long_name' , trim(cf_name_long), status)
  4706. IF_NOTOK_MDF(fid=RF%ncid)
  4707. call MDF_Put_Att( RF%ncid , varid, 'units' , trim(cf_name_unit), status)
  4708. IF_NOTOK_MDF(fid=RF%ncid)
  4709. if ( itr <= ntrace ) then
  4710. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
  4711. IF_NOTOK_MDF(fid=RF%ncid)
  4712. else
  4713. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
  4714. IF_NOTOK_MDF(fid=RF%ncid)
  4715. end if
  4716. call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
  4717. IF_NOTOK_MDF(fid=RF%ncid)
  4718. call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
  4719. IF_NOTOK_MDF(fid=RF%ncid)
  4720. if ( len_trim(comment) > 0 ) then
  4721. call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment) , status)
  4722. IF_NOTOK_MDF(fid=RF%ncid)
  4723. end if
  4724. ! store varid
  4725. RF%varid_ddep(k) = varid
  4726. ! ~~ wet deposition
  4727. if ( RF%with_wdep(k) ) then
  4728. ! CF standard name for concentration/mixing ratio/column:
  4729. cf_enti_stnd = 'surface_wet_deposition_mole_flux'
  4730. cf_enti_unit = 'mole m-2 s-1'
  4731. cf_enti_long = 'wet deposition of '
  4732. ! start of dataset name:
  4733. varname_enti = 'wet'
  4734. ! by default no comment:
  4735. comment = ''
  4736. ! standard names from CF conventions:
  4737. select case ( RF%name_tr(k) )
  4738. case ( 'NOy', 'noy' )
  4739. varname_spec = 'noy'
  4740. cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
  4741. cf_spec_long = 'NOy'
  4742. comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
  4743. 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
  4744. case ( 'HNO3', 'hno3' )
  4745. varname_spec = 'hno3'
  4746. cf_spec_stnd = 'nitric_acid'
  4747. cf_spec_long = 'HNO3'
  4748. case ( 'NH3', 'nh3' )
  4749. varname_spec = 'nh3'
  4750. cf_spec_stnd = 'ammonia'
  4751. cf_spec_long = 'NH3'
  4752. case ( 'NH4', 'nh4' )
  4753. varname_spec = 'nh4'
  4754. cf_spec_stnd = 'ammonium'
  4755. cf_spec_long = 'NH4'
  4756. case ( 'SO2', 'so2' )
  4757. varname_spec = 'so2'
  4758. cf_spec_stnd = 'sulfur_dioxide'
  4759. cf_spec_long = 'SO2'
  4760. case default
  4761. write (gol,'("unsupported tracer name for CF standard name : ",a)') RF%name_tr(k); call goPr
  4762. TRACEBACK; status=1; return
  4763. end select
  4764. write (varname,'(a,"_",a)') trim(varname_enti), trim(varname_spec)
  4765. ! define variable:
  4766. call MDF_Def_Var( RF%ncid, trim(varname), MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
  4767. IF_NOTOK_MDF(fid=RF%ncid)
  4768. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  4769. IF_NOTOK_MDF(fid=RF%ncid)
  4770. ! total names:
  4771. cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)
  4772. cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)
  4773. cf_name_unit = trim(cf_enti_unit)
  4774. ! write attributes:
  4775. call MDF_Put_Att( RF%ncid , varid, 'standard_name' , trim(cf_name_stnd), status)
  4776. IF_NOTOK_MDF(fid=RF%ncid)
  4777. call MDF_Put_Att( RF%ncid , varid, 'long_name' , trim(cf_name_long), status)
  4778. IF_NOTOK_MDF(fid=RF%ncid)
  4779. call MDF_Put_Att( RF%ncid , varid, 'units' , trim(cf_name_unit), status)
  4780. IF_NOTOK_MDF(fid=RF%ncid)
  4781. if ( itr <= ntrace ) then
  4782. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
  4783. IF_NOTOK_MDF(fid=RF%ncid)
  4784. else
  4785. call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
  4786. IF_NOTOK_MDF(fid=RF%ncid)
  4787. end if
  4788. call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
  4789. IF_NOTOK_MDF(fid=RF%ncid)
  4790. call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
  4791. IF_NOTOK_MDF(fid=RF%ncid)
  4792. if ( len_trim(comment) > 0 ) then
  4793. call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment) , status)
  4794. IF_NOTOK_MDF(fid=RF%ncid)
  4795. end if
  4796. ! store varid
  4797. RF%varid_wdep(k) = varid
  4798. end if
  4799. end do
  4800. allocate( RF%data2d_dry(i1:i2, j1:j2, n_deps_rec, RF%ntr) )
  4801. allocate( RF%data2d_wet(i1:i2, j1:j2, n_deps_rec, RF%ntr) )
  4802. ! RF%data2d_dry = 0.
  4803. ! RF%data2d_wet = 0.
  4804. ! o end defintion mode
  4805. call MDF_EndDef( RF%ncid , status)
  4806. IF_NOTOK_MDF(fid=RF%ncid)
  4807. ! o
  4808. ! no records written yet
  4809. RF%trec = 0
  4810. call goLabel()
  4811. ! ok
  4812. status = 0
  4813. end subroutine RF_DEPS_Init
  4814. !EOC
  4815. !--------------------------------------------------------------------------
  4816. ! TM5 !
  4817. !--------------------------------------------------------------------------
  4818. !BOP
  4819. !
  4820. ! !IROUTINE: RF_DEPS_Write
  4821. !
  4822. ! !DESCRIPTION:
  4823. !\\
  4824. !\\
  4825. ! !INTERFACE:
  4826. !
  4827. SUBROUTINE RF_DEPS_Write( RF, region, idate_f, status )
  4828. !
  4829. ! !USES:
  4830. !
  4831. use GO, only : TDate, NewDate, Set, iTotal, rTotal, operator(-), wrtgol
  4832. use Grid, only : AreaOper
  4833. use MeteoData, only : global_lli, levi, lli
  4834. #ifndef without_chemistry
  4835. use ebischeme, only : buddrydep_dat => buddep_dat
  4836. #endif
  4837. #ifndef without_wet_deposition
  4838. use wet_deposition, only : buddep_dat
  4839. #endif
  4840. !
  4841. ! !INPUT/OUTPUT PARAMETERS:
  4842. !
  4843. type(TPdumpFile_DEPS), intent(inout) :: RF
  4844. !
  4845. ! !INPUT PARAMETERS:
  4846. !
  4847. integer, intent(in) :: region
  4848. integer, intent(in) :: idate_f(6)
  4849. !
  4850. ! !OUTPUT PARAMETERS:
  4851. !
  4852. integer, intent(out) :: status
  4853. !
  4854. ! !REVISION HISTORY:
  4855. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  4856. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  4857. !
  4858. !EOP
  4859. !------------------------------------------------------------------------
  4860. !BOC
  4861. character(len=*), parameter :: rname = mname//'/RF_DEPS_Write'
  4862. ! --- local ------------------------------------
  4863. integer :: imr, jmr, lmr
  4864. type(TDate) :: t, t0
  4865. real :: time
  4866. real :: dt_sec
  4867. integer :: k, itr, i1, i2, j1, j2
  4868. real, allocatable :: budget(:,:)
  4869. real, allocatable :: budget_loc(:,:)
  4870. real, allocatable :: depflux(:,:)
  4871. integer :: icomp
  4872. ! --- begin -------------------------------------
  4873. ! for multiple of dhour only ...
  4874. if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
  4875. status=0; return
  4876. end if
  4877. call goLabel(rname)
  4878. ! grid size
  4879. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  4880. imr = i2-i1+1
  4881. jmr = j2-j1+1
  4882. lmr = levi%nlev
  4883. ! temporary storage:
  4884. allocate( budget_loc(imr,jmr) )
  4885. allocate( depflux (imr,jmr) )
  4886. ! next time record:
  4887. RF%trec = RF%trec + 1
  4888. if(okdebug)then
  4889. write(gol,*) "RF_DEPS_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
  4890. end if
  4891. ! time since 1950-1-1 00:00
  4892. t0 = NewDate( time6=time_reftime6 )
  4893. t = NewDate( time6=idate_f )
  4894. time = rTotal( t - t0, 'day' )
  4895. ! length of time interval:
  4896. dt_sec = iTotal( t - RF%t0_budget, 'sec' )
  4897. ! zero time interval ? routine should not have been called ...
  4898. if ( dt_sec == 0 ) then
  4899. write (gol,'("routine called after zero lenght time interval:")'); call goErr
  4900. call wrtgol( ' t0_budget : ', RF%t0_budget ); call goErr
  4901. call wrtgol( ' t : ', t ); call goErr
  4902. !status=1
  4903. TRACEBACK
  4904. end if
  4905. ! reset timer:
  4906. call Set( RF%t0_budget, time6=idate_f )
  4907. !---------------
  4908. ! Write GRID
  4909. !---------------
  4910. if ( RF%trec == 1 ) then
  4911. ! longitudes
  4912. call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
  4913. IF_NOTOK_MDF(fid=RF%ncid)
  4914. ! latitudes
  4915. call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
  4916. IF_NOTOK_MDF(fid=RF%ncid)
  4917. end if
  4918. !---------------
  4919. ! FILL DIAGNOSTIC ARRAYS
  4920. !---------------
  4921. !--------------- time
  4922. rf%time(rf%trec) = time
  4923. rf%date(:,rf%trec) = real(idate_f)
  4924. rf%dt(rf%trec) = dt_sec
  4925. !--------------- dry deposition
  4926. do k = 1, RF%ntr
  4927. ! global tracer index:
  4928. itr = RF%itr(k)
  4929. ! extract current budget
  4930. #ifndef without_chemistry
  4931. if ( itr == iNOy ) then
  4932. ! add contributions of all NOy components:
  4933. budget_loc = 0.0
  4934. do icomp = 1, nNOyt
  4935. budget_loc = budget_loc + buddrydep_dat(region)%dry(:,:,iNOyt(icomp))
  4936. end do
  4937. else
  4938. ! extract budget for requested tracer:
  4939. budget_loc = buddrydep_dat(region)%dry(:,:,itr)
  4940. end if
  4941. #else
  4942. budget_loc = 0.0
  4943. #endif
  4944. ! deposition flux ~ (current budget - previous budget)/dt
  4945. depflux = ( budget_loc - RF%ddep_budget(:,:,k) ) / dt_sec ! mole/s
  4946. call AreaOper( lli(region), depflux, '/', 'm2', status ) ! mole/m2/s
  4947. IF_NOTOK_RETURN(status=1)
  4948. ! save current budget & store record
  4949. RF%ddep_budget(:,:,k) = budget_loc
  4950. rf%data2d_dry(:,:,RF%trec,k)= depflux
  4951. end do
  4952. !--------------- wet deposition
  4953. do k = 1, RF%ntr
  4954. ! skip ?
  4955. if ( .not. RF%with_wdep(k) ) cycle
  4956. ! global tracer index:
  4957. itr = RF%itr(k)
  4958. ! extract current budget
  4959. #ifndef without_wet_deposition
  4960. if ( itr == iNOy ) then
  4961. ! add contributions of all NOy components:
  4962. budget_loc = 0.0
  4963. do icomp = 1, nNOyt
  4964. ! add wet depositions for large scale and convective precip; total column:
  4965. budget_loc = budget_loc + sum(buddep_dat(region)%lsp(:,:,:,iNOyt(icomp)),3) + &
  4966. sum(buddep_dat(region)% cp(:,:,:,iNOyt(icomp)),3)
  4967. end do
  4968. else
  4969. ! extract budget for requested tracer;
  4970. ! add wet depositions for large scale and convective precip; total column:
  4971. budget_loc = sum(buddep_dat(region)%lsp(:,:,:,itr),3) + &
  4972. sum(buddep_dat(region)% cp(:,:,:,itr),3)
  4973. end if
  4974. #else
  4975. budget_loc = 0.0
  4976. #endif
  4977. ! deposition flux ~ (current budget - previous budget)/dt
  4978. depflux = ( budget_loc - RF%wdep_budget(:,:,k) ) / dt_sec ! mole/s
  4979. call AreaOper( lli(region), depflux, '/', 'm2', status ) ! mole/m2/s
  4980. IF_NOTOK_RETURN(status=1)
  4981. ! save current budget & store record
  4982. RF%wdep_budget(:,:,k) = budget_loc
  4983. RF%data2d_wet(:,:,RF%trec,k)= depflux
  4984. end do
  4985. !----------------
  4986. ! WRITE
  4987. !----------------
  4988. if ( RF%trec == n_deps_rec ) then
  4989. call MDF_Put_Var( RF%ncid, RF%varid_time, rf%time, status)
  4990. IF_NOTOK_MDF(fid=RF%ncid)
  4991. call MDF_Put_Var( RF%ncid, RF%varid_date, rf%date, status)
  4992. IF_NOTOK_MDF(fid=RF%ncid)
  4993. ! accumulation interval
  4994. call MDF_Put_Var( RF%ncid, RF%varid_accum, rf%dt , status)
  4995. IF_NOTOK_MDF(fid=RF%ncid)
  4996. ! deposition flux
  4997. do k = 1, RF%ntr
  4998. call MDF_Put_Var( RF%ncid, RF%varid_ddep(k), rf%data2d_dry(:,:,:,k), status, start=(/i1,j1,1/) )
  4999. IF_NOTOK_MDF(fid=RF%ncid)
  5000. if ( .not. RF%with_wdep(k) ) cycle
  5001. call MDF_Put_Var( RF%ncid, RF%varid_wdep(k), rf%data2d_wet(:,:,:,k), status, start=(/i1,j1,1/) )
  5002. IF_NOTOK_MDF(fid=RF%ncid)
  5003. end do
  5004. end if
  5005. !----------------
  5006. ! DONE
  5007. !----------------
  5008. deallocate( budget_loc )
  5009. deallocate( depflux )
  5010. call goLabel()
  5011. status = 0
  5012. END SUBROUTINE RF_DEPS_Write
  5013. !EOC
  5014. !--------------------------------------------------------------------------
  5015. ! TM5 !
  5016. !--------------------------------------------------------------------------
  5017. !BOP
  5018. !
  5019. ! !IROUTINE: RF_DEPS_Done
  5020. !
  5021. ! !DESCRIPTION: close file #5
  5022. !\\
  5023. !\\
  5024. ! !INTERFACE:
  5025. !
  5026. SUBROUTINE RF_DEPS_Done( RF, status )
  5027. !
  5028. ! !INPUT/OUTPUT PARAMETERS:
  5029. !
  5030. type(TPdumpFile_DEPS), intent(inout) :: RF
  5031. !
  5032. ! !OUTPUT PARAMETERS:
  5033. !
  5034. integer, intent(out) :: status
  5035. !
  5036. ! !REVISION HISTORY:
  5037. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  5038. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  5039. !
  5040. !EOP
  5041. !------------------------------------------------------------------------
  5042. !BOC
  5043. character(len=*), parameter :: rname = mname//'/RF_DEPS_Done'
  5044. ! --- begin -------------------------------------
  5045. call goLabel(rname)
  5046. ! close file
  5047. call MDF_Close( RF%ncid , status)
  5048. IF_NOTOK_RETURN(status=1)
  5049. ! clear
  5050. deallocate( RF%ddep_budget )
  5051. deallocate( RF%wdep_budget )
  5052. deallocate( rf%time, rf%date, rf%dt, rf%data2d_dry, rf%data2d_wet )
  5053. call goLabel() ; status = 0
  5054. END SUBROUTINE RF_DEPS_Done
  5055. !EOC
  5056. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  5057. ! FILE #6 : deposition velocities
  5058. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  5059. !--------------------------------------------------------------------------
  5060. ! TM5 !
  5061. !--------------------------------------------------------------------------
  5062. !BOP
  5063. !
  5064. ! !IROUTINE: RF_DEPV_Init
  5065. !
  5066. ! !DESCRIPTION:
  5067. !\\
  5068. !\\
  5069. ! !INTERFACE:
  5070. !
  5071. subroutine RF_DEPV_Init( RF, fdir, model, expid, filetype, region, &
  5072. idate_f, dhour, tracer_names, status )
  5073. !
  5074. ! !USES:
  5075. !
  5076. use Binas, only : xmair
  5077. use GO, only : goReadFromLine, goUpCase
  5078. use GO, only : NewDate
  5079. use dims, only : im, jm
  5080. use chem_param, only : ntrace, names, ra
  5081. use partools, only : MPI_INFO_NULL, localComm
  5082. use MeteoData, only : global_lli, levi
  5083. !
  5084. ! !OUTPUT PARAMETERS:
  5085. !
  5086. type(TPdumpFile_DEPV), intent(out) :: RF
  5087. !
  5088. ! !INPUT PARAMETERS:
  5089. !
  5090. character(len=*), intent(in) :: fdir
  5091. character(len=*), intent(in) :: model
  5092. character(len=*), intent(in) :: expid
  5093. character(len=*), intent(in) :: filetype
  5094. integer, intent(in) :: region
  5095. integer, intent(in) :: idate_f(6)
  5096. integer, intent(in) :: dhour
  5097. character(len=*), intent(in) :: tracer_names
  5098. integer, intent(out) :: status
  5099. !
  5100. ! !REVISION HISTORY:
  5101. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  5102. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  5103. !
  5104. !EOP
  5105. !------------------------------------------------------------------------
  5106. !BOC
  5107. character(len=*), parameter :: rname = mname//'/RF_DEPV_Init'
  5108. ! --- local ------------------------------------
  5109. character(len=256) :: fname
  5110. integer :: varid, i1, i2, j1, j2
  5111. character(len=256) :: trnames
  5112. character(len=8) :: trname, tmname
  5113. integer :: k, itr
  5114. character(len=32) :: varname, varname_enti, varname_spec
  5115. character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
  5116. character(len=64) :: cf_spec_stnd, cf_spec_long
  5117. character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
  5118. character(len=512) :: comment
  5119. ! --- begin -------------------------------------
  5120. call goLabel(rname)
  5121. ! store arguments
  5122. RF%dhour = dhour
  5123. RF%tracer_names = tracer_names
  5124. RF%ntr = 0
  5125. trnames = tracer_names
  5126. ! get dims
  5127. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  5128. n_depv_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, mess='DEPV_Init' )
  5129. if ( n_depv_rec == 0 ) then ! degenerated cases
  5130. depv_apply = .false.
  5131. status=0
  5132. return
  5133. end if
  5134. ! tracer index for requested tracers
  5135. if ( len_trim(trnames) == 0 ) then
  5136. depv_apply = .false.
  5137. write (gol,'("WARNING - NO tracers selected for depositions velocity output!")') ; call goPr
  5138. write (gol,'(" - depv_apply set to False.")' ) ; call goPr
  5139. status=0
  5140. return
  5141. else
  5142. write (gol,'("selected tracers for deposition velocity output:")'); call goPr
  5143. end if
  5144. do
  5145. if ( len_trim(trnames) == 0 ) exit
  5146. ! next number:
  5147. if ( RF%ntr == ntrace ) then
  5148. write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
  5149. TRACEBACK; status=1; return
  5150. end if
  5151. RF%ntr = RF%ntr + 1
  5152. ! extract leading name:
  5153. call goReadFromLine( trnames, trname, status, sep=' ' )
  5154. IF_NOTOK_RETURN(status=1)
  5155. ! store pdump name:
  5156. RF%name_tr(RF%ntr) = trname
  5157. ! convert to tm5 name:
  5158. select case ( trname )
  5159. case ( 'HCHO' ) ; tmname = 'CH2O'
  5160. case ( 'Rn', 'Radon' ) ; tmname = 'Rn222'
  5161. case ( 'Pb', 'Lead' ) ; tmname = 'Pb210'
  5162. case default ; tmname = trname
  5163. end select
  5164. ! loop over all names:
  5165. RF%itr(RF%ntr) = -1
  5166. do itr = 1, ntrace
  5167. ! case indendent match ?
  5168. if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
  5169. write (gol,'(" ",i3," ",a10," (",a10,")",f12.4)') &
  5170. itr, trim(trname), trim(names(itr)), ra(itr); call goPr
  5171. RF%itr(RF%ntr) = itr
  5172. exit
  5173. end if
  5174. end do
  5175. ! not found ?
  5176. if ( RF%itr(RF%ntr) < 0 ) then
  5177. write (gol,'("tracer name not supported:") ') ; call goPr
  5178. write (gol,'(" list all : ",a) ') trim(tracer_names) ; call goPr
  5179. write (gol,'(" list element : ",i3) ') RF%ntr ; call goPr
  5180. write (gol,'(" pdump name : ",a) ') trim(trname) ; call goPr
  5181. write (gol,'(" tm5 name : ",a) ') trim(tmname) ; call goPr
  5182. write (gol,'(" tm5 tracers : ") ') ; call goPr
  5183. do itr = 1, ntrace
  5184. write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
  5185. end do
  5186. TRACEBACK; status=1; return
  5187. end if
  5188. end do
  5189. ! empty file ?
  5190. if ( RF%ntr < 1 ) then
  5191. write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
  5192. TRACEBACK; status=1; return
  5193. end if
  5194. ! o open file
  5195. ! write filename
  5196. write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
  5197. trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
  5198. ! open:
  5199. #ifdef MPI
  5200. ! overwrite existing files (clobber), provide MPI stuff:
  5201. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
  5202. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  5203. if (status/=0) then
  5204. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  5205. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  5206. TRACEBACK; status=1; return
  5207. end if
  5208. #else
  5209. ! overwrite existing files (clobber)
  5210. call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
  5211. IF_NOTOK_RETURN(status=1)
  5212. #endif
  5213. ! o global attributes
  5214. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'volume mixing ratios' , status)
  5215. IF_NOTOK_MDF(fid=RF%ncid)
  5216. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
  5217. IF_NOTOK_MDF(fid=RF%ncid)
  5218. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution), status)
  5219. IF_NOTOK_MDF(fid=RF%ncid)
  5220. call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
  5221. IF_NOTOK_MDF(fid=RF%ncid)
  5222. ! o define dimensions
  5223. call MDF_Def_Dim( RF%ncid, 'lon' , global_lli(region)%nlon, RF%dimid_lon , status)
  5224. IF_NOTOK_MDF(fid=RF%ncid)
  5225. call MDF_Def_Dim( RF%ncid, 'lat' , global_lli(region)%nlat, RF%dimid_lat , status)
  5226. IF_NOTOK_MDF(fid=RF%ncid)
  5227. call MDF_Def_Dim( RF%ncid, 'time' , n_depv_rec , RF%dimid_time , status)
  5228. IF_NOTOK_MDF(fid=RF%ncid)
  5229. call MDF_Def_Dim( RF%ncid, 'datelen', 6 , RF%dimid_datelen, status)
  5230. IF_NOTOK_MDF(fid=RF%ncid)
  5231. ! o define variables
  5232. call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
  5233. IF_NOTOK_MDF(fid=RF%ncid)
  5234. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  5235. IF_NOTOK_MDF(fid=RF%ncid)
  5236. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
  5237. IF_NOTOK_MDF(fid=RF%ncid)
  5238. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'longitude' , status)
  5239. IF_NOTOK_MDF(fid=RF%ncid)
  5240. call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_east', status)
  5241. IF_NOTOK_MDF(fid=RF%ncid)
  5242. RF%varid_lon = varid
  5243. call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
  5244. IF_NOTOK_MDF(fid=RF%ncid)
  5245. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  5246. IF_NOTOK_MDF(fid=RF%ncid)
  5247. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
  5248. IF_NOTOK_MDF(fid=RF%ncid)
  5249. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'latitude' , status)
  5250. IF_NOTOK_MDF(fid=RF%ncid)
  5251. call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_north', status)
  5252. IF_NOTOK_MDF(fid=RF%ncid)
  5253. RF%varid_lat = varid
  5254. call MDF_Def_Var( RF%ncid, 'time', mdf_float, (/RF%dimid_time/), varid , status)
  5255. IF_NOTOK_MDF(fid=RF%ncid)
  5256. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  5257. IF_NOTOK_MDF(fid=RF%ncid)
  5258. call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
  5259. IF_NOTOK_MDF(fid=RF%ncid)
  5260. call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'time' , status)
  5261. IF_NOTOK_MDF(fid=RF%ncid)
  5262. call MDF_Put_Att( RF%ncid, varid, 'units' , 'days since 1950-01-01 00:00:00', status)
  5263. IF_NOTOK_MDF(fid=RF%ncid)
  5264. call MDF_Put_Att( RF%ncid, varid, 'calender' , 'gregorian' , status)
  5265. IF_NOTOK_MDF(fid=RF%ncid)
  5266. RF%varid_time = varid
  5267. allocate( rf%time(n_depv_rec) )
  5268. call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen, RF%dimid_time/), varid , status)
  5269. IF_NOTOK_MDF(fid=RF%ncid)
  5270. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  5271. IF_NOTOK_MDF(fid=RF%ncid)
  5272. call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
  5273. IF_NOTOK_MDF(fid=RF%ncid)
  5274. call MDF_Put_Att( RF%ncid, varid, 'units' , 'year, month, day, hour, minute, second' , status)
  5275. IF_NOTOK_MDF(fid=RF%ncid)
  5276. RF%varid_date = varid
  5277. allocate( rf%date(6,n_depv_rec) )
  5278. ! loop over tracer to be written:
  5279. do k = 1, RF%ntr
  5280. ! global tracer index
  5281. itr = RF%itr(k)
  5282. ! CF standard name for concentration/mixing ratio/column:
  5283. cf_enti_stnd = 'surface_dry_deposition_velocity_due_to_turbulence'
  5284. cf_enti_unit = 'mole m-2 s-1'
  5285. cf_enti_long = 'dry deposition of '
  5286. ! start of dataset name:
  5287. varname_enti = 'ddepvel'
  5288. ! by default no comment:
  5289. comment = ''
  5290. ! standard names from CF conventions:
  5291. select case ( RF%name_tr(k) )
  5292. case ( 'CO', 'co' )
  5293. varname_spec = 'co'
  5294. cf_spec_stnd = 'carbon_monoxide'
  5295. cf_spec_long = 'CO'
  5296. case ( 'O3', 'o3' )
  5297. varname_spec = 'o3'
  5298. cf_spec_stnd = 'ozone'
  5299. cf_spec_long = 'O3'
  5300. case ( 'O3s', 'o3s' )
  5301. varname_spec = 'o3s'
  5302. cf_spec_stnd = 'ozone_from_stratosphere'
  5303. cf_spec_long = 'O3s'
  5304. case ( 'NO', 'no' )
  5305. varname_spec = 'no'
  5306. cf_spec_stnd = 'nitrogen_monoxide'
  5307. cf_spec_long = 'NO'
  5308. case ( 'NO2', 'no2' )
  5309. varname_spec = 'no2'
  5310. cf_spec_stnd = 'nitrogen_dioxide'
  5311. cf_spec_long = 'NO2'
  5312. case ( 'NOy', 'noy' )
  5313. varname_spec = 'noy'
  5314. cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
  5315. cf_spec_long = 'NOy'
  5316. comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
  5317. 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
  5318. case ( 'CH2O', 'ch2o', 'CHOH', 'choh' )
  5319. varname_spec = 'ch2o'
  5320. cf_spec_stnd = 'formaldehyde'
  5321. cf_spec_long = 'CH2O'
  5322. case ( 'SO2', 'so2' )
  5323. varname_spec = 'so2'
  5324. cf_spec_stnd = 'sulfur_dioxide'
  5325. cf_spec_long = 'SO2'
  5326. case ( 'CH4', 'ch4' )
  5327. varname_spec = 'ch4'
  5328. cf_spec_stnd = 'methane'
  5329. cf_spec_long = 'CH4'
  5330. case ( 'OH', 'oh' )
  5331. varname_spec = 'oh'
  5332. cf_spec_stnd = 'hydroxyl_radical'
  5333. cf_spec_long = 'OH'
  5334. case ( 'H2O2', 'h2o2' )
  5335. varname_spec = 'h2o2'
  5336. cf_spec_stnd = 'hydrogen_peroxide'
  5337. cf_spec_long = 'H2O2'
  5338. case ( 'HNO3', 'hno3' )
  5339. varname_spec = 'hno3'
  5340. cf_spec_stnd = 'nitric_acid'
  5341. cf_spec_long = 'HNO3'
  5342. case ( 'PAN', 'pan' )
  5343. varname_spec = 'pan'
  5344. cf_spec_stnd = 'peroxyacetyl_nitrate'
  5345. cf_spec_long = 'PAN'
  5346. case ( 'Rn', 'rn', 'Radon', 'radon' )
  5347. varname_spec = 'rn'
  5348. cf_spec_stnd = 'radon'
  5349. cf_spec_long = 'Rn'
  5350. case ( 'Pb', 'pb', 'Lead', 'lead' )
  5351. varname_spec = 'pb'
  5352. cf_spec_stnd = 'lead'
  5353. cf_spec_long = 'Pb'
  5354. case ( 'NH3', 'nh3' )
  5355. varname_spec = 'nh3'
  5356. cf_spec_stnd = 'ammonia'
  5357. cf_spec_long = 'NH3'
  5358. case ( 'NH4', 'nh4' )
  5359. varname_spec = 'nh4'
  5360. cf_spec_stnd = 'ammonium'
  5361. cf_spec_long = 'NH4'
  5362. case default
  5363. write (gol,'("unsupported tracer name for CF standard name : ",a)') RF%name_tr(k); call goPr
  5364. TRACEBACK; status=1; return
  5365. end select
  5366. write (varname,'(a,"_",a)') trim(varname_enti), trim(varname_spec)
  5367. write (gol,'(" varname : ",a)') trim(varname); call goPr
  5368. ! define variable:
  5369. call MDF_Def_Var( RF%ncid, trim(varname), MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
  5370. IF_NOTOK_MDF(fid=RF%ncid)
  5371. call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
  5372. IF_NOTOK_MDF(fid=RF%ncid)
  5373. ! total names:
  5374. cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)
  5375. cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)
  5376. cf_name_unit = trim(cf_enti_unit)
  5377. ! write attributes:
  5378. call MDF_Put_Att( RF%ncid , varid, 'standard_name' , trim(cf_name_stnd), status)
  5379. IF_NOTOK_MDF(fid=RF%ncid)
  5380. call MDF_Put_Att( RF%ncid , varid, 'long_name' , trim(cf_name_long), status)
  5381. IF_NOTOK_MDF(fid=RF%ncid)
  5382. call MDF_Put_Att( RF%ncid , varid, 'units' , trim(cf_name_unit), status)
  5383. IF_NOTOK_MDF(fid=RF%ncid)
  5384. call MDF_Put_Att( RF%ncid , varid, 'moleweight_tracer', ra(itr)*1e3 , status)
  5385. IF_NOTOK_MDF(fid=RF%ncid)
  5386. call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
  5387. IF_NOTOK_MDF(fid=RF%ncid)
  5388. call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
  5389. IF_NOTOK_MDF(fid=RF%ncid)
  5390. if ( len_trim(comment) > 0 ) then
  5391. call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment) , status)
  5392. IF_NOTOK_MDF(fid=RF%ncid)
  5393. end if
  5394. ! store varid
  5395. RF%varid_tr(k) = varid
  5396. end do
  5397. allocate( rf%data2d(i1:i2, j1:j2, n_depv_rec, rf%ntr) )
  5398. ! o end defintion mode
  5399. call MDF_EndDef( RF%ncid , status)
  5400. IF_NOTOK_MDF(fid=RF%ncid)
  5401. ! o
  5402. ! no records written yet
  5403. RF%trec = 0
  5404. call goLabel() ; status = 0
  5405. END SUBROUTINE RF_DEPV_Init
  5406. !EOC
  5407. !--------------------------------------------------------------------------
  5408. ! TM5 !
  5409. !--------------------------------------------------------------------------
  5410. !BOP
  5411. !
  5412. ! !IROUTINE: RF_DEPV_Write
  5413. !
  5414. ! !DESCRIPTION:
  5415. !\\
  5416. !\\
  5417. ! !INTERFACE:
  5418. !
  5419. SUBROUTINE RF_DEPV_Write( RF, region, idate_f, status )
  5420. !
  5421. ! !USES:
  5422. !
  5423. use GO, only : TDate, NewDate, Set, iTotal, rTotal, operator(-), wrtgol
  5424. use Grid, only : AreaOper
  5425. use MeteoData, only : global_lli
  5426. #ifndef without_dry_deposition
  5427. use dry_deposition, only : vd
  5428. #endif
  5429. !
  5430. ! !INPUT/OUTPUT PARAMETERS:
  5431. !
  5432. type(TPdumpFile_DEPV), intent(inout) :: RF
  5433. !
  5434. ! !INPUT PARAMETERS:
  5435. !
  5436. integer, intent(in) :: region
  5437. integer, intent(in) :: idate_f(6)
  5438. !
  5439. ! !OUTPUT PARAMETERS:
  5440. !
  5441. integer, intent(out) :: status
  5442. !
  5443. ! !REVISION HISTORY:
  5444. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  5445. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  5446. !
  5447. !EOP
  5448. !------------------------------------------------------------------------
  5449. !BOC
  5450. character(len=*), parameter :: rname = mname//'/RF_DEPV_Write'
  5451. ! --- local ------------------------------------
  5452. integer :: imr, jmr
  5453. type(TDate) :: t, t0
  5454. real :: time
  5455. integer :: k, itr, i1, i2, j1, j2
  5456. real, allocatable :: depvel(:,:)
  5457. ! --- begin -------------------------------------
  5458. ! for multiple of dhour only ...
  5459. if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
  5460. status=0; return
  5461. end if
  5462. call goLabel(rname)
  5463. ! grid size
  5464. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  5465. imr=i2-i1+1
  5466. jmr=j2-j1+1
  5467. ! next time record:
  5468. RF%trec = RF%trec + 1
  5469. if(okdebug)then
  5470. write(gol,*) "RF_DEPV_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
  5471. end if
  5472. ! time since 1950-1-1 00:00
  5473. t0 = NewDate( time6=time_reftime6 )
  5474. t = NewDate( time6=idate_f )
  5475. time = rTotal( t - t0, 'day' )
  5476. ! Only once : Dimensions
  5477. if ( RF%trec == 1 ) then
  5478. ! write longitudes:
  5479. call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
  5480. IF_NOTOK_MDF(fid=RF%ncid)
  5481. ! write latitudes:
  5482. call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
  5483. IF_NOTOK_MDF(fid=RF%ncid)
  5484. end if
  5485. !-------- FILL DIAGNOSTIC ARRAYS
  5486. rf%time(rf%trec) = time
  5487. rf%date(:,rf%trec) = real(idate_f)
  5488. ! loop over tracers to be written:
  5489. do k = 1, RF%ntr
  5490. itr = RF%itr(k) ! global tracer index
  5491. #ifndef without_dry_deposition
  5492. rf%data2d(:,:,RF%trec,k) = vd(region,itr)%surf ! deposition velocity
  5493. #else
  5494. rf%data2d(:,:,RF%trec,k) = 0.0
  5495. #endif
  5496. end do
  5497. !-------- WRITE
  5498. if ( RF%trec == n_depv_rec ) then
  5499. call MDF_Put_Var( RF%ncid, RF%varid_time, rf%time, status)
  5500. IF_NOTOK_MDF(fid=RF%ncid)
  5501. call MDF_Put_Var( RF%ncid, RF%varid_date, rf%date, status)
  5502. IF_NOTOK_MDF(fid=RF%ncid)
  5503. ! loop over tracers to be written:
  5504. do k = 1, RF%ntr
  5505. call MDF_Put_Var( RF%ncid, RF%varid_tr(k), rf%data2d(:,:,:,k), status, start=(/i1,j1,1/))
  5506. IF_NOTOK_MDF(fid=RF%ncid)
  5507. end do
  5508. end if
  5509. call goLabel()
  5510. status = 0
  5511. END SUBROUTINE RF_DEPV_Write
  5512. !EOC
  5513. !--------------------------------------------------------------------------
  5514. ! TM5 !
  5515. !--------------------------------------------------------------------------
  5516. !BOP
  5517. !
  5518. ! !IROUTINE: RF_DEPV_Done
  5519. !
  5520. ! !DESCRIPTION:
  5521. !\\
  5522. !\\
  5523. ! !INTERFACE:
  5524. !
  5525. SUBROUTINE RF_DEPV_Done( RF, status )
  5526. !
  5527. ! !INPUT/OUTPUT PARAMETERS:
  5528. !
  5529. type(TPdumpFile_DEPV), intent(inout) :: RF
  5530. !
  5531. ! !OUTPUT PARAMETERS:
  5532. !
  5533. integer, intent(out) :: status
  5534. !
  5535. ! !REVISION HISTORY:
  5536. ! 1 Oct 2010 - Achim Strunk - retro -> pdump
  5537. ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
  5538. !
  5539. !EOP
  5540. !------------------------------------------------------------------------
  5541. !BOC
  5542. character(len=*), parameter :: rname = mname//'/RF_DEPV_Done'
  5543. ! --- begin -------------------------------------
  5544. call goLabel(rname)
  5545. ! close file
  5546. call MDF_Close( RF%ncid , status)
  5547. IF_NOTOK_RETURN(status=1)
  5548. deallocate( rf%time, rf%date, rf%data2d )
  5549. call goLabel() ; status = 0
  5550. END SUBROUTINE RF_DEPV_Done
  5551. !EOC
  5552. #endif
  5553. !--------------------------------------------------------------------------
  5554. ! TM5 !
  5555. !--------------------------------------------------------------------------
  5556. !BOP
  5557. !
  5558. ! !FUNCTION: strlowercase
  5559. !
  5560. ! !DESCRIPTION:
  5561. !
  5562. ! This function returns a copy of the input string 'struppercase' with all
  5563. ! letters changed to lowercase. All other characters remain unchanged.
  5564. !\\
  5565. !\\
  5566. ! !INTERFACE:
  5567. !
  5568. FUNCTION strlowercase(struppercase)
  5569. !
  5570. ! !USES:
  5571. !
  5572. IMPLICIT NONE
  5573. !
  5574. ! !INPUT PARAMETERS:
  5575. !
  5576. CHARACTER(LEN=*), INTENT(IN) :: struppercase
  5577. !
  5578. ! !RETURN VALUE:
  5579. !
  5580. CHARACTER(LEN=LEN(struppercase)) :: strlowercase
  5581. !
  5582. ! !REVISION HISTORY:
  5583. ! 1 Oct 2010 - Achim Strunk -
  5584. !
  5585. !EOP
  5586. !------------------------------------------------------------------------
  5587. !BOC
  5588. CHARACTER(LEN=1) :: u
  5589. INTEGER :: i,j
  5590. strlowercase = struppercase
  5591. DO i=1,LEN(struppercase)
  5592. u = struppercase(i:i)
  5593. j = IACHAR(u)
  5594. IF(j < 65 .OR. j > 90) CYCLE
  5595. strlowercase(i:i) = ACHAR(j+32)
  5596. END DO
  5597. !-------------------------------------------------------------------------------
  5598. END FUNCTION STRLOWERCASE
  5599. !EOC
  5600. !--------------------------------------------------------------------------
  5601. ! TM5 !
  5602. !--------------------------------------------------------------------------
  5603. !BOP
  5604. !
  5605. ! !FUNCTION: struppercase
  5606. !
  5607. ! !DESCRIPTION:
  5608. !
  5609. ! This function returns a copy of the input string 'struppercase' with all
  5610. ! letters changed to lowercase. All other characters remain unchanged.
  5611. !\\
  5612. !\\
  5613. ! !INTERFACE:
  5614. !
  5615. FUNCTION STRUPPERCASE(strlowercase)
  5616. !
  5617. ! !USES:
  5618. !
  5619. IMPLICIT NONE
  5620. !
  5621. ! !INPUT PARAMETERS:
  5622. !
  5623. CHARACTER(LEN=*), INTENT(IN) :: strlowercase
  5624. !
  5625. ! !RETURN VALUE:
  5626. !
  5627. CHARACTER(LEN=LEN(strlowercase)) :: struppercase
  5628. !
  5629. ! !REVISION HISTORY:
  5630. ! 1 Oct 2010 - Achim Strunk -
  5631. !
  5632. !EOP
  5633. !------------------------------------------------------------------------
  5634. !BOC
  5635. CHARACTER(LEN=1) :: u
  5636. INTEGER :: i,j
  5637. struppercase = strlowercase
  5638. DO i=1,LEN(strlowercase)
  5639. u = strlowercase(i:i)
  5640. j = IACHAR(u)
  5641. IF(j < 97 .OR. j > 122) CYCLE
  5642. struppercase(i:i) = ACHAR(j-32)
  5643. END DO
  5644. !-------------------------------------------------------------------------------
  5645. END FUNCTION STRUPPERCASE
  5646. !EOC
  5647. END MODULE USER_OUTPUT_PDUMP