user_output_pdump__co2.F90 233 KB

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