1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631 |
- #define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') rname, __FILE__, __LINE__ ; call goErr
- #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
- #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
- #define IF_NOTOK_MDF(action) if (status/=0) then; TRACEBACK; action; call MDF_CLose(fid,status); status=1; return; end if
- !
- #include "tm5.inc"
- !-----------------------------------------------------------------------------
- ! TM5 !
- !-----------------------------------------------------------------------------
- !BOP
- !
- ! !MODULE: USER_OUTPUT_PDUMP
- !
- ! !DESCRIPTION:
- !
- ! Module to deal with time-series output. Output are in NetCDF-4 and use CF
- ! conventions. The following output are available:
- !
- ! - one file with grid definition
- ! - one file with time series of some met fields (pressure, temperature, winds, ...)
- ! - one or more files with time series of some tracers
- ! - one or two files with Local Time output for some tracers
- ! - one file with time series of wet and dry depositions
- ! - one file with time series of deposition velocity
- !
- ! If the macro (cpp) "tropomi" is used, then the temperature and extra attributes added to the vmr (tracers) datasets.
- !
- ! Activation, tracers to account for, time step of the series, are set in the
- ! rcfile, following this template :
- !
- !
- ! SAMPLE RCFILE
- !
- ! output.pdump : T
- ! output.pdump.dataset.author : John Doe
- ! output.pdump.dataset.institution : MyFirm, Anytown, USA
- ! output.pdump.dataset.version : GEMS GRG; era2003 simulation
- ! tropomi only:
- ! output.pdump.tropomi.tm5version : v4
- ! output.pdump.tropomi.institution : KNMI
- ! output.pdump.tropomi.tm5reference : Huijnen et al., ACP
- ! output.pdump.tropomi.authoremail : Doe@john.com
- ! output.pdump.tropomi.datasetname : "S5P_AUX_CTMFCT" or "S5P_AUX_CTMANA"
- !
- ! output.pdump.fname.model : TM5
- ! output.pdump.fname.expid : V2
- ! output.pdump.fname.grid.300x200 : 3x2 ! short name, required if there is zoom regions
- ! output.pdump.fname.grid.100x100 : 1x1
- !
- ! output.pdump.griddef.apply : T
- !
- ! output.pdump.tp.apply : T
- ! output.pdump.tp.dhour : 1
- !
- ! output.pdump.vmr.n : 3
- !
- ! output.pdump.vmr.001.apply : T
- ! output.pdump.vmr.001.fname : vmr3
- ! output.pdump.vmr.001.dhour : 3
- ! output.pdump.vmr.001.tracers : SO2 NOy CH4 OH HNO3 PAN H2O2 Radon Lead
- !
- ! output.pdump.vmr.002.apply : T
- ! output.pdump.vmr.002.fname : vmr1
- ! output.pdump.vmr.002.dhour : 1
- ! output.pdump.vmr.002.tracers : O3 O3s CO NO2 NO CH2O
- !
- ! output.pdump.vmr.003.apply : F
- ! output.pdump.vmr.003.fname : vmra
- ! output.pdump.vmr.003.dhour : 3
- ! 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
- !
- ! output.pdump.lt.apply : T
- ! output.pdump.lt.tracers : O3
- ! output.pdump.lt.localtime : 2
- !
- ! output.pdump.lt2.apply : F
- ! output.pdump.lt2.tracers :
- ! output.pdump.lt2.localtime :
- !
- ! output.pdump.depositions.apply : F
- ! output.pdump.depositions.dhour : 3
- ! output.pdump.depositions.tracers : O3 HNO3 NO NO2 H2O2 CH2O PAN CO NH3 NH4 SO2 NOy
- !
- ! output.pdump.depvels.apply : F
- ! output.pdump.depvels.dhour : 3
- ! output.pdump.depvels.tracers : O3 HNO3 NO NO2 H2O2 CH2O PAN CO NH3 NH4 SO2
- !
- !\\
- !\\
- ! !INTERFACE:
- !
- MODULE USER_OUTPUT_PDUMP
- !
- ! !USES:
- !
- use partools, only : isRoot
- use GO, only : gol, goPr, goErr, goLabel
- use GO, only : TDate, IncrDate, NewDate
- use GO, only : operator(+), SystemDate, Get
- use dims, only : nregions, idatee, idatei, okdebug, nread
- use chem_param, only : ntrace
- use chem_param, only : iNOx, iHNO3, iPAN, iOrgNtr
- #ifdef with_m7
- use chem_param, only : iNO3_a
- use chem_param, only : iSO4nus, iSO4ais, iSO4acs, iSO4cos
- use chem_param, only : iBCais, iBCacs, iBCcos, iBCaii
- use chem_param, only : iPOMais, iPOMacs, iPOMcos, iPOMaii
- use chem_param, only : iDUacs, iDUcos, iDUaci, iDUcoi
- use chem_param, only : iSScos, iSSacs
- #endif
-
- USE MDF
- USE TM5_DISTGRID, only : dgrid, Get_DistGrid, update_halo
-
- IMPLICIT NONE
- PRIVATE
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- !
- public :: Output_PDUMP_Init
- public :: Output_PDUMP_Step
- public :: Output_PDUMP_Done
- !
- ! !PRIVATE DATA MEMBERS:
- !
- character(len=*), parameter :: mname = 'user_output_pdump'
- character(len=*), parameter :: outfileversnr = '0.1'
- integer, parameter :: time_reftime6(6) = (/1950,01,01,00,00,00/) ! reference time
- character(len=*), parameter :: time_units = 'days since 1950-01-01 00:00:00'
- !
- ! NOy is not a standard tracer field, but sum of some transported tracers:
- ! NOx HNO3 PAN orgntr NO3_a
- ! where NOx is the sum of short lived tracers:
- ! NOx = NO + NO2 + NO3 + HNO4 + 2*N2O5
- !
- #ifdef with_m7
- integer, parameter :: iNOy = ntrace + 1
- integer, parameter :: nNOyt = 5
- integer, parameter :: iNOyt(nNOyt) = (/ iNOx, iHNO3, iNO3_a, iPAN, iOrgNtr /)
- integer, parameter :: iSO4 = ntrace + 2
- integer, parameter :: nSO4t = 4
- integer, parameter :: iSO4t(nSO4t) = (/ iSO4nus, iSO4ais, iSO4acs, iSO4cos /)
- integer, parameter :: iBC = ntrace + 3
- integer, parameter :: nBCt = 4
- integer, parameter :: iBCt(nBCt) = (/ iBCais, iBCacs, iBCcos, iBCaii /)
- integer, parameter :: iPOM = ntrace + 4
- integer, parameter :: nPOMt = 4
- integer, parameter :: iPOMt(nPOMt) = (/ iPOMais, iPOMacs, iPOMcos, iPOMaii /)
- integer, parameter :: iSS = ntrace + 5
- integer, parameter :: nSSt = 2
- integer, parameter :: iSSt(nSSt) = (/ iSSacs, iSScos /)
- integer, parameter :: iDU = ntrace + 6
- integer, parameter :: nDUt = 4
- integer, parameter :: iDUt(nDUt) = (/ iDUacs, iDUcos, iDUaci, iDUcoi /)
- #else
- integer, parameter :: iNOy = ntrace + 1
- integer, parameter :: nNOyt = 4
- integer, parameter :: iNOyt(nNOyt) = (/ iNOx, iHNO3, iPAN, iOrgNtr /)
- #endif
- !
- ! !PRIVATE TYPES:
- !
- type TPdumpFile_GridDef
- integer :: trec
- integer :: ncid
- integer :: dimid_scalar, dimid_lon, dimid_lat, dimid_lev, dimid_levi
- integer :: varid_lon, varid_lat, varid_time, varid_date
- integer :: varid_gridbox_area
- integer :: varid_a, varid_b
- integer :: varid_a_bnds, varid_b_bnds
- integer :: varid_p0
- !integer :: varid_ps
- !integer :: varid_geo_height
- end type TPdumpFile_GridDef
- type TPdumpFile_TP
- integer :: trec
- integer :: dhour
- integer :: ncid
- integer :: dimid_lon, dimid_lat, dimid_lev, dimid_time, dimid_datelen
- integer :: varid_lon, varid_lat, varid_lev, varid_time, varid_date
- integer :: varid_ps
- integer :: varid_surface_temp
- integer :: varid_orog
- integer :: varid_geop
- integer :: varid_pressure
- integer :: varid_temp
- integer :: varid_humid
- integer :: varid_u, varid_v, varid_w
- real, allocatable :: data3d(:,:,:,:,:)
- real, allocatable :: data2d(:,:,:,:)
- real, allocatable :: time(:)
- real, allocatable :: date(:,:)
- end type TPdumpFile_TP
- type TPdumpFile_VMR
- integer :: trec, n_rec
- logical :: apply
- real :: dhour
- integer :: dsec
- character(len=256) :: tracer_names
- integer :: ncid
- integer :: dimid_lon, dimid_lat, dimid_lev, dimid_levi, dimid_time, dimid_datelen
- integer :: varid_lon, varid_lat, varid_lev, varid_time, varid_date
- integer :: varid_ps
- integer :: varid_a_bnds, varid_b_bnds
- integer :: ntr
- integer :: itr(ntrace)
- character(len=8) :: name_tr(ntrace)
- #ifdef with_m7
- logical :: lpmx(ntrace)
- real :: sizepmx(ntrace)
- #endif
- integer :: varid_tr(ntrace)
- character(len=4) :: varid_type(ntrace)
- real, allocatable :: data3d(:,:,:,:,:)
- real, allocatable :: sp(:,:,:)
- real, allocatable :: time(:)
- real, allocatable :: date(:,:)
- real, allocatable :: data3d_t(:,:,:,:)
- integer :: varid_temp
- #ifdef tropomi
- integer :: varid_hyai, varid_hybi, varid_hyam, varid_hybm
- integer :: varid_hgt
- integer :: varid_ltropo
- real, allocatable :: data2d_hgt(:,:)
- integer, allocatable:: data2d_ltropo(:,:,:)
- #endif
- end type TPdumpFile_VMR
- type TPdumpFile_LT
- integer :: trec
- character(len=256) :: tracer_names
- integer :: ncid
- integer :: local_time
- integer :: dimid_lon, dimid_lat, dimid_lev, dimid_time, dimid_datelen
- integer :: varid_lon, varid_lat, varid_lev, varid_time, varid_date
- integer :: varid_ps
- integer :: ntr
- integer :: itr(ntrace)
- character(len=8) :: name_tr(ntrace)
- integer :: varid_tr(ntrace)
- real,allocatable :: accu(:,:,:,:)
- real,allocatable :: naccu(:,:)
- real,allocatable :: p_accu(:,:)
- real,allocatable :: np_accu(:)
- #ifdef with_m7
- logical :: laod(ntrace)
- real :: wavel(ntrace)
- #endif
- end type TPdumpFile_LT
- type TPdumpFile_DEPS
- integer :: trec
- integer :: dhour
- character(len=256) :: tracer_names
- integer :: ncid
- integer :: dimid_lon, dimid_lat, dimid_time, dimid_datelen
- integer :: varid_lon, varid_lat, varid_time, varid_date, varid_accum
- integer :: ntr
- integer :: itr(ntrace)
- character(len=8) :: name_tr(ntrace)
- integer :: varid_ddep(ntrace)
- real, pointer :: ddep_budget(:,:,:)
- logical :: with_wdep(ntrace)
- integer :: varid_wdep(ntrace)
- real, pointer :: wdep_budget(:,:,:)
- type(TDate) :: t0_budget
- real, allocatable :: data2d_dry(:,:,:,:)
- real, allocatable :: data2d_wet(:,:,:,:)
- real, allocatable :: time(:), dt(:)
- real, allocatable :: date(:,:)
- end type TPdumpFile_DEPS
- type TPdumpFile_DEPV
- integer :: trec
- integer :: dhour
- character(len=256) :: tracer_names
- integer :: ncid
- integer :: dimid_lon, dimid_lat, dimid_time, dimid_datelen
- integer :: varid_lon, varid_lat, varid_time, varid_date
- integer :: ntr
- integer :: itr(ntrace)
- character(len=8) :: name_tr(ntrace)
- integer :: varid_tr(ntrace)
- real, allocatable :: data2d(:,:,:,:)
- real, allocatable :: time(:)
- real, allocatable :: date(:,:)
- end type TPdumpFile_DEPV
- ! --- var -----------------------------
- integer :: fid ! file id for IF_NOTOK_MDF macro
- integer :: access_mode ! netcdf-4 access mode
- integer :: curr_day(nregions,3)
- logical :: firstday
- logical :: lastday ! it is last day and not a full day (ie day does not end at 00 of next day)
- character(len=32) :: fname_model
- character(len=8) :: fname_expid, meteo_class
- character(len=32) :: fname_grid(nregions)
- character(len=256) :: dataset_author, institution, dataset_version
- #ifdef tropomi
- character(len=256) :: tropomi_authoremail, tropomi_tm5_reference, tropomi_institution
- character(len=256) :: tropomi_tm5_version, tropomi_dataset_name
- character(len=15) :: tropomi_date_start, tropomi_date_stop, tropomi_date_create
- #endif
- logical, save :: griddef_apply
- type(TPdumpFile_GridDef), save :: RF_GridDef(nregions)
- logical, save :: tp_apply
- integer :: tp_dhour, n_tp_rec
- type(TPdumpFile_TP), save :: RF_TP(nregions)
- integer, save :: nvmr
- logical, allocatable :: vmr_apply(:)
- real, allocatable :: vmr_sregbord(:,:)
- character(len=16), allocatable :: vmr_fname(:)
- real, allocatable :: vmr_dhour(:)
- character(len=256), allocatable :: vmr_tracer_names(:)
- type(TPdumpFile_VMR), allocatable, save :: RF_VMR(:,:)
- logical, save :: lt_apply
- character(len=16) :: lt_fname
- character(len=256) :: lt_tracer_names
- integer :: lt_localtime
- type(TPdumpFile_LT), save :: RF_LT(nregions)
- logical, save :: lt2_apply
- character(len=16) :: lt2_fname
- character(len=256) :: lt2_tracer_names
- integer :: lt2_localtime
- type(TPdumpFile_LT), save :: RF_LT2(nregions)
- logical, save :: deps_apply
- character(len=16) :: deps_fname
- integer :: deps_dhour, n_deps_rec
- character(len=256) :: deps_tracer_names
- type(TPdumpFile_DEPS), save :: RF_DEPS(nregions)
- logical, save :: depv_apply
- character(len=16) :: depv_fname
- integer :: depv_dhour, n_depv_rec
- character(len=256) :: depv_tracer_names
- type(TPdumpFile_DEPV), save :: RF_DEPV(nregions)
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - revised older RETRO ouptut :
- ! add 2nd local time, regional output,
- ! handle aerosol tracers and M7
- ! 10 Jul 2012 - Ph. Le Sager - switch from pnetcdf to netcdf4_par (through
- ! MDF); get rid of the with_tendencies code.
- ! 12 Nov 2012 - Ph. Le Sager - adapted for lon-lat MPI decomposition.
- ! - get rid of unlimited dimensions so we can
- ! write in collective mode.
- ! - store series to write them only at end-of-day
- ! to speed-up code
- ! 10 Oct 2013 - Ph. Le Sager - fixed GET_N_TIME_RECORDS and several 'init'
- ! and write' routines.
- ! 14 Apr 2014 - Ph. Le Sager + JEW - tropomi add-ons in VMR: Temperature,
- ! As, Bs, better CF
- ! 8 October 2014 - H. Eskes - changes in tropomi output (based on the "tropomi" macro)
- !
- ! !REMARKS:
- !
- ! (1) Initially called RETRO output for GEMS GRG, the module has been adapted
- ! for CLIMAQS project and renamed PDUMP.
- ! (2) Previous remarks "as is":
- ! - longitudes from [0,360] ?
- ! this is imposible for zoom area's such as for the heatwave
- ! - levels from surface to top
- ! - time from 1950-01-01 00:00
- ! (3) This is supposed to work with netcdf4_parallel. You cannot use
- ! MPI with a non-parallel version of netcdf4 here.
- ! (4) The parallel writing is done in COLLECTIVE mode, but remain
- ! expensive on some system. Possible optimization : output one file
- ! per month (chunk/leg), and/or per field, and/or per processor.
- ! (5) Switch in nstep for DEPS data should work for full days. Not tested
- ! for partial days.
- !
- ! !TODO:
- ! - test with M7 tracers. Which ones?
- ! - in LT_WRITE : AOD if m7 needs to be coded
- ! - in RF_VMR_INIT : match tracer with CF standard names for some aerosols
- ! (dust,...)
- !
- !EOP
- !------------------------------------------------------------------------
- CONTAINS
-
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !FUNCTION: GET_N_TIME_RECORDS
- !
- ! !DESCRIPTION: return number of time steps for a daily timeseries file
- !\\
- !\\
- ! !INTERFACE:
- !
- FUNCTION GET_N_TIME_RECORDS( date, dsec, isDEPS, mess )
- !
- ! !USES:
- !
- USE GO , only : TDate, NewDate, rTotal, operator(-)
- !
- ! !RETURN VALUE:
- !
- integer :: get_n_time_records
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: date(6) ! 1st time step of the day (timestart basically)
- integer, intent(in) :: dsec ! time step for timeseries in sec (should divide 24*3600, be divided by ndyn/2)
- logical, optional, intent(in) :: isDEPS ! to differentiate b/w DEPS and others
- character(len=*), optional, intent(in) :: mess ! message (if okdebug)
- !
- ! !REVISION HISTORY:
- ! 9 Nov 2012 - Ph. Le Sager - v0
- ! 9 Oct 2013 - Ph. Le Sager - fix to work with default "output.after.step: v"
- ! 15 Jul 2014 - Ph. Le Sager - works with seconds instead of hours
- !
- ! !REMARKS:
- ! - dynamic timestep cannot be LARGER than timestep of timeseries, with notable exception
- ! of dynamic timestep = 2*timeseries_timestep.
- !
- ! !TODO:
- ! - check if anything changes with other possible values of "output.after.step"
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- integer :: is, ie, delta, dynstep
- logical :: deps
- type(TDate) :: t, t0
- real :: time
- ! Type of record (standard=vmr, tp, depv) or special (deps)
- deps=.false.
- if (present(isDEPS)) deps=isDEPS
- ! Start index
- delta=date(4)*3600+date(5)*60+date(6) ! 0, unless start of the run is not at 00:00:00
- if (deps) delta=delta + nread ! one DYNAMIC time step done to output something
- if (modulo(delta,dsec)==0) then
- is=delta/dsec
- else
- is=(delta+dsec)/dsec
- end if
-
- ! End index for daily file (nread=dynamic time step read from rc)
- ie = (24*3600 - nread/2) / dsec
- if (deps) then ! there will be an extra step if run goes further than midnight
-
- t0 = NewDate( time6=date )
- t = NewDate( time6=idatee )
- time = rTotal( t - t0, 'day' )
- if (time > 1) ie=24*3600/dsec
- end if
- ! Case of "last day stopping before midnite". (Need testing for DEPS)
- if (lastday) ie=(idatee(4)*3600+idatee(5)*60+idatee(6)-nread/2)/dsec
-
- ! length
- get_n_time_records = ie-is+1
- if(okdebug)then
- if (present(mess))then
- write(gol,*) 'GET_N_TIME_RECORDS -'//trim(mess); call goPr
- end if
-
- write(gol,*) "GET_N_TIME_RECORDS - is, ie, deps, firstday, lastday, get_n_time_records:" ; call goPr
- write(gol,*) "GET_N_TIME_RECORDS - ", is, ie, deps, firstday, lastday, get_n_time_records ; call goPr
- write(gol,*) "GET_N_TIME_RECORDS - date, dsec, nread ", date, dsec, nread ; call goPr
- write(gol,*) "GET_N_TIME_RECORDS - idateE ", idatee ; call goPr
- end if
-
- return
- END FUNCTION GET_N_TIME_RECORDS
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: OUTPUT_PDUMP_INIT
- !
- ! !DESCRIPTION: reads rc file keys relevant for pdump
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE OUTPUT_PDUMP_INIT( rcF, dsec_min, status )
- !
- ! !USES:
- !
- use GO, only : TrcFile, ReadRc
- use MeteoData, only : lli, set
- use MeteoData, only : sp_dat, oro_dat, temper_dat, humid_dat, pu_dat, pv_dat
- use MeteoData, only : mfw_dat, gph_dat, t2m_dat
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TrcFile), intent(inout) :: rcF
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: dsec_min ! smallest timeseries period in sec
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - upgrade from RETRO to PDUMP
- ! 8 Nov 2012 - Ph. Le Sager - added access mode switch
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/Output_PDUMP_Init'
- ! --- local ------------------------------
- integer :: region
- character(len=64) :: key
- character(len=3) :: nr
- integer :: ivmr
- ! --- begin -------------------------------
- call goLabel(rname)
- #ifdef MPI
- #ifdef with_netcdf4_par
- access_mode = MDF_COLLECTIVE
- #else
- write(gol,'("Time Series output (PDUMP) requires netcdf4 with parallel access enabled")') ; call goErr
- TRACEBACK
- status=1; return
- #endif
- #else
- access_mode = MDF_INDEPENDENT
- #endif
- ! which day
- firstday = .true.
- lastday = .true.
-
- ! lowest time frequency in sec
- dsec_min = 999999
-
- if (any(idatei(1:3)/=idatee(1:3))) lastday=.false. ! i.e. at least one full day
- ! dataset keys:
- call ReadRc( rcF, 'output.pdump.dataset.author' , dataset_author , status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.dataset.institution', institution , status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.dataset.version' , dataset_version , status )
- IF_NOTOK_RETURN(status=1)
- #ifdef tropomi
- call ReadRc( rcF, 'output.pdump.tropomi.tm5version', tropomi_tm5_version , status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.tropomi.institution', tropomi_institution , status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.tropomi.tm5reference', tropomi_tm5_reference , status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.tropomi.authoremail', tropomi_authoremail , status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.tropomi.datasetname', tropomi_dataset_name , status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! filename keys:
- call ReadRc( rcF, 'output.pdump.fname.model', fname_model, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.fname.expid', fname_expid, status )
- IF_NOTOK_RETURN(status=1)
- ! prefix grid name in case of zooming regions:
- if ( nregions > 1 ) then
- ! loop over regions:
- do region = 1, nregions
- ! short grid name from rcfile:
- call ReadRc( rcF, 'output.pdump.fname.grid.'//trim(lli(region)%name), key, status )
- IF_NOTOK_RETURN(status=1)
- ! fill grid extenstion to file names:
- fname_grid(region) = '-'//trim(key)
- end do
- else
- ! empty
- fname_grid = ''
- end if
- ! griddef file ?
- call ReadRc( rcF, 'output.pdump.griddef.apply', griddef_apply, status )
- IF_NOTOK_RETURN(status=1)
- ! temperature, pressure, etc file ?
- call ReadRc( rcF, 'output.pdump.tp.apply', tp_apply, status )
- IF_NOTOK_RETURN(status=1)
- if (tp_apply) then
- ! ensure that required meteo is loaded
- do region=1,nregions
- call Set( sp_dat(region), status, used=.true. )
- call Set( oro_dat(region), status, used=.true. )
- call Set( temper_dat(region), status, used=.true. )
- call Set( t2m_dat(region), status, used=.true. )
- call Set( humid_dat(region), status, used=.true. )
- call Set( pu_dat(region), status, used=.true. )
- call Set( pv_dat(region), status, used=.true. )
- call Set( mfw_dat(region), status, used=.true. )
- call Set( gph_dat(region), status, used=.true. ) ! used to compute vertical wind
- end do
- ! time resolution (1 hour by default)
- call ReadRc( rcF, 'output.pdump.tp.dhour', tp_dhour, status, default=1 )
- IF_ERROR_RETURN(status=1)
-
- dsec_min = tp_dhour*3600
-
- end if
- ! VMR files
- call ReadRc( rcF, 'output.pdump.vmr.n', nvmr, status ) ! number of vmr files to be written
- IF_NOTOK_RETURN(status=1)
- if ( nvmr < 0 ) then
- write (gol,'("strange specification of number of vmr files : ",i6)') nvmr; call goErr
- TRACEBACK; status=1; return
- end if
- ! meteo
- call ReadRc( rcF, 'my.meteo.class', meteo_class, status, default='unknown' )
- IF_ERROR_RETURN(status=1)
-
-
- ! write any vmr files ?
- if ( nvmr > 0 ) then
- ! storage:
- allocate( vmr_apply(nvmr) ) ; vmr_apply = .false.
- allocate( vmr_fname(nvmr) ) ; vmr_fname = ''
- allocate( vmr_dhour(nvmr) ) ; vmr_dhour = -1.
- allocate( vmr_tracer_names(nvmr) ) ; vmr_tracer_names = ''
- allocate( vmr_sregbord(nvmr,4) ) ; vmr_sregbord = -999.9
- allocate( RF_VMR(nregions,nvmr) )
-
- #ifdef tropomi
- do region=1,nregions
- call Set( temper_dat(region), status, used=.true. )
- call Set( gph_dat(region), status, used=.true. ) ! used to compute surface altitude
- end do
- #endif
- ! loop over vmr files:
- do ivmr = 1, nvmr
- ! number in rc keys:
- write (nr,'(i3.3)') ivmr
- ! apply ?
- call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.apply', vmr_apply(ivmr), status )
- IF_NOTOK_RETURN(status=1)
- rf_vmr(:,ivmr)%apply = vmr_apply(ivmr)
-
- ! proceed ?
- if ( vmr_apply(ivmr) ) then
- ! first part of filename:
- call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.fname', vmr_fname(ivmr), status )
- IF_NOTOK_RETURN(status=1)
- ! time resolution:
- call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.dhour', vmr_dhour(ivmr), status )
- IF_NOTOK_RETURN(status=1)
- ! here is the catch: fractional hour for step should divide 3600
- dsec_min = min( dsec_min, int(vmr_dhour(ivmr)*3600) )
-
- ! tracers to be written:
- call ReadRc( rcF, 'output.pdump.vmr.'//nr//'.tracers', vmr_tracer_names(ivmr), status )
- IF_NOTOK_RETURN(status=1)
- end if ! apply ?
- end do ! vmr numbers
- ! required meteo
- if (any(vmr_apply)) then
- do region=1,nregions
- call Set( sp_dat(region), status, used=.true. )
- end do
- end if
-
- end if ! nvmr > 0
- ! ---------------------
- ! local time:
- ! ---------------------
- ! file 1
- lt_fname = 'lt'
- call ReadRc( rcF, 'output.pdump.lt.apply', lt_apply, status )
- IF_NOTOK_RETURN(status=1)
- if ( lt_apply ) then
- call ReadRc( rcF, 'output.pdump.lt.tracers', lt_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.lt.localtime', lt_localtime, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! file 2
- lt2_fname = 'lt2'
- call ReadRc( rcF, 'output.pdump.lt2.apply', lt2_apply, status )
- IF_NOTOK_RETURN(status=1)
- if ( lt2_apply ) then
- call ReadRc( rcF, 'output.pdump.lt2.tracers', lt2_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.lt2.localtime', lt2_localtime, status )
- IF_NOTOK_RETURN(status=1)
- end if
- if (lt_apply .or. lt2_apply) then
- do region=1,nregions
- call Set( sp_dat(region), status, used=.true. )
- end do
- end if
- ! ---------------------
- ! deposition fluxes:
- ! ---------------------
- deps_fname = 'depositions'
- call ReadRc( rcF, 'output.pdump.depositions.apply', deps_apply, status )
- IF_NOTOK_RETURN(status=1)
- if ( deps_apply ) then
- #ifdef with_budgets
- call ReadRc( rcF, 'output.pdump.depositions.dhour', deps_dhour, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.depositions.tracers', deps_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- dsec_min = min( dsec_min, deps_dhour*3600)
- #else
- write(gol,*) "timeseries of deposition fluxes requires using 'with_budget' macro" ; call goErr
- status=1 ; TRACEBACK ; return
- #endif
- end if
- ! ---------------------
- ! deposition velocities:
- ! ---------------------
- depv_fname = 'depvels'
- call ReadRc( rcF, 'output.pdump.depvels.apply', depv_apply, status )
- IF_NOTOK_RETURN(status=1)
- if ( depv_apply ) then
- #ifdef with_budgets
- call ReadRc( rcF, 'output.pdump.depvels.dhour', depv_dhour, status )
- IF_NOTOK_RETURN(status=1)
- call ReadRc( rcF, 'output.pdump.depvels.tracers', depv_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- dsec_min = min( dsec_min, depv_dhour*3600)
- #else
- write(gol,*) "timeseries of deposition velocities requires using 'with_budget' macro" ; call goErr
- status=1 ; TRACEBACK ; return
- #endif
- end if
- ! no files open yet
- curr_day = -1
- call goLabel()
- ! ok
- status = 0
- END SUBROUTINE OUTPUT_PDUMP_INIT
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: OUTPUT_PDUMP_STEP
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE OUTPUT_PDUMP_STEP( region, idate_f, status )
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- !
- ! !REMARKS:
- ! (1) called every hour.
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/Output_PDUMP_Step'
- ! --- begin -------------------------------
- call goLabel(rname)
-
- !----------------------
- ! close if necessary
- !----------------------
- ! if a file is open, and it is a new day
- if ( all(curr_day(region,:) > 0) .and. any(idate_f(1:3) /= curr_day(region,:)) ) then
- ! write in previous day file end-of-interval data
- call PDUMP_Files_Write2( region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- ! close all
- call PDUMP_Files_Close( region, status )
- IF_NOTOK_RETURN(status=1)
- ! no files open ...
- curr_day(region,:) = -1
- firstday = .false.
- end if
- !----------------------
- ! open if necessary
- !----------------------
- if ( any(curr_day(region,:) < 0) ) then
- if (all(idate_f(1:3)==idatee(1:3))) lastday=.true. ! means last day is not a full day
- write(gol,*) "U_O_Pdump open [idate_f, last day] = ", idate_f, lastday; call goPr
- call PDUMP_Files_Open( region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- ! store date of current day
- curr_day(region,:) = idate_f(1:3)
- end if
- !----------------------
- ! write
- !----------------------
- call PDUMP_Files_Write( region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- ! if not midnight, write end-of-interval data
- if ( any(idate_f(4:6) > 0) ) then
- call PDUMP_Files_Write2( region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- !----------------------
- ! done
- !----------------------
- call goLabel()
- status = 0
- END SUBROUTINE OUTPUT_PDUMP_STEP
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: OUTPUT_PDUMP_DONE
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE OUTPUT_PDUMP_DONE( status )
- !
- ! !USES:
- !
- use dims, only : itaur
- use datetime, only : tau2date
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 31 Aug 2012 - P. Le Sager - reverse order in which regions are dealt with (MDF issue)
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/Output_PDUMP_Done'
- integer :: region
- integer,dimension(6) :: idate_f
- ! --- begin -------------------------------
- ! close files:
- do region = nregions, 1, -1
- ! write end of interval DEPS data (requires that DEPS nstep is calculated with .false. -see RF_DEPS_Init-)
- call tau2date(itaur(region),idate_f)
- call PDUMP_Files_Write2( region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
-
- call PDUMP_Files_Close( region, status )
- IF_NOTOK_RETURN(status=1)
- end do
- ! clear:
- if ( nvmr > 0 ) then
- deallocate( vmr_apply )
- deallocate( vmr_fname )
- deallocate( vmr_dhour )
- deallocate( vmr_tracer_names )
- deallocate( vmr_sregbord )
- deallocate( RF_VMR )
- end if
- ! ok
- status = 0
- END SUBROUTINE OUTPUT_PDUMP_DONE
- !EOC
- ! ********************************************************************
- ! ***
- ! *** open/write/close pdump files
- ! ***
- ! ********************************************************************
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: PDUMP_FILES_OPEN
- !
- ! !DESCRIPTION: call init method of each output file.
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine PDUMP_Files_Open( region, idate_f, status )
- !
- ! !USES:
- !
- use global_data, only : outdir
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/PDUMP_Files_Open'
- ! --- local -------------------------------
- integer :: ivmr
- ! --- begin -------------------------------
- ! grid definition:
- if ( griddef_apply ) then
- call RF_GridDef_Init( RF_GridDef(region), outdir, fname_model, fname_expid, region, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! dynamics:
- if ( tp_apply ) then
- call RF_TP_Init ( RF_TP(region) , outdir, fname_model, fname_expid, &
- region, idate_f, tp_dhour, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! tracer concentrations:
- do ivmr = 1, nvmr
- if ( .not. vmr_apply(ivmr) ) cycle
- call RF_VMR_Init( RF_VMR(region,ivmr), outdir, fname_model, fname_expid, &
- vmr_fname(ivmr), region, idate_f, &
- vmr_dhour(ivmr), vmr_tracer_names(ivmr), status )
- IF_NOTOK_RETURN(status=1)
- vmr_apply(ivmr) = rf_vmr(region,ivmr)%apply
- end do
- ! lt output:
- if ( lt_apply ) then
- call RF_LT_Init( RF_LT(region), outdir, fname_model, fname_expid, &
- lt_fname, region, idate_f, &
- lt_localtime, lt_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- end if
- if ( lt2_apply ) then
- call RF_LT_Init( RF_LT2(region), outdir, fname_model, fname_expid, &
- lt2_fname, region, idate_f, &
- lt2_localtime, lt2_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- end if
- #ifdef with_budgets
- ! deposition fluxes:
- if ( deps_apply ) then
- call RF_DEPS_Init( RF_DEPS(region), outdir, fname_model, fname_expid, &
- deps_fname, region, idate_f, &
- deps_dhour, deps_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! deposition velocities:
- if ( depv_apply ) then
- call RF_DEPV_Init( RF_DEPV(region), outdir, fname_model, fname_expid, &
- depv_fname, region, idate_f, &
- depv_dhour, depv_tracer_names, status )
- IF_NOTOK_RETURN(status=1)
- end if
- #endif
- ! ok
- status = 0
- END SUBROUTINE PDUMP_FILES_OPEN
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: PDUMP_FILES_WRITE
- !
- ! !DESCRIPTION: call write method for each output file.
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE PDUMP_FILES_WRITE( region, idate_f, status )
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/PDUMP_Files_Write'
- integer :: ivmr
- ! --- begin -------------------------------
- ! grid definition:
- if ( griddef_apply ) then
- call RF_GridDef_Write( RF_GridDef(region), region, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! dynamics:
- if ( tp_apply ) then
- call RF_TP_Write( RF_TP(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! tracer fields:
- do ivmr = 1, nvmr
- if ( .not. vmr_apply(ivmr) ) cycle
- call RF_VMR_Write( RF_VMR(region,ivmr), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end do
- ! lt output:
- if ( lt_apply ) then
- call RF_LT_Write( RF_LT(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- if ( lt2_apply ) then
- call RF_LT_Write( RF_LT2(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- #ifdef with_budgets
- ! deposition velocities:
- if ( depv_apply ) then
- call RF_DEPV_Write( RF_DEPV(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- #endif
-
- status = 0
- END SUBROUTINE PDUMP_FILES_WRITE
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: PDUMP_FILES_WRITE2
- !
- ! !DESCRIPTION: write at end of time interval
- !
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE PDUMP_FILES_WRITE2( region, idate_f, status )
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/PDUMP_Files_Write2'
- ! --- begin -------------------------------
- #ifdef with_budgets
- ! deposition fluxes:
- if ( deps_apply ) then
- call RF_DEPS_Write( RF_DEPS(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- #endif
-
- ! lt output:
- if ( lt_apply ) then
- call RF_LT_Write( RF_LT(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- if ( lt2_apply ) then
- call RF_LT_Write( RF_LT2(region), region, idate_f, status )
- IF_NOTOK_RETURN(status=1)
- end if
- ! ok
- status = 0
- END SUBROUTINE PDUMP_FILES_WRITE2
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: PDUMP_FILES_CLOSE
- !
- ! !DESCRIPTION: call done method of each output file.
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE PDUMP_FILES_CLOSE( region, status )
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 31 Aug 2012 - Ph. Le Sager - switch closing order, since it was giving issues on some machine.
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/PDUMP_Files_Close'
- ! --- local -------------------------------
- integer :: ivmr
- ! --- begin -------------------------------
- #ifdef with_budgets
- if ( depv_apply ) then
- call RF_DEPV_Done( RF_DEPV(region), status )
- IF_NOTOK_RETURN(status=1)
- end if
- if ( deps_apply ) then
- call RF_DEPS_Done( RF_DEPS(region), status )
- IF_NOTOK_RETURN(status=1)
- end if
- #endif
-
- if ( lt2_apply ) then
- call RF_LT_Done( RF_LT2(region), region, status )
- IF_NOTOK_RETURN(status=1)
- end if
-
- if ( lt_apply ) then
- call RF_LT_Done( RF_LT(region), region, status )
- IF_NOTOK_RETURN(status=1)
- end if
- do ivmr = nvmr, 1, -1
- if ( .not. vmr_apply(ivmr) ) cycle
- call RF_VMR_Done( RF_VMR(region,ivmr), status )
- IF_NOTOK_RETURN(status=1)
- end do
- if ( tp_apply ) then
- call RF_TP_Done ( RF_TP(region) , status )
- IF_NOTOK_RETURN(status=1)
- end if
- if ( griddef_apply ) then
- call RF_GridDef_Done( RF_GridDef(region), status )
- IF_NOTOK_RETURN(status=1)
- end if
- status = 0
- end subroutine PDUMP_Files_Close
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_GRIDDEF_INIT
- !
- ! !DESCRIPTION:
- !
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ! FILE 1: Model horizontal grid definition
- ! (longitude, latitude, size of gridbox [m2] ).
- ! For documentation purposes, please also include the native vertical
- ! grid definition from your model (hybrid level coefficients) and the
- ! formula used to calculate pressure.
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- !
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine RF_GridDef_Init( RF, fdir, model, expid, region, status )
- !
- ! !USES:
- !
- use partools, only : MPI_INFO_NULL, localComm
- use MeteoData, only : global_lli, levi
- !
- ! !OUTPUT PARAMETERS:
- !
- type(TPdumpFile_GridDef), intent(out) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in) :: fdir
- character(len=*), intent(in) :: model
- character(len=*), intent(in) :: expid
- integer, intent(in) :: region
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- ! 10 Jul 2012 - Ph. Le Sager - switch to MDF_NETCDF4
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_GridDef_Init'
- character(len=256) :: fname
- integer :: varid
- integer :: rtype
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! o open file
- ! write filename
- write (fname,'(a,"/",a,a,"_",a,"_",a,".nc")') &
- trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), 'griddef'
- #ifdef MPI
- ! overwrite existing files (clobber), provide MPI stuff:
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
- mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
- if (status/=0) then
- write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
- write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
- TRACEBACK; status=1; return
- end if
- #else
- ! overwrite existing files (clobber)
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! o global attributes
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title', 'model horizontal definition' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define dimensions
- call MDF_Def_Dim( RF%ncid, 'scalar', 1, RF%dimid_scalar , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lon', global_lli(region)%nlon, RF%dimid_lon , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lat', global_lli(region)%nlat, RF%dimid_lat , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lev', levi%nlev, RF%dimid_lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'levi', levi%nlev+1, RF%dimid_levi , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Def_Dim( RF%ncid, 'time', NTS, RF%dimid_time , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Def_Dim( RF%ncid, 'datelen', 6, RF%dimid_datelen , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- ! o define variables
- rtype = MDF_FLOAT
- call MDF_Def_Var( RF%ncid, 'lon', rtype, (/RF%dimid_lon/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_east' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lon = varid
- call MDF_Def_Var( RF%ncid, 'lat', MDF_FLOAT, (/RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_north' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lat = varid
- !call MDF_Def_Var( RF%ncid, 'time', MDF_FLOAT, RF%dimid_time, varid , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'time' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'units', 'days since 1950-01-01 00:00:00' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'calender', 'gregorian' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !RF%varid_time = varid
-
- !call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'date' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !RF%varid_date = varid
-
- call MDF_Def_Var( RF%ncid, 'area', MDF_FLOAT, (/RF%dimid_lon,RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'grid_cell_area' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'grid-cell area' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'm2' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_gridbox_area = varid
- call MDF_Def_Var( RF%ncid, 'a', MDF_FLOAT, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a(k)*p0 + b(k)*ps(n,j,i)' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'comment', 'bottom-up' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_a = varid
- call MDF_Def_Var( RF%ncid, 'b', mdf_float, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'p(n,k,j,i) = a(k)*p0 + b(k)*ps(n,j,i)' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'comment', 'bottom-up' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_b = varid
- call MDF_Def_Var( RF%ncid, 'a_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_a_bnds = varid
- call MDF_Def_Var( RF%ncid, 'b_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_b_bnds = varid
- call MDF_Def_Var( RF%ncid, 'p0', mdf_float, (/RF%dimid_scalar/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'reference pressure value' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_p0 = varid
- !status = pnf90_def_var( RF%ncid, 'ps', MDF_FLOAT, &
- ! (/RF%dimid_lon,RF%dimid_lat,RF%dimid_time/), varid )
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'surface pressure' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !RF%varid_ps = varid
- !status = pnf90_def_var( RF%ncid, 'geo_height', MDF_FLOAT, &
- ! (/RF%dimid_lon,RF%dimid_lat,RF%dimid_lev,RF%dimid_time/), varid )
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'long_name', 'geopotential height' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'units', 'm' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !call MDF_Put_Att( RF%ncid, varid, 'comment', 'bottom-up; lower half level; top value implicit infinity' , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
- !RF%varid_geo_height = varid
- ! o end defintion mode
- call MDF_EndDef( RF%ncid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! no records written yet
- RF%trec = 0
- call goLabel() ; status = 0
- END SUBROUTINE RF_GRIDDEF_INIT
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_GridDef_Write
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_GRIDDEF_WRITE( RF, region, status )
- !
- ! !USES:
- !
- use GO, only : TDate, NewDate, rTotal, operator(-)
- use Grid, only : AreaOper
- use MeteoData, only : global_lli, levi, sp_dat
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_GridDef), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- ! 10 Jul 2012 - Ph. Le Sager - switch to MDF_NETCDF4
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_GridDef_Write'
- integer :: imr, jmr, lmr
- real, allocatable :: ll(:,:)
- real :: time
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! grid size
- imr = global_lli(region)%nlon
- jmr = global_lli(region)%nlat
- lmr = levi%nlev
- ! next time record:
- RF%trec = RF%trec + 1
- ! o write data
- if ( RF%trec == 1 ) then
- ! lat/lon field:
- allocate( ll(imr,jmr) )
- call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ll = 1.0
- call AreaOper( global_lli(region), ll, '*', 'm2', status )
- IF_NOTOK_RETURN(status=1)
- call MDF_Put_Var( RF%ncid, RF%varid_gridbox_area, ll , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_a, levi%fa , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_b, levi%fb , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_a_bnds, levi%a(0:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_b_bnds, levi%b(0:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_p0, (/1.0/) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- deallocate( ll )
- end if
-
- !call MDF_Put_Var( RF%ncid, RF%varid_time, time, index=RF%trec , status)
- !IF_NOTOK_MDF(fid=RF%ncid)
-
- !call MDF_Put_Var( RF%ncid, RF%varid_date, reshape(real(idate_f),(/6,1/), status), &
- ! start=(/1,RF%trec/), count=(/6,1/) )
- !IF_NOTOK_MDF(fid=RF%ncid)
-
- !status = pnf90_put_var( RF%ncid, RF%varid_ps, &
- ! reshape(sp_dat(region)%data(1:imr,1:jmr,1:1),(/imr,jmr,1/)), &
- ! start=(/1,1,RF%trec/), count=(/imr,jmr,1/) )
- !IF_NOTOK_MDF(fid=RF%ncid)
-
- !status = pnf90_put_var( RF%ncid, RF%varid_geo_height, &
- ! reshape(gph_dat(region)%data(1:imr,1:jmr,1:lmr),(/imr,jmr,lmr,1/)), &
- ! start=(/1,1,1,RF%trec/), count=(/imr,jmr,lmr,1/) )
- !IF_NOTOK_MDF(fid=RF%ncid)
-
- call goLabel()
- status = 0
- END SUBROUTINE RF_GridDef_Write
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_GRIDDEF_DONE
- !
- ! !DESCRIPTION: close file-1
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_GridDef_Done( RF, status )
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_GridDef), intent(inout) :: RF
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_GridDef_Done'
- ! --- begin -------------------------------------
- call goLabel(rname)
- call MDF_Close( RF%ncid , status)
- IF_NOTOK_RETURN(status=1)
- call goLabel()
- status = 0
- END SUBROUTINE RF_GRIDDEF_DONE
- !EOC
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ! FILE2: 3D field of monthly Model pressure [Pa] and temperature [K].
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_TP_INIT
- !
- ! !DESCRIPTION: file-2 : open and define var/att
- !
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_TP_Init( RF, fdir, model, expid, region, idate_f, dhour, status )
- !
- ! !USES:
- !
- use partools, only : MPI_INFO_NULL, localComm
- use MeteoData, only : global_lli, levi
- !
- ! !OUTPUT PARAMETERS:
- !
- type(TPdumpFile_TP), intent(out) :: RF
- integer, intent(out) :: status
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in) :: fdir
- character(len=*), intent(in) :: model
- character(len=*), intent(in) :: expid
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- integer, intent(in) :: dhour
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - switch to netcdf-4 thru MDF
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_TP_Init'
- ! --- local ------------------------------------
- character(len=256) :: fname
- integer :: varid, i1, i2, j1, j2
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! store arguments
- RF%dhour = dhour
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- n_tp_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, mess='TP_Init' )
- if ( n_tp_rec == 0 ) then
- tp_apply = .false.
- status=0
- return
- end if
-
- ! o open file
- ! write filename
- write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
- trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), 'TP', idate_f(1:3)
- ! open, overwrite existing files (clobber)
- #ifdef MPI
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
- mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
- if (status/=0) then
- write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
- write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
- TRACEBACK; status=1; return
- end if
- #else
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! o global attributes
- call mdf_put_att( RF%ncid, MDF_GLOBAL, 'title', 'model pressure and temperature', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, MDF_GLOBAL, 'dataset_version', trim(dataset_version) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define dimensions
-
- call mdf_def_dim( RF%ncid, 'lon', global_lli(region)%nlon, RF%dimid_lon , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_def_dim( RF%ncid, 'lat', global_lli(region)%nlat, RF%dimid_lat , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_def_dim( RF%ncid, 'lev', levi%nlev, RF%dimid_lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_def_dim( RF%ncid, 'time', n_tp_rec, RF%dimid_time , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_def_dim( RF%ncid, 'datelen', 6, RF%dimid_datelen , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define variables
- call mdf_def_var( RF%ncid, 'lon', MDF_FLOAT, (/RF%dimid_lon/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'degrees_east' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lon = varid
- call mdf_def_var( RF%ncid, 'lat', MDF_FLOAT, (/RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'degrees_north' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lat = varid
- call mdf_def_var( RF%ncid, 'lev', MDF_FLOAT, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'level' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lev = varid
- call mdf_def_var( RF%ncid, 'time', MDF_FLOAT, (/RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'days since 1950-01-01 00:00:00' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'calender', 'gregorian' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_time = varid
- allocate(RF%time(n_tp_rec))
-
- call mdf_def_var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'date and time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_date = varid
- allocate(RF%date(6,n_tp_rec))
-
- call mdf_def_var( RF%ncid, 'ps', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'surface_air_pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'surface pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_ps = varid
- call mdf_def_var( RF%ncid, 'orog', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'surface_altitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'surface altitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'm' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_orog = varid
- call mdf_def_var( RF%ncid, 'surface_temp', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'surface_temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'surface temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'K' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', &
- '2m temperature from MARS archive or IFS model (grib 167, 2T)' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_surface_temp = varid
- allocate( RF%data2d(i1:i2, j1:j2, n_tp_rec, 3) )
- call mdf_def_var( RF%ncid, 'geopotential', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), &
- varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'geopotential' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'geopotential' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'm2 s-2' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'at mid levels' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_geop = varid
- call mdf_def_var( RF%ncid, 'pressure', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'at mid levels' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_pressure = varid
- call mdf_def_var( RF%ncid, 'temp', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'air_temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'K' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'bottom-up; full levels' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_temp = varid
- call mdf_def_var( RF%ncid, 'specific_humidity', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), &
- varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'specific_humidity' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'specific humidity' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'kg kg-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'mass fraction of water vapor in moist air; (kg water)/(kg air)' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_humid = varid
- call mdf_def_var( RF%ncid, 'U', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'eastward_wind' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'zonal wind' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'm s-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'computed from mass fluxes through grid box boundaries' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_u = varid
- call mdf_def_var( RF%ncid, 'V', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'standard_name', 'northward_wind' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'meridional wind' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'm s-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'computed from mass fluxes through grid box boundaries' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_v = varid
- call mdf_def_var( RF%ncid, 'W', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'long_name', 'vertical wind velocity' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'units', 'm s-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'comment', 'computed from mass fluxes through grid box boundaries' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_w = varid
- allocate( RF%data3d(i1:i2, j1:j2, levi%nlev, n_tp_rec, 7) )
-
- ! o end defintion mode
- call mdf_enddef( RF%ncid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o
- ! no records written yet
- RF%trec = 0
- call goLabel()
- ! ok
- status = 0
- END SUBROUTINE RF_TP_Init
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_TP_Write
- !
- ! !DESCRIPTION: store records, and if last time step write data to file
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_TP_Write( RF, region, idate_f, status )
- !
- ! !USES:
- !
- use Binas , only : grav
- use Phys , only : GeoPotentialHeight
- use Grid , only : FPressure, HPressure
- use GO , only : TDate, NewDate, rTotal, operator(-)
- use partools , only : myid, root
- use MeteoData , only : global_lli, lli, levi
- use MeteoData , only : sp_dat, temper_dat, humid_dat, pu_dat, pv_dat, mfw_dat, gph_dat, oro_dat, t2m_dat
- use MeteoData , only : m_dat
- use global_data, only : mass_dat
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_TP), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_TP_Write'
- ! --- local ------------------------------------
- integer :: i, j, l, i1, i2, j1, j2
- integer :: imr, jmr, lmr, klm
- real :: lev(levi%nlev)
- type(TDate) :: t, t0
- real :: time
- real, allocatable :: field3d(:,:,:)
- real :: p_hlev(0:levi%nlev)
- ! --- begin -------------------------------------
- ! for multiple of dhour only ...
- if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
- status=0; return
- end if
- call goLabel(rname)
- ! grid size
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr=i2-i1+1
- jmr=j2-j1+1
- lmr = levi%nlev
- ! next time record:
- RF%trec = RF%trec + 1
- ! time since reftime:
- t0 = NewDate( time6=time_reftime6 )
- t = NewDate( time6=idate_f )
- time = rTotal( t - t0, 'day' )
-
- if(okdebug)then
- write(gol,*) "RF_TP_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
- end if
-
- ! o write data
- if ( RF%trec == 1 ) then
- call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- do l = 1, lmr
- lev(l) = real(l)
- end do
- call MDF_Put_Var( RF%ncid, RF%varid_lev, lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- ! temporary storage for 3D fields
- allocate( field3d(i1:i2,j1:j2,1:lmr) ) ; field3d = 0.
- !-------- FILL DIAGNOSTIC ARRAYS
- RF%time(RF%trec) = time
- RF%date(:,RF%trec) = real(idate_f)
- RF%data2d(:,:,RF%trec,1) = sp_dat(region)%data(i1:i2,j1:j2,1)
- RF%data2d(:,:,RF%trec,2) = oro_dat(region)%data(i1:i2,j1:j2,1)
- RF%data2d(:,:,RF%trec,3) = t2m_dat(region)%data(i1:i2,j1:j2,1)
- ! o geopotential
- ! fill mid level geopotential:
- do j = j1, j2
- do i = i1, i2
- ! half level pressures
- call HPressure( levi, sp_dat(region)%data(i,j,1), p_hlev, status )
- IF_NOTOK_RETURN(status=1)
- ! mid level gph (m)
- call GeoPotentialHeight( lmr, p_hlev, temper_dat(region)%data(i,j,:), &
- humid_dat(region)%data(i,j,:), oro_dat(region)%data(i,j,1)/grav, &
- field3d(i,j,:) ) ! m
- end do
- end do
- ! multiply with gravity for correct unit:
- field3d = field3d * grav ! m2/s2
- RF%data3d(:,:,:,RF%trec,1) = field3d
-
- ! o pressure
- ! fill mid level pressure
- call FPressure( levi, sp_dat(region)%data(i1:i2,j1:j2,1), field3d, status )
- IF_NOTOK_RETURN(status=1)
- RF%data3d(:,:,:,RF%trec,2) = field3d
- ! o temperature
- RF%data3d(:,:,:,RF%trec,3) = temper_dat(region)%data(i1:i2,j1:j2,1:lmr)
- ! o specific humidity
- RF%data3d(:,:,:,RF%trec,4) = humid_dat(region)%data(i1:i2,j1:j2,1:lmr)
- ! o wind fields
- CALL UPDATE_HALO( dgrid(region), pu_dat(region)%data, pu_dat(region)%halo, status)
- IF_NOTOK_RETURN(status=1)
- CALL UPDATE_HALO( dgrid(region), pv_dat(region)%data, pv_dat(region)%halo, status)
- IF_NOTOK_RETURN(status=1)
-
- ! average U wind
- 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) ) &
- / m_dat(region)%data(i1:i2,j1:j2,1:lmr) ! 1/s
- do j = j1, j2
- field3d(:,j,:) = field3d(:,j,:) * lli(region)%dx(j-j1+1) ! m/s
- end do
- RF%data3d(:,:,:,RF%trec,5) = field3d
- ! average V wind:
- 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) ) &
- / m_dat(region)%data(i1:i2,j1:j2,1:lmr) ! 1/s
- field3d = field3d * lli(region)%dy ! m/s
- RF%data3d(:,:,:,RF%trec,6) = field3d
- ! from downward massflux to upward average W wind:
- field3d = 0.5 * ( mfw_dat(region)%data(i1:i2,j1:j2,0:lmr-1) + mfw_dat(region)%data(i1:i2,j1:j2,1:lmr) ) &
- / m_dat(region)%data(i1:i2,j1:j2,1:lmr) ! 1/s
- do l = 1, lmr
- field3d(:,:,l) = - 1.0 * field3d(:,:,l) * &
- abs( gph_dat(region)%data(i1:i2,j1:j2,l+1) - gph_dat(region)%data(i1:i2,j1:j2,l) ) ! m/s
- end do
- RF%data3d(:,:,:,RF%trec,7) = field3d
-
- !-------- WRITE ARRAYS
- if ( RF%trec == n_tp_rec ) then
- ! time
- call MDF_Put_Var( RF%ncid, RF%varid_time, RF%time, status)!, start=(/1/), count=(/n_tp_rec/))
- IF_NOTOK_MDF(fid=RF%ncid)
- ! date
- call MDF_Put_Var( RF%ncid, RF%varid_date, RF%date, status )!, &
- ! start=(/1,1/), count=(/6,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! surface pressure
- call MDF_Put_Var( RF%ncid, RF%varid_ps, RF%data2d(:,:,:,1), status, start=(/i1,j1,1/), count=(/imr,jmr,n_tp_rec/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! orography (in m!)
- call MDF_Put_Var( RF%ncid, RF%varid_orog, RF%data2d(:,:,:,2), status, start=(/i1,j1,1/), count=(/imr,jmr,n_tp_rec/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! surface temperature = 2m temperature
- call MDF_Put_Var( RF%ncid, RF%varid_surface_temp, RF%data2d(:,:,:,3), status, start=(/i1,j1,1/) ) !, count=(/imr,jmr,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! geopotential
- 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/))
- IF_NOTOK_MDF(fid=RF%ncid)
- ! pressure
- call MDF_Put_Var( RF%ncid, RF%varid_pressure, RF%data3d(:,:,:,:,2), status, start=(/i1,j1,1,1/), &
- count=(/imr,jmr,lmr,n_tp_rec/))
- IF_NOTOK_MDF(fid=RF%ncid)
- ! temperature
- 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/))
- IF_NOTOK_MDF(fid=RF%ncid)
- ! specific humidity
- 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/))
- IF_NOTOK_MDF(fid=RF%ncid)
- ! winds
- 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/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- 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/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- 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/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
-
- ! Done
- deallocate( field3d )
- call goLabel()
- status = 0
- END SUBROUTINE RF_TP_Write
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_TP_Done
- !
- ! !DESCRIPTION: close file #2
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine RF_TP_Done( RF, status )
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_TP), intent(inout) :: RF
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_TP_Done'
- ! --- begin -------------------------------------
- call goLabel(rname)
- call MDF_Close( RF%ncid , status)
- IF_NOTOK_RETURN(status=1)
- deallocate( rf%time, rf%date, rf%data2d, rf%data3d )
- call goLabel() ; status = 0
- end subroutine RF_TP_Done
- !EOC
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ! FILE3: 3D fields for O3, CO, CH4, ... Volume Mixing Ratios
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_VMR_Init
- !
- ! !DESCRIPTION: open and define variables/attribute for file #3
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine RF_VMR_Init( RF, fdir, model, expid, filetype, region, &
- idate_f, dhour, tracer_names, status )
- !
- ! !USES:
- !
- use Binas, only : xmair
- use GO, only : goReadFromLine, goUpCase
- use chem_param, only : ntrace, names, ra
- use partools, only : PAR_BROADCAST, MPI_INFO_NULL, localComm
- use MeteoData, only : global_lli, lli, levi, sp_dat
- use dims, only : xbeg, xend, ybeg, yend, dx, dy, dz, xref, yref, zref
- use dims, only : zbeg, zend
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_VMR), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in) :: fdir
- character(len=*), intent(in) :: model
- character(len=*), intent(in) :: expid
- character(len=*), intent(in) :: filetype
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- real, intent(in) :: dhour
- character(len=*), intent(in) :: tracer_names
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- ! 15 Apr 2014 - Ph. Le Sager - tropomi add-ons
- ! 8 Oct 2014 - H. Eskes - tropomi add-ons
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_VMR_Init'
- ! --- local ------------------------------------
- character(len=256) :: fname, history, sysdate, model_meteo
- integer :: varid, i1, i2, j1, j2
- integer, dimension(8) :: isysdate
-
- character(len=256) :: trnames
- character(len=8) :: trname, tmname
- integer :: k, itr, posend, pospoint
- integer :: imr, jmr, lmr, si, ei, ix, jy
- character(len=32) :: varname_spec
- character(len=5) :: zone
- character(len=64) :: cf_medium_stnd, cf_medium_long
- character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
- character(len=64) :: cf_spec_stnd, cf_spec_long
- character(len=4) :: cf_enti_type
- character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
- character(len=512) :: comment
- character(len=6) :: csize
- integer, dimension(6) :: idate_f_end, idate_create
- type(TDate) :: date_f_end, date_create
-
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! store arguments
- RF%dhour = dhour
- RF%dsec = int(dhour*3600.)
- RF%tracer_names = tracer_names
-
- ! Test that dsec is multiple of dynamic-step/2 (nread in sec)
- if (((RF%dsec*2)/nread < 1).or.(modulo(RF%dsec,nread/2)/=0))then
- write(gol,*) "timeseries timestep should be a multiple of (dynamic_timestep)/2"; call goErr
- TRACEBACK; status=1; return
- end if
-
- ! size
- imr = global_lli(region)%nlon
- jmr = global_lli(region)%nlat
- lmr = levi%nlev
- ! number of time steps
- rf%n_rec = GET_N_TIME_RECORDS( idate_f, rf%dsec, mess='VMR_Init' )
- ! degenerated cases (eg, very short runs)
- if ( rf%n_rec == 0 ) then
- rf%apply = .false.
- status=0
- return
- end if
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
-
- ! set tracer index for requested tracers:
- write (gol,'("selected tracers for VMR output:")'); call goPr
- ! initialise RF
- RF%ntr = 0
- #ifdef with_m7
- RF%lpmx = .false.
- RF%sizepmx = -1.0
- #endif
- RF%itr = -1
- trnames = tracer_names
- do
- ! empty ?
- if ( len_trim(trnames) == 0 ) exit
- ! next number:
- if ( RF%ntr == ntrace ) then
- write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
- TRACEBACK; status=1; return
- end if
- RF%ntr = RF%ntr + 1
- ! extract leading name:
- call goReadFromLine( trnames, trname, status, sep=' ' )
- IF_NOTOK_RETURN(status=1)
- #ifdef with_m7
- ! ---------------------------
- ! check for PMx
- ! ---------------------------
- if( strlowercase(trname(1:2)) == 'pm' ) then
- RF%lpmx(RF%ntr) = .true.
- RF%itr (RF%ntr) = -1
- ! paste size to real
- read(trname(3:len_trim(trname)), * ) RF%sizepmx(RF%ntr)
- else
- #endif
- ! convert to tm5 name:
- select case ( trim(strlowercase(trname)) )
- case ( 'hcho' ) ; tmname = 'CH2O'
- case ( 'rn', 'radon' ) ; tmname = 'Rn222'
- case ( 'pb', 'lead' ) ; tmname = 'Pb210'
- case default ; tmname = trname
- end select
- ! --------------------------------
- ! NOy and M7 are special cases ...
- ! --------------------------------
- select case ( trim(strlowercase(tmname)) )
- case( 'noy' )
- ! defined as ntrace+1
- RF%itr(RF%ntr) = iNOy
- write (gol,'(" * ",a10)') trim(trname); call goPr
- #ifdef with_m7
- case( 'tso4' )
- ! defined as ntrace+2
- RF%itr(RF%ntr) = iSO4
- write (gol,'(" * ",a10)') trim(trname); call goPr
- case( 'tbc' )
- ! defined as ntrace+3
- RF%itr(RF%ntr) = iBC
- write (gol,'(" * ",a10)') trim(trname); call goPr
- case( 'tpom' )
- ! defined as ntrace+4
- RF%itr(RF%ntr) = iPOM
- write (gol,'(" * ",a10)') trim(trname); call goPr
- case( 'tss' )
- ! defined as ntrace+5
- RF%itr(RF%ntr) = iSS
- write (gol,'(" * ",a10)') trim(trname); call goPr
- case( 'tdu' )
- ! defined as ntrace+6
- RF%itr(RF%ntr) = iDU
- write (gol,'(" * ",a10)') trim(trname); call goPr
- #endif
- case default
- ! --------------------------------
- ! `regular` constituents
- ! --------------------------------
- ! loop over all names:
- RF%itr(RF%ntr) = -1
- do itr = 1, ntrace
- ! case indendent match ?
- if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
- write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4)') itr, trim(trname), trim(names(itr)), ra(itr); call goPr
- RF%itr(RF%ntr) = itr
- exit
- end if
- end do
- end select
- ! not found ?
- if ( RF%itr(RF%ntr) < 0 ) then
- write (gol,'("tracer name not supported:")'); call goPr
- write (gol,'(" list all : ",a)') trim(tracer_names); call goPr
- write (gol,'(" list element : ",i3)') RF%ntr; call goPr
- write (gol,'(" pdump name : ",a)') trim(trname); call goPr
- write (gol,'(" tm5 name : ",a)') trim(tmname); call goPr
- write (gol,'(" tm5 tracers : ")'); call goPr
- do itr = 1, ntrace
- write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
- end do
- TRACEBACK; status=1; return
- end if ! RF%itr
- #ifdef with_m7
- end if ! pmx
- #endif
- ! store pdump name:
- RF%name_tr(RF%ntr) = tmname
- end do
- ! empty file ?
- if ( RF%ntr < 1 ) then
- write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
- TRACEBACK; status=1; return
- end if
- ! o open file
- ! write filename
- #ifdef tropomi
- ! define start/stop of output, and run date
- date_f_end = NewDate( time6=idate_f ) + IncrDate(hour=24)
- call Get( date_f_end, time6=idate_f_end )
- if ( isRoot ) then
- date_create = SystemDate()
- call Get( date_create, time6=idate_create )
- endif
- call PAR_BROADCAST(idate_create, status)
- IF_NOTOK_RETURN(status=1)
- date_create = SystemDate()
- call Get( date_create, time6=idate_create )
- write (tropomi_date_start, '(i4.4,i2.2,i2.2,"T",i2.2,i2.2,i2.2)') idate_f
- write (tropomi_date_stop, '(i4.4,i2.2,i2.2,"T",i2.2,i2.2,i2.2)') idate_f_end
- write (tropomi_date_create,'(i4.4,i2.2,i2.2,"T",i2.2,i2.2,i2.2)') idate_create
- ! write filename according to tropomi convention
- write (fname,'(a,"/",a,"_",a,"_",a,".nc")') &
- trim(fdir), trim(tropomi_dataset_name), tropomi_date_start, tropomi_date_stop
- #else
- write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
- trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
- #endif
- ! open:
- #ifdef MPI
- ! overwrite existing files (clobber), provide MPI stuff:
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
- mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
- if (status/=0) then
- write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
- write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
- TRACEBACK; status=1; return
- end if
- #else
- ! overwrite existing files (clobber)
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! o global attributes
- #ifdef tropomi
- ! H. Eskes: Extra attributes for TROPOMI
- ! Conventions = "CF-1.6"
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'Conventions', 'CF-1.6' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! validity_start = "20132305T120000" (zoals in filenaam)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'validity_start', tropomi_date_start , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! validity_stop = "20132405T000000"
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'validity_stop', tropomi_date_stop , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! creation_date = "20142909T124905"
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'creation_date', tropomi_date_create , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! version = TM5 version string.
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'version', trim(tropomi_tm5_version) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! institution = "KNMI"
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution', trim(tropomi_institution) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! reference = TM5 reference (journal article or so)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'reference', trim(tropomi_tm5_reference) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! contact = email address of volunteer.
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'contact', trim(tropomi_authoremail) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! dataset_name = "S5P_NRTI_AUX_CTMFCT" of "S5P_OFFL_AUX_CTMANA"
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_name', trim(tropomi_dataset_name) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- #endif
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'mixing ratios & concentrations' , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'file_version_number', trim(outfileversnr) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'im' , imr , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'jm' , jmr , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'lm' , lmr , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dx' , dx/xref(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dy' , dy/yref(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dz' , dz/zref(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'xbeg' , xbeg(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'xend' , xend(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'ybeg' , ybeg(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'yend' , yend(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'zbeg' , zbeg(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'zend' , zend(region) , status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! Meteo attribute
- if (trim(meteo_class)=='ei') then
- model_meteo='analysis (ERA-Interim)'
- elseif (trim(meteo_class)=='ea') then
- model_meteo='reanalysis (ERA5)'
- elseif (trim(meteo_class)=='od') then
- model_meteo='forecast (IFS)'
- elseif (trim(meteo_class)=='ifs10') then
- model_meteo='EC-Earth (ifs 10L)'
- elseif (trim(meteo_class)=='ifs34') then
- model_meteo='EC-Earth (ifs 34L)'
- elseif (trim(meteo_class)=='ifs62') then
- model_meteo='EC-Earth (ifs 62L)'
- elseif (trim(meteo_class)=='ifs91') then
- model_meteo='EC-Earth (ifs 91L)'
- else
- write (gol,'("Meteo Model not known !")'); call goErr
- TRACEBACK; status=1; return
- endif
-
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'meteo_model', trim(model_meteo), status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! History attribute for audit trail: date, time of day, user name, program name
- call date_and_time(values=isysdate, zone=zone)
- write (sysdate, '(i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2," ",a)') &
- isysdate(1), isysdate(2), isysdate(3), isysdate(5), isysdate(6), isysdate(7), zone
- write(history,'("Created ",a," by ",a," with TM5.")') trim(sysdate),trim(dataset_author)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'history', trim(history), status )
- IF_NOTOK_MDF(fid=RF%ncid)
-
- ! o define dimensions
- call MDF_Def_Dim( RF%ncid, 'lon', imr, RF%dimid_lon , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lat', jmr, RF%dimid_lat , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lev', levi%nlev, RF%dimid_lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'levi', levi%nlev+1, RF%dimid_levi , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'time', rf%n_rec, RF%dimid_time , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'datelen', 6, RF%dimid_datelen , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define variables
- call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_east' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lon = varid
- call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'degrees_north' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lat = varid
-
- #ifdef tropomi
- call MDF_Def_Var( RF%ncid, 'hyai', mdf_float, (/RF%dimid_levi/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid A coefficient at layer interfaces' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_hyai = varid
- #else
- call MDF_Def_Var( RF%ncid, 'a_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_a_bnds = varid
- #endif
- #ifdef tropomi
- call MDF_Def_Var( RF%ncid, 'hybi', mdf_float, (/RF%dimid_levi/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid B coefficient at layer interfaces' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_hybi = varid
- #else
- call MDF_Def_Var( RF%ncid, 'b_bnds', mdf_float, (/RF%dimid_levi/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid sigma coordinate a coefficient for layer bounds' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_b_bnds = varid
- #endif
-
- #ifdef tropomi
- call MDF_Def_Var( RF%ncid, 'hyam', mdf_float, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid A coefficient at layer midpoints' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_hyam = varid
- call MDF_Def_Var( RF%ncid, 'hybm', mdf_float, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid B coefficient at layer midpoints' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_hybm = varid
- #endif
- call MDF_Def_Var( RF%ncid, 'lev', mdf_float, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- #ifdef tropomi
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'hybrid level at layer midpoints' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'level' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call mdf_put_att( RF%ncid, varid, 'positive', 'down' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'formula', 'hyam hybm (mlev=hyam+hybm*ps)' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'formula_terms', 'ap: hyam b: hybm ps: ps' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- #else
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'level' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- #endif
- RF%varid_lev = varid
- call MDF_Def_Var( RF%ncid, 'time', mdf_double, (/RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'days since 1950-01-01 00:00:00' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'calender', 'gregorian' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_time = varid
- allocate(RF%time(rf%n_rec))
- call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_date = varid
- allocate(RF%date(6,rf%n_rec))
-
- call MDF_Def_Var( RF%ncid, 'ps', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'surface_air_pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'surface pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_ps = varid
- allocate( RF%sp(i1:i2, j1:j2, rf%n_rec) )
- #ifndef tropomi
- call MDF_Def_Var( RF%ncid, 't', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'air_temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'K' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_put_att( RF%ncid, varid, 'comment', 'bottom-up; full levels' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_temp = varid
- allocate( RF%data3d_t(i1:i2, j1:j2, levi%nlev, rf%n_rec) )
- #endif
- #ifdef tropomi
- ! Extra temperature field output
- ! with compression - crash
- !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)
- call MDF_Def_Var( RF%ncid, 't', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_lev, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'air_temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'temperature' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'K' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_put_att( RF%ncid, varid, 'comment', 'bottom-up; full levels' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_temp = varid
- allocate( RF%data3d_t(i1:i2, j1:j2, levi%nlev, rf%n_rec) )
- ! Extra surface elevation output, retrieved from GPH (meteo.f90) and g0 (binas.f90) following WGS84?
- call MDF_Def_Var( RF%ncid, 'surface_altitude', MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'surface_altitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'surface altitude of TM5 grid' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'm' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_put_att( RF%ncid, varid, 'comment', 'ECMWF interpolated orography' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_hgt = varid
- allocate( RF%data2d_hgt(i1:i2, j1:j2) )
- ! Extra tropopause level output, retrieved from GPH and temperature (meteo.f90)
- call MDF_Def_Var( RF%ncid, 'tropopause_layer_index', MDF_INT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'tropopause_layer_index' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'index of the highest model layer in the troposphere' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', '-' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_put_att( RF%ncid, varid, 'comment', 'Based on WMO temperature gradient method' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_ltropo = varid
- allocate( RF%data2d_ltropo(i1:i2, j1:j2, rf%n_rec) )
- #endif
- ! loop over tracer to be written:
- do k = 1, RF%ntr
- #ifdef with_m7
- if( RF%lpmx(k) ) then
- ! get diameter
- write(csize,'(F5.1)') RF%sizepmx(k)
- ! remove leading blanks
- csize = adjustl(csize)
- pospoint = index(csize,'.')
- posend = len_trim(csize)
- ! CF standard name for concentration/mixing ratio/column:
- RF%varid_type(k) = 'conc'
- varname_spec = 'pm'//csize(1:pospoint-1)//'p'//csize(pospoint+1:posend)
- cf_spec_stnd = 'particulate_matter_'//trim(csize)
- cf_spec_long = 'particulate matter diameter le '//trim(csize)//' micrometers'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- else
- #endif
- ! ----------------------------
- ! setting defaults (gas phase)
- ! ----------------------------
- ! CF standard name for concentration/mixing ratio/column:
- cf_enti_stnd = 'mole_fraction'
- #ifdef tropomi
- cf_enti_unit = '1'
- #else
- cf_enti_unit = 'mole mole-1'
- #endif
- cf_enti_long = 'volume mixing ratio'
- cf_medium_stnd = 'in_air'
- cf_medium_long = 'in humid air'
- RF%varid_type(k) = 'mixr'
- ! global tracer index
- itr = RF%itr(k)
- ! no comment yet
- comment = ''
- ! standard names from CF conventions:
- select case ( strlowercase(RF%name_tr(k)) )
- case ( 'co2' )
- varname_spec = 'co2'
- cf_spec_stnd = 'carbon_dioxide'
- cf_spec_long = 'CO2'
- case ( 'co' )
- varname_spec = 'co'
- cf_spec_stnd = 'carbon_monoxide'
- cf_spec_long = 'CO'
- case ( 'o3' )
- varname_spec = 'o3'
- cf_spec_stnd = 'ozone'
- cf_spec_long = 'O3'
- case ( 'o3s' )
- varname_spec = 'o3s'
- cf_spec_stnd = 'ozone_from_stratosphere'
- cf_spec_long = 'O3s'
- case ( 'no' )
- varname_spec = 'no'
- cf_spec_stnd = 'nitrogen_monoxide'
- cf_spec_long = 'NO'
- case ( 'no2' )
- varname_spec = 'no2'
- cf_spec_stnd = 'nitrogen_dioxide'
- cf_spec_long = 'NO2'
- case ( 'noy' )
- varname_spec = 'noy'
- cf_spec_stnd = 'nitrogen_oxides'
- cf_spec_long = 'NOy'
- comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
- 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
- case ( 'ch2o', 'choh' )
- varname_spec = 'ch2o'
- cf_spec_stnd = 'formaldehyde'
- cf_spec_long = 'CH2O'
- case ( 'so2' )
- varname_spec = 'so2'
- cf_spec_stnd = 'sulfur_dioxide'
- cf_spec_long = 'SO2'
- case( 'h2so4' )
- varname_spec = 'h2so4'
- cf_spec_stnd = 'sulfuric_acid_g'
- cf_spec_long = 'H2SO4 (g)'
- !!$ case ( 'so4' )
- !!$ varname_spec = 'so4'
- !!$ cf_spec_stnd = 'sulfate_as_sulfate_dry_aerosol'
- !!$ cf_spec_long = 'SO4'
- case ( 'ch4' )
- varname_spec = 'ch4'
- cf_spec_stnd = 'methane'
- cf_spec_long = 'CH4'
- case ( 'oh' )
- varname_spec = 'oh'
- cf_spec_stnd = 'hydroxyl_radical'
- cf_spec_long = 'OH'
- case ( 'h2o2' )
- varname_spec = 'h2o2'
- cf_spec_stnd = 'hydrogen_peroxide'
- cf_spec_long = 'H2O2'
- case ( 'hno3' )
- varname_spec = 'hno3'
- cf_spec_stnd = 'nitric_acid'
- cf_spec_long = 'HNO3'
- case ( 'hno4' )
- varname_spec = 'hno4'
- cf_spec_stnd = 'peroxonitric_acid'
- cf_spec_long = 'HNO4'
- case ( 'n2o5' )
- varname_spec = 'n2o5'
- cf_spec_stnd = 'nitrogen_pentoxide'
- cf_spec_long = 'N2O5'
- case ( 'par' )
- varname_spec = 'par'
- cf_spec_stnd = 'paraffinic_carbon_atoms'
- cf_spec_long = 'PAR'
- case ( 'eth' )
- varname_spec = 'eth'
- cf_spec_stnd = 'ethylene'
- cf_spec_long = 'ETH'
- case ( 'ole' )
- varname_spec = 'ole'
- cf_spec_stnd = 'olefinic_carbon_bonds'
- cf_spec_long = 'OLE'
- case ( 'ald2' )
- varname_spec = 'ald2'
- cf_spec_stnd = 'acetaldehyde_and_higher_aldehydes'
- cf_spec_long = 'ALD2'
- case ( 'mgly' )
- varname_spec = 'mgly'
- cf_spec_stnd = 'methylglyoxal'
- cf_spec_long = 'MGLY'
- case ( 'isop' )
- varname_spec = 'isop'
- cf_spec_stnd = 'isoprene'
- cf_spec_long = 'ISOP'
- case ( 'nh3' )
- varname_spec = 'nh3'
- cf_spec_stnd = 'ammonia'
- cf_spec_long = 'NH3'
- case ( 'ORGNTR','orgntr' )
- varname_spec = 'orgntr'
- cf_spec_stnd = 'organic_nitrate'
- cf_spec_long = 'ORGNTR'
- case ( 'pan' )
- varname_spec = 'pan'
- cf_spec_stnd = 'peroxyacetyl_nitrate'
- cf_spec_long = 'PAN'
- case ( 'terp' )
- varname_spec = 'terp'
- cf_spec_stnd = 'terpene'
- cf_spec_long = 'TERP'
- case ( 'elvoc' )
- varname_spec = 'elvoc'
- cf_spec_stnd = 'extremely low volatile OC'
- cf_spec_long = 'ELVOC'
- case ( 'svoc' )
- varname_spec = 'svoc'
- cf_spec_stnd = 'semi volatile OC'
- cf_spec_long = 'SVOC'
- case ( 'rn', 'radon', 'rn222' )
- varname_spec = 'rn'
- cf_spec_stnd = 'radon'
- cf_spec_long = 'Rn'
- case ( 'pb', 'lead', 'pb210' )
- varname_spec = 'pb'
- cf_spec_stnd = 'lead'
- cf_spec_long = 'Pb'
- #ifdef with_m7
- ! Sulphate
- case( 'tso4' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'so4'
- cf_spec_stnd = 'total_sulphate_aerosol'
- cf_spec_long = 'SO4'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Black Carbon
- case( 'tbc' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'bc'
- cf_spec_stnd = 'total_black_carbon_aerosol'
- cf_spec_long = 'BC'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Particulate Organic Matter
- case( 'tpom' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'pom'
- cf_spec_stnd = 'total_particulate_organic_matter_aerosol'
- cf_spec_long = 'POM'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Sea Salt
- case( 'tss' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'ss'
- cf_spec_stnd = 'total_sea_salt_aerosol'
- cf_spec_long = 'SS'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Dust
- case( 'tdu' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'du'
- cf_spec_stnd = 'total_dust_aerosol'
- cf_spec_long = 'SS'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Nucleation Soluble (nus): number, SO4
- case ( 'nus_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'nus_n'
- cf_spec_stnd = 'number_wet_nucleation'
- cf_spec_long = 'Number_nus'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'so4nus' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'so4nus'
- cf_spec_stnd = 'sulphate_wet_nucleation'
- cf_spec_long = 'SO4_nus'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'soanus' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'soanus'
- cf_spec_stnd = 'SOA_wet_nucleation'
- cf_spec_long = 'SOA_nus'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Aitken Soluble (ais): number, SO4, BC, POM
- case ( 'ais_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'ais_n'
- cf_spec_stnd = 'number_wet_aitken'
- cf_spec_long = 'Number_ais'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'so4ais' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'so4ais'
- cf_spec_stnd = 'sulphate_wet_aitken'
- cf_spec_long = 'SO4_ais'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'bcais' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'bcais'
- cf_spec_stnd = 'black_carbon_wet_aitken'
- cf_spec_long = 'BC_ais'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'pomais' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'pomais'
- cf_spec_stnd = 'particulate_organic_matter_wet_aitken'
- cf_spec_long = 'POM_ais'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'soaais' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'soaais'
- cf_spec_stnd = 'SOA_dry_Aitken'
- cf_spec_long = 'SOA_ais'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Accumulation Soluble (acs): number, SO4, BC, POM, SS, DU
- case ( 'acs_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'acs_n'
- cf_spec_stnd = 'number_wet_accumulation'
- cf_spec_long = 'Number_acs'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'so4acs' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'so4acs'
- cf_spec_stnd = 'sulphate_wet_accumulation'
- cf_spec_long = 'SO4_acs'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'bcacs' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'bcacs'
- cf_spec_stnd = 'black_carbon_wet_accumulation'
- cf_spec_long = 'BC_acs'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'pomacs' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'pomacs'
- cf_spec_stnd = 'particulate_organic_matter_wet_accumulation'
- cf_spec_long = 'POM_acs'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'ssacs' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'ssacs'
- cf_spec_stnd = 'seasalt_wet_accumulation'
- cf_spec_long = 'SS_acs'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'duacs' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'duacs'
- cf_spec_stnd = 'dust_wet_accumulation'
- cf_spec_long = 'DU_acs'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'soaacs' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'soaacs'
- cf_spec_stnd = 'SOA_dry_Accumulation'
- cf_spec_long = 'SOA_acs'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
-
- ! Coarse Soluble (cos): number, SO4, BC, POM, SS, DU
- case ( 'cos_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'cos_n'
- cf_spec_stnd = 'number_wet_coarse'
- cf_spec_long = 'Number_cos'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'so4cos' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'so4cos'
- cf_spec_stnd = 'sulphate_wet_coarse'
- cf_spec_long = 'SO4_cos'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'bccos' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'bccos'
- cf_spec_stnd = 'black_carbon_wet_coarse'
- cf_spec_long = 'BC_cos'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'pomcos' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'pomcos'
- cf_spec_stnd = 'particulate_organic_matter_wet_coarse'
- cf_spec_long = 'POM_cos'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'sscos' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'sscos'
- cf_spec_stnd = 'seasalt_wet_coarse'
- cf_spec_long = 'SS_cos'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'ducos' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'ducos'
- cf_spec_stnd = 'dust_wet_coarse'
- cf_spec_long = 'DU_cos'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'soacos' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'soacos'
- cf_spec_stnd = 'SOA_dry_coarse'
- cf_spec_long = 'SOA_cos'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Aitken Insoluble (aii): number, BC, POM
- case ( 'aii_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'aii_n'
- cf_spec_stnd = 'number_dry_aitken'
- cf_spec_long = 'Number_aii'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'bcaii' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'bcaii'
- cf_spec_stnd = 'black_carbon_dry_aitken'
- cf_spec_long = 'BC_aii'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'pomaii' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'pomaii'
- cf_spec_stnd = 'particulate_organic_matter_dry_aitken'
- cf_spec_long = 'POM_aii'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'soaaii' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'soaaii'
- cf_spec_stnd = 'SOA_dry_Aitken'
- cf_spec_long = 'SOA_aii'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Accumulation Insoluble (aci): number, DU
- case ( 'aci_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'aci_n'
- cf_spec_stnd = 'number_dry_accumulation'
- cf_spec_long = 'Number_aci'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'duaci' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'duaci'
- cf_spec_stnd = 'dust_dry_accumulation'
- cf_spec_long = 'DU_aci'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- ! Coarse Insoluble (coi): number, DU
- case ( 'coi_n' )
- RF%varid_type(k) = 'numb'
- varname_spec = 'coi_n'
- cf_spec_stnd = 'number_dry_coarse'
- cf_spec_long = 'Number_coi'
- cf_enti_stnd = 'number'
- cf_enti_unit = '1.'
- cf_enti_long = ''
- case ( 'ducoi' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'ducoi'
- cf_spec_stnd = 'dust_dry_coarse'
- cf_spec_long = 'DU_coi'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- #endif
- case ( 'nh4' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'nh4'
- cf_spec_stnd = 'ammonium_as_ammonium_dry_aerosol'
- cf_spec_long = 'NH4'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- case ( 'no3_a' )
- RF%varid_type(k) = 'conc'
- varname_spec = 'no3'
- cf_spec_stnd = 'nitrate_as_nitrate_dry_aerosol'
- cf_spec_long = 'NO3'
- cf_enti_stnd = 'concentration'
- cf_enti_unit = 'kg m-3 '
- cf_enti_long = 'mass per volume'
- !!$ case ( 'bc' )
- !!$ varname_spec = 'bc'
- !!$ cf_spec_stnd = 'black_carbon_dry_aerosol'
- !!$ cf_spec_long = 'BC'
- !!$ case ( 'BCS', 'bcs' )
- !!$ varname_spec = 'bcs'
- !!$ cf_spec_stnd = 'hydrophilic_black_carbon_dry_aerosol'
- !!$ cf_spec_long = 'BC(aq)'
- !!$ case ( 'POM', 'pom' )
- !!$ varname_spec = 'om'
- !!$ cf_spec_stnd = 'organic_carbon_as_particulate_organic_matter_dry_aerosol'
- !!$ cf_spec_long = 'OM'
- !!$ case ( 'SS1_N', 'ss1_n' )
- !!$ varname_spec = 'ss1_n'
- !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode1_number'
- !!$ cf_spec_long = 'SS1_n'
- !!$ case ( 'SS1_M', 'ss1_m' )
- !!$ varname_spec = 'ss1_m'
- !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode1_mass'
- !!$ cf_spec_long = 'SS1_m'
- !!$ case ( 'SS2_N', 'ss2_n' )
- !!$ varname_spec = 'ss2_n'
- !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode2_number'
- !!$ cf_spec_long = 'SS2_n'
- !!$ case ( 'SS2_M', 'ss2_m' )
- !!$ varname_spec = 'ss2_m'
- !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode2_mass'
- !!$ cf_spec_long = 'SS2_m'
- !!$ case ( 'SS3_N', 'ss3_n' )
- !!$ varname_spec = 'ss3_n'
- !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode3_number'
- !!$ cf_spec_long = 'SS3_n'
- !!$ case ( 'SS3_M', 'ss3_m' )
- !!$ varname_spec = 'ss3_m'
- !!$ cf_spec_stnd = 'seasalt_dry_aerosol_mode3_mass'
- !!$ cf_spec_long = 'SS3_m'
- !!$ case ( 'DUST2_N', 'dust2_n' )
- !!$ varname_spec = 'dust2_n'
- !!$ cf_spec_stnd = 'dust_dry_aerosol_mode2_number'
- !!$ cf_spec_long = 'DUST2_n'
- !!$ case ( 'DUST2_M', 'dust2_m' )
- !!$ varname_spec = 'dust2_m'
- !!$ cf_spec_stnd = 'dust_dry_aerosol_mode2_madust'
- !!$ cf_spec_long = 'DUST2_m'
- !!$ case ( 'DUST3_N', 'dust3_n' )
- !!$ varname_spec = 'dust3_n'
- !!$ cf_spec_stnd = 'dust_dry_aerosol_mode3_number'
- !!$ cf_spec_long = 'DUST3_n'
- !!$ case ( 'DUST3_M', 'dust3_m' )
- !!$ varname_spec = 'dust3_m'
- !!$ cf_spec_stnd = 'dust_dry_aerosol_mode3_madust'
- !!$ cf_spec_long = 'DUST3_m'
- case default
- write (gol,'("do not know how to match tracer with CF standard names : ",a)') RF%name_tr(k); call goErr
- TRACEBACK; status=1; return
- end select
- #ifdef with_m7
- end if ! RF%lpmx(k)
- #endif
- ! define variable:
- call MDF_Def_Var( RF%ncid, trim(varname_spec), MDF_FLOAT, &
- (/RF%dimid_lon,RF%dimid_lat,RF%dimid_lev,RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! total names:
- cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)//'_'//trim(cf_medium_stnd)
- cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)//' '//trim(cf_medium_long)
- cf_name_unit = trim(cf_enti_unit)
- ! write attributes:
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', trim(cf_name_stnd) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', trim(cf_name_long) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', trim(cf_name_unit) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! moleweights; ra from chem_param is in g/mol .
- if ( itr <= ntrace .and. itr > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- else
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
-
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( len_trim(comment) > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- ! store varid
- RF%varid_tr(k) = varid
- end do
- ! storage
- allocate(rf%data3d(i1:i2,j1:j2,lmr,rf%n_rec,rf%ntr))
- ! o end defintion mode
- call MDF_EndDef( RF%ncid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o
- ! no records written yet
- RF%trec = 0
- call goLabel()
- status = 0
- END SUBROUTINE RF_VMR_Init
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_VMR_Write
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_VMR_Write( RF, region, idate_f, status )
- !
- ! !USES:
- !
- use Binas, only : xmair
- use GO, only : TDate, NewDate, rTotal, operator(-)
- use binas, only : Rgas
- use chem_param, only : ntrace, ntracet, fscale, ra
- use tracer_data, only : mass_dat, chem_dat
- use Grid, only : FPressure
- use MeteoData, only : global_lli, levi, m_dat, sp_dat, temper_dat
- #ifdef tropomi
- use MeteoData, only : gph_dat
- use toolbox, only : ltropo_ifs, lvlpress
- #endif
- #ifdef with_m7
- use calc_pm, only : PMx_Integrate_3d
- #endif
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_VMR), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- ! 2 Oct 2012 - Ph. Le Sager - adapted for lat-lon mpi decomp
- ! - no more sub-regions available
- !
- ! !REMARKS:
- ! (1)
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_VMR_Write'
- ! --- local ------------------------------------
- integer :: imr, jmr, lmr, i1, i2, j1, j2, i, j
- real, allocatable :: lev(:)
- integer :: l
- type(TDate) :: t, t0
- real :: time
- integer :: k, itr, dsec
- integer :: k_comp, itr_comp
- integer :: ims, ime, jms, jme, lms, lme
- integer :: gimr, gjmr, glmr
- real, allocatable :: compo_k(:,:,:)
- real, allocatable :: field_k(:,:,:)
- real, allocatable :: pres3d(:,:,:), pmx(:,:,:)
- integer :: numtrac
- integer :: listtrac(10)
- ! --- begin -------------------------------------
- ! for multiple of timestep only ...
- dsec = idate_f(4)*3600 + idate_f(5)*60 + idate_f(6)
-
- if ( modulo(dsec,RF%dsec) /= 0 ) then
- status=0; return
- end if
-
- call goLabel(rname)
- ! grid sizes
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr=i2-i1+1
- jmr=j2-j1+1
- lmr = levi%nlev
-
- gimr = global_lli(region)%nlon
- gjmr = global_lli(region)%nlat
- ! yet to change ??
- lms = 1
- lme = levi%nlev
- lmr = levi%nlev
- glmr = levi%nlev
- #ifdef with_m7
- ! get helping pressure field in 3d
- allocate( pres3d(i1:i2,j1:j2,lmr) )
- ! fill mid level pressure
- call FPressure( levi, sp_dat(region)%data(i1:i2,j1:j2,1), pres3d, status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! next time record:
- RF%trec = RF%trec + 1
- if(isRoot.and.okdebug)then
- write(gol,*) "RF_VMR_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
- end if
- ! time since 1950-1-1 00:00
- t0 = NewDate( time6=time_reftime6 )
- t = NewDate( time6=idate_f )
- time = rTotal( t - t0, 'day' )
-
- ! only once ...
- if ( RF%trec == 1 ) then
-
- ! write longitudes:
- call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! write latitudes:
- call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! write level indices:
- allocate( lev(lmr) )
- do l = lms, lme
- lev(l) = real(l)
- end do
- call MDF_Put_Var( RF%ncid, RF%varid_lev, lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- deallocate(lev)
- #ifdef tropomi
- ! As and Bs interfaces
- call MDF_Put_Var( RF%ncid, RF%varid_hyai, levi%a(0:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_hybi, levi%b(0:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! As and Bs mid-level (full level)
- call MDF_Put_Var( RF%ncid, RF%varid_hyam, levi%fa(1:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_hybm, levi%fb(1:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- #else
- ! As and Bs
- call MDF_Put_Var( RF%ncid, RF%varid_a_bnds, levi%a(0:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_b_bnds, levi%b(0:levi%nlev) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- #endif
- end if ! first record
- RF%time(RF%trec) = time
- RF%date(:,RF%trec) = real(idate_f)
- RF%sp(:,:,RF%trec) = sp_dat(region)%data(i1:i2,j1:j2,1)
- #ifdef tropomi
- ! copy of temperature field
- RF%data3d_t(:,:,:,RF%trec) = temper_dat(region)%data(i1:i2,j1:j2,1:lmr)
- ! orography: copy of lowest interface gph field. gph in the model is in "m", at interfaces, and gph(1)=oro
- ! only once ...
- if ( RF%trec == 1 ) then
- RF%data2d_hgt(:,:) = gph_dat(region)%data(i1:i2,j1:j2,1)
- end if
- ! compute highest tropopause layer index
- do i = i1, i2
- do j = j1, j2
- RF%data2d_ltropo(i,j,RF%trec) = ltropo_ifs(region,i,j,temper_dat(region)%data(i,j,1:lmr),lmr)
- end do
- end do
- #endif
- ! loop over all tracers to be written:
- do k = 1, RF%ntr
- ! global tracer index:
- itr = RF%itr(k)
- #ifdef with_m7
- ! ---------------------
- ! particulate matter
- ! ---------------------
- if( RF%lpmx(k) ) then
- allocate( pmx( i1:i2, j1:j2, 1:lmr ) ) ; pmx = 0.0
- call PMx_Integrate_3d( region, RF%sizepmx(k), pmx, status )
- IF_NOTOK_RETURN(status=1)
- rf%data3d(:,:,:, rf%trec, k) = pmx
-
- ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
- ! reshape( pmx(i1:i2,j1:j2,lms:lme), (/imr,jmr,lmr,1/) ), status &
- ! start=(/i1,j1,1,RF%trec/), count=(/imr,jmr,lmr,1/) )
- deallocate( pmx )
- else
- #endif
-
- ! ---------
- ! transported or chemistry only ?
- ! ---------
- select case( itr )
- case( 1:ntracet )
-
- ! ----------------------------------------------------
- ! distinguish between mixing ratios and concentrations
- ! ----------------------------------------------------
- select case( RF%varid_type(k) )
- case( 'conc' )
- ! write slab of concentrations
- ! m(trace) pressure xm(trace)
- ! C = -------- * fscale * ----------- * ---------
- ! m(air) temperature Rgas
- ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
- ! reshape( mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr) / &
- ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
- ! pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
- ! Rgas, (/imr,jmr,lmr,1/) ), &
- ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
- #ifdef with_m7
-
- rf%data3d(:,:,:, rf%trec, k) = mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr) / &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
- pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
- Rgas
- #else
- write(gol,*)"Not using m7 - did not expected to be here."; call goErr
- write(gol,*)" - make pres3d available"; call goErr
- status=1; TRACEBACK; return
- #endif
-
- case( 'mixr' )
- ! write slab of volume mixing ratios
- ! m(trace)
- ! X = -------- * fscale
- ! m(air)
- ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
- ! reshape( mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr)/ &
- ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr), &
- ! (/imr,jmr,lmr,1/) ), &
- ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
- rf%data3d(:,:,:, rf%trec, k) = mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr)/ &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr)
-
- case( 'numb' )
- ! write slab of concentrations
- ! number(trace) pressure #/gridcell Pa*K*mol
- ! C = ------------- * molmass_air * ---------------- = ------------- * kg/mol *-----------
- ! m(air) temperature*Rgas kg/gridcell K*J
- #ifdef with_m7
- rf%data3d(:,:,:, rf%trec, k) = mass_dat(region)%rm(i1:i2,j1:j2,lms:lme,itr) / &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
- pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
- Rgas
- #else
- write(gol,*)"Not using m7 - did not expected to be here."; call goErr
- write(gol,*)" - make pres3d available"; call goErr
- status=1; TRACEBACK; return
- #endif
- case default
- write (gol,'("no such unit type",a)') RF%varid_type(k); call goErr
- status=1
- end select
- ! IF_NOTOK_MDF(fid=RF%ncid)
-
- ! ---------
- case( ntracet+1:ntrace )
- ! ---------
- ! ----------------------------------------------------
- ! distinguish between mixing ratios and concentrations
- ! ----------------------------------------------------
- select case( RF%varid_type(k) )
- case( 'conc' )
- ! write slab of concentrations
- ! m(trace) pressure xm(trace)
- ! C = -------- * fscale * ----------- * ---------
- ! m(air) temperature Rgas
- ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
- ! reshape( chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr) / &
- ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
- ! pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
- ! Rgas, (/imr,jmr,lmr,1/) ), &
- ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
- #ifdef with_m7
- rf%data3d(:,:,:, rf%trec, k) = chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr) / &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * xmair * 1.E-03 * &
- pres3d(i1:i2,j1:j2,lms:lme) / temper_dat(region)%data(i1:i2,j1:j2,lms:lme) / &
- Rgas
- #else
- write(gol,*)"Not using m7 - did not expected to be here."; call goErr
- write(gol,*)" - make pres3d available"; call goErr
- status=1; TRACEBACK; return
- #endif
-
- case( 'mixr' )
- ! write slab of volume mixing ratios
- ! m(trace)
- ! X = -------- * fscale
- ! m(air)
- ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
- ! reshape( chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr)/ &
- ! m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr), &
- ! (/imr,jmr,lmr,1/) ), &
- ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
- rf%data3d(:,:,:, rf%trec, k) = chem_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr)/ &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * fscale(itr)
-
- case default
- write (gol,'("no such unit type",a)') RF%varid_type(k); call goErr
- status=1
- end select
-
- IF_NOTOK_MDF(fid=RF%ncid)
- ! ---------
- ! NOy and others (M7)
- ! ---------
- #ifdef with_m7
- case( iNOy, iSO4, iBC, iPOM, iSS, iDU )
- #else
- case( iNOy )
- #endif
- listtrac(:) = -999
- select case( itr )
- case( iNOy ); numtrac = nNOyt; listtrac(1:nNOyt) = iNOyt
- #ifdef with_m7
- case( iSO4 ); numtrac = nSO4t; listtrac(1:nSO4t) = iSO4t
- case( iBC ); numtrac = nBCt ; listtrac(1:nBCt ) = iBCt
- case( iPOM ); numtrac = nPOMt; listtrac(1:nPOMt) = iPOMt
- case( iSS ); numtrac = nSSt ; listtrac(1:nSSt ) = iSSt
- case( iDU ); numtrac = nDUt ; listtrac(1:nDUt ) = iDUt
- #endif
- end select
- ! mole fraction = sum of mole fractions of components
- ! storage for sum of components (distributed over levels):
- allocate( Compo_k(i1:i2,j1:j2,lmr) )
- ! 3d fields with all levels or local levels only:
- allocate( field_k(i1:i2,j1:j2,lmr) )
- ! loop over transported components:
- Compo_k = 0.0
- do k_comp = 1, numtrac
- ! no more components??
- if( listtrac(k_comp) < 0 ) exit
- ! global tracer index:
- itr_comp = listtrac(k_comp)
- ! check ...
- if ( itr_comp > ntracet ) then
- write (gol,'("index of NOy component does not represent a transported tracer : ",i3)') itr_comp; call goErr
- TRACEBACK; status=1; return
- end if
- ! ----------------------------------------------------
- ! distinguish between mixing ratios and concentrations
- ! ----------------------------------------------------
- select case( RF%varid_type(k) )
- case( 'conc' )
- ! calculate concentrations
- ! m(trace) pressure xm(trace)
- ! C = -------- * fscale * ----------- * ---------
- ! m(air) temperature Rgas
- #ifdef with_m7
- field_k = mass_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr_comp) / &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * &
- xmair * 1.E-03 * pres3d(i1:i2,j1:j2,1:lmr) / &
- temper_dat(region)%data(i1:i2,j1:j2,1:lmr) / Rgas
- #else
- write(gol,*)"Not using m7 - did not expected to be here."; call goErr
- write(gol,*)" - make pres3d available"; call goErr
- status=1; TRACEBACK; return
- #endif
- case( 'mixr' )
- ! m(trace)
- ! X = -------- * fscale
- ! m(air)
- field_k = mass_dat(region)%rm(i1:i2,j1:j2,1:lmr,itr_comp) / &
- m_dat(region)%data(i1:i2,j1:j2,lms:lme) * &
- fscale(itr_comp)
- case default
- write (gol,'("no such unit type",a)') RF%varid_type(k); call goErr
- TRACEBACK; status=1; return
- end select
- ! add contribution of this component:
- Compo_k = Compo_k + field_k
- end do
- ! write slab of volume mixing ratio's:
- ! call MDF_Put_Var( RF%ncid, RF%varid_tr(k), &
- ! reshape( Compo_k, (/imr,jmr,lmr,1/) ), &
- ! status, start=(/i1,j1,lms,RF%trec/), count=(/imr,jmr,lmr,1/) )
- ! IF_NOTOK_MDF(fid=RF%ncid)
- rf%data3d(:,:,:, rf%trec, k) = Compo_k
- ! clear
- deallocate( Compo_k )
- deallocate( field_k )
- ! -------------------
- case default
- ! -------------------
- write (gol,'("strange tracer index requested : ",i6)') itr; call goErr
- TRACEBACK; status=1; return
- end select
- #ifdef with_m7
- endif
- #endif
- end do ! tracer
- !----------------
- ! WRITE
- !----------------
- if ( RF%trec == rf%n_rec ) then
- call MDF_Put_Var( RF%ncid, RF%varid_time, rf%time, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_date, rf%date, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! surface presure
- call MDF_Put_Var( RF%ncid, RF%varid_ps, rf%sp, status, start=(/i1,j1,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! temperature (3d)
- 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/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- #ifdef tropomi
- if ( isRoot ) then
- write (gol,'(a,2i4)') 'PDUMP - writing fields T, hgt, ltropo, no2, so2, hcho; trec, n_rec ', RF%trec, rf%n_rec
- call goPr
- end if
- ! temperature (3d)
- 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/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! surface altitude (2d)
- call MDF_Put_Var( RF%ncid, RF%varid_hgt, RF%data2d_hgt(:,:), status, start=(/i1,j1/), count=(/imr,jmr/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! highest tropopause level (2d)
- call MDF_Put_Var( RF%ncid, RF%varid_ltropo, RF%data2d_ltropo(:,:,:), status, start=(/i1,j1,1/), count=(/imr,jmr,RF%n_rec/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- #endif
- ! vmr
- do k = 1, RF%ntr
- call MDF_Put_Var( RF%ncid, RF%varid_tr(k), RF%data3d(:,:,:,:,k), status, start=(/i1,j1,1,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- end do
- end if
- !----------------
- ! DONE
- !----------------
- #ifdef with_m7
- deallocate(pres3d)
- #endif
- call goLabel()
- status = 0
- END SUBROUTINE RF_VMR_Write
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_VMR_Done
- !
- ! !DESCRIPTION: close file #3
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_VMR_Done( RF, status )
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_VMR), intent(inout) :: RF
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_VMR_Done'
- ! --- begin -------------------------------------
- call goLabel(rname)
-
- call MDF_Close( RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- deallocate(rf%date, rf%time, rf%sp, rf%data3d )
- deallocate(rf%data3d_t)
- #ifdef tropomi
- deallocate(rf%data2d_hgt)
- deallocate(rf%data2d_ltropo)
- #endif
-
- call goLabel() ; status = 0
- END SUBROUTINE RF_VMR_Done
- !EOC
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ! FILE: 2D LT output
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_LT_Init
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine RF_LT_Init( RF, fdir, model, expid, filetype, region, &
- idate_f, local_time, tracer_names, status )
- !
- ! !USES:
- !
- use Binas, only : xmair
- use GO, only : goReadFromLine, goUpCase
- use GO, only : NewDate
- use dims, only : im, jm
- use chem_param, only : ntrace, names, ra
- use partools, only : MPI_INFO_NULL, localComm
- use MeteoData, only : global_lli, levi, sp_dat, Set
- !
- ! !OUTPUT PARAMETERS:
- !
- type(TPdumpFile_LT), intent(out) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in) :: fdir
- character(len=*), intent(in) :: model
- character(len=*), intent(in) :: expid
- character(len=*), intent(in) :: filetype
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- integer, intent(in) :: local_time
- character(len=*), intent(in) :: tracer_names
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_LT_Init'
- ! --- local ------------------------------------
- character(len=256) :: fname
- integer :: varid
- integer :: imr, jmr, lmr
- character(len=256) :: trnames
- character(len=8) :: trname, tmname
- character(len=3) :: cwavel
- integer :: k, itr, i1, i2, j1, j2
- character(len=32) :: varname, varname_enti, varname_spec
- character(len=64) :: cf_medium_stnd, cf_medium_long
- character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
- character(len=64) :: cf_spec_stnd, cf_spec_long
- character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
- character(len=512) :: comment
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! store arguments
- RF%local_time = local_time
- RF%tracer_names = tracer_names
- ! set tracer index for requested tracers:
- write (gol,'("selected tracers for LT output:")'); call goPr
- RF%ntr = 0
- #ifdef with_m7
- RF%laod = .false.
- RF%wavel = -1.0
- #endif
- RF%itr = -1
- trnames = tracer_names
- do
- ! empty ?
- if ( len_trim(trnames) == 0 ) exit
-
- ! next number:
- if ( RF%ntr == ntrace ) then
- write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
- TRACEBACK; status=1; return
- end if
- RF%ntr = RF%ntr + 1
- ! extract leading name:
- call goReadFromLine( trnames, trname, status, sep=' ' )
- IF_NOTOK_RETURN(status=1)
- #ifdef with_m7
-
- ! ---------------------------
- ! check for AOD
- ! ---------------------------
- if( strlowercase(trname(1:3)) == 'aod' ) then
- RF%laod(RF%ntr) = .true.
- RF%itr (RF%ntr) = -1
- ! paste size to real
- read(trname(5:len_trim(trname)), * ) RF%wavel(RF%ntr)
- else
- #endif
- ! convert to tm5 name:
- select case ( trim(strlowercase(trname)) )
- case ( 'hcho' ) ; tmname = 'CH2O'
- case ( 'rn', 'radon' ) ; tmname = 'Rn222'
- case ( 'pb', 'lead' ) ; tmname = 'Pb210'
- case default ; tmname = trname
- end select
- ! NOy is a special ...
- select case ( trim(strlowercase(tmname)) )
- case ( 'NOy' )
- ! defined as ntrace+1
- RF%itr(RF%ntr) = iNOy
- write (gol,'(" * ",a10)') trim(trname); call goPr
- case default
- ! loop over all names:
- RF%itr(RF%ntr) = -1
- do itr = 1, ntrace
- ! case indendent match ?
- if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
- write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4)') itr, trim(trname), trim(names(itr)), ra(itr); call goPr
- RF%itr(RF%ntr) = itr
- exit
- end if
- end do
- end select ! not found ?
- if ( RF%itr(RF%ntr) < 0 ) then
- write (gol,'("tracer name not supported:")'); call goPr
- write (gol,'(" list all : ",a)') trim(tracer_names); call goPr
- write (gol,'(" list element : ",i3)') RF%ntr; call goPr
- write (gol,'(" pdump name : ",a)') trim(trname); call goPr
- write (gol,'(" tm5 name : ",a)') trim(tmname); call goPr
- write (gol,'(" tm5 tracers : ")'); call goPr
- do itr = 1, ntrace
- write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
- end do
- TRACEBACK; status=1; return
- end if
- #ifdef with_m7
- end if ! aod
- #endif
- ! store pdump name:
- RF%name_tr(RF%ntr) = trname
- end do
-
- ! empty file ?
- if ( RF%ntr < 1 ) then
- write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
- TRACEBACK; status=1; return
- end if
- ! grid size
- imr = global_lli(region)%nlon
- jmr = global_lli(region)%nlat
- lmr = levi%nlev
- ! o open file
- ! write filename
- write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
- trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
- ! open:
- #ifdef MPI
- ! overwrite existing files (clobber), provide MPI stuff:
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
- mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
- if (status/=0) then
- write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
- write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
- TRACEBACK; status=1; return
- end if
- #else
- ! overwrite existing files (clobber)
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- #endif
-
- ! o global attributes
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'local time output' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'file_version_number', trim(outfileversnr) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define dimensions
- call MDF_Def_Dim( RF%ncid, 'lon' , global_lli(region)%nlon, RF%dimid_lon , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lat' , global_lli(region)%nlat, RF%dimid_lat , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lev' , levi%nlev , RF%dimid_lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'time' , 1 , RF%dimid_time , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'datelen', 6 , RF%dimid_datelen, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define variables
- call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_east', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lon = varid
- call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_north', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lat = varid
- call MDF_Def_Var( RF%ncid, 'lev', mdf_float, (/RF%dimid_lev/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'level' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , '1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- 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)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lev = varid
- call MDF_Def_Var( RF%ncid, 'time', mdf_float, (/RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'days since 1950-01-01 00:00:00', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'calender' , 'gregorian' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_time = varid
- call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', 'year, month, day, hour, minute, second' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_date = varid
- call MDF_Def_Var( RF%ncid, 'ps', MDF_FLOAT, &
- (/RF%dimid_lon,RF%dimid_lat,RF%dimid_time/), varid, status )
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'surface_air_pressure', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'surface pressure' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'Pa' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_ps = varid
- ! CF standard name for medium:
- cf_medium_stnd = 'in_air' ; cf_medium_long = 'in humid air'
- ! loop over tracer to be written:
- do k = 1, RF%ntr
- #ifdef with_m7
- if( RF%laod(k) ) then
- ! get diameter
- write(cwavel,'(I3)') RF%wavel(k)
- ! Aerosol Optical Depth (AOD):
- varname_spec = 'AOD@'//trim(cwavel)
- cf_spec_stnd = 'AOD at '//trim(cwavel)//'nm'
- cf_spec_long = 'aerosol optical depth at '//trim(cwavel)//' nanometer'
- cf_enti_stnd = 'aerosol_optical_depth'
- cf_enti_unit = '1'
- cf_enti_long = 'aerosol optical depth'
- else
- #endif
- ! global tracer index
- itr = RF%itr(k)
- ! ~~ local time species info
- ! CF standard name for concentration/mixing ratio/column:
- cf_enti_stnd = 'mole_fraction'
- cf_enti_unit = 'mole mole-1'
- cf_enti_long = 'volume mixing ratio'
- ! start of dataset name:
- varname_enti = 'dry'
- ! no comment yet
- comment = ''
- ! standard names from CF conventions:
- select case ( RF%name_tr(k) )
- case ( 'CO', 'co' )
- varname_spec = 'co'
- cf_spec_stnd = 'carbon_monoxide'
- cf_spec_long = 'CO'
- case ( 'O3', 'o3' )
- varname_spec = 'o3'
- cf_spec_stnd = 'ozone'
- cf_spec_long = 'O3'
- case ( 'O3s', 'o3s' )
- varname_spec = 'o3s'
- cf_spec_stnd = 'ozone_from_stratosphere'
- cf_spec_long = 'O3s'
- case ( 'NO', 'no' )
- varname_spec = 'no'
- cf_spec_stnd = 'nitrogen_monoxide'
- cf_spec_long = 'NO'
- case ( 'NO2', 'no2' )
- varname_spec = 'no2'
- cf_spec_stnd = 'nitrogen_dioxide'
- cf_spec_long = 'NO2'
- case ( 'NOy', 'noy' )
- varname_spec = 'noy'
- cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
- cf_spec_long = 'NOy'
- comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
- 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
- case ( 'CH2O', 'ch2o', 'CHOH', 'choh' )
- varname_spec = 'ch2o'
- cf_spec_stnd = 'formaldehyde'
- cf_spec_long = 'CH2O'
- case ( 'SO2', 'so2' )
- varname_spec = 'so2'
- cf_spec_stnd = 'sulfur_dioxide'
- cf_spec_long = 'SO2'
- case ( 'CH4', 'ch4' )
- varname_spec = 'ch4'
- cf_spec_stnd = 'methane'
- cf_spec_long = 'CH4'
- case ( 'OH', 'oh' )
- varname_spec = 'oh'
- cf_spec_stnd = 'hydroxyl_radical'
- cf_spec_long = 'OH'
- case ( 'H2O2', 'h2o2' )
- varname_spec = 'h2o2'
- cf_spec_stnd = 'hydrogen_peroxide'
- cf_spec_long = 'H2O2'
- case ( 'HNO3', 'hno3' )
- varname_spec = 'hno3'
- cf_spec_stnd = 'nitric_acid'
- cf_spec_long = 'HNO3'
- case ( 'NH3', 'nh3' )
- varname_spec = 'nh3'
- cf_spec_stnd = 'ammonia'
- cf_spec_long = 'NH3'
- case ( 'NH4', 'nh4' )
- varname_spec = 'nh4'
- cf_spec_stnd = 'ammonium'
- cf_spec_long = 'NH4'
- case ( 'ORGNTR','orgntr' )
- varname_spec = 'orgntr'
- cf_spec_stnd = 'organic_nitrate'
- cf_spec_long = 'ORGNTR'
- case ( 'PAN', 'pan' )
- varname_spec = 'pan'
- cf_spec_stnd = 'peroxyacetyl_nitrate'
- cf_spec_long = 'PAN'
- case ( 'Rn', 'rn', 'Radon', 'radon' )
- varname_spec = 'rn'
- cf_spec_stnd = 'radon'
- cf_spec_long = 'Rn'
- case ( 'Pb', 'pb', 'Lead', 'lead' )
- varname_spec = 'pb'
- cf_spec_stnd = 'lead'
- cf_spec_long = 'Pb'
- case default
- write (gol,'("do not know how to match tracer with CF standard names : ",a)') RF%name_tr(k); call goPr
- TRACEBACK; status=1; return
- end select
- #ifdef with_m7
- end if ! RF%laod(k)
- #endif
- ! define variable:
- call MDF_Def_Var( RF%ncid, trim(varname_spec), MDF_FLOAT, &
- (/RF%dimid_lon,RF%dimid_lat,RF%dimid_lev,RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! total names:
- cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)//'_'//trim(cf_medium_stnd)
- cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)//' '//trim(cf_medium_long)
- cf_name_unit = trim(cf_enti_unit)
- ! write attributes:
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', trim(cf_name_stnd) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', trim(cf_name_long) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units', trim(cf_name_unit) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
-
- if ( itr <= ntrace .and. itr > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- else
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_air', xmair*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_unit', 'kg mole-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( len_trim(comment) > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'comment', trim(comment) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
-
- ! store varid
- RF%varid_tr(k) = varid
-
- end do
- ! o end defintion mode
- call MDF_EndDef( RF%ncid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! no records written yet
- RF%trec = 0
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
-
- allocate(RF%accu (i1:i2, j1:j2, 1:lmr, RF%ntr)) ; RF%accu = 0
- allocate(RF%naccu (i1:i2, RF%ntr )) ; RF%naccu = 0
- allocate(RF%p_accu (i1:i2, j1:j2 )) ; RF%p_accu = 0
- allocate(RF%np_accu(i1:i2 )) ; RF%np_accu = 0
- call goLabel()
- status = 0
- END SUBROUTINE RF_LT_Init
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_LT_Write
- !
- ! !DESCRIPTION: does not write anything, just get
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_LT_Write( RF, region, idate_f, status )
- !
- ! !USES:
- !
- use GO, only : TDate, NewDate, Set, iTotal, rTotal, operator(-), wrtgol
- use chem_param, only : ntrace, ntracet, fscale
- use tracer_data, only : mass_dat, chem_dat
- use MeteoData, only : global_lli, levi, m_dat, sp_dat
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_LT), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_LT_Write'
- ! --- local ------------------------------------
- integer :: imr, jmr, lmr, gimr, i1, i2, j1, j2
- real, allocatable :: lev(:)
- real, allocatable :: field_out(:,:,:)
- real, allocatable :: field_out_b(:,:)
- integer :: l, ls, le
- type(TDate) :: t, t0
- real :: time
- real :: dt_sec
- integer :: i, j, k, itr
- integer(kind=8) :: itau
- integer :: loctim, gridboxtimestep
- integer :: iloctim,itautoday,ilon
- integer :: icomp, itr_loc, ncells, window
- ! --- begin -------------------------------------
- ! for multiple of dhour only ...
- ! if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
- ! status=0; return
- ! end if
- call goLabel(rname)
- ! grid size
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr=i2-i1+1
- jmr=j2-j1+1
- gimr = global_lli(region)%nlon
- ! gjmr = global_lli(region)%nlat
- lmr = levi%nlev
- ! next time record:
- RF%trec = RF%trec + 1
- if(okdebug)then
- write(gol,*) "RF_LT_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
- end if
- ! grid index offsets for GMT and local time
- loctim=RF%local_time
- if( loctim < 0 ) loctim=loctim+24*3600
- ! time since 1950-1-1 00:00
- t0 = NewDate( time6=time_reftime6 )
- t = NewDate( time6=idate_f )
- call SET( t, hour=0, min=0, sec=0 )
- time = rTotal( t - t0, 'day' ) + loctim / 86400.
- !
- ! ~~ time, grid
- !
-
- ! only once ...
- if ( RF%trec == 1 ) then
- ! write longitudes:
- call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! write latitudes:
- call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! write level indices:
- allocate( lev(lmr) )
- do l = 1, lmr
- lev(l) = real(l)
- end do
- call MDF_Put_Var( RF%ncid, RF%varid_lev, lev , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- deallocate(lev)
- ! time:
- call MDF_Put_Var( RF%ncid, RF%varid_time, (/time/) , status, start=(/RF%trec/))
- IF_NOTOK_MDF(fid=RF%ncid)
- ! date:
- call MDF_Put_Var( RF%ncid, RF%varid_date, reshape(real(idate_f),(/6,1/)), status, &
- start=(/1,1/), count=(/6,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- end if ! first record
-
- !
- ! local time
- !
- if ( RF%trec > 1 ) then ! do not accumulate fields on 00:00
- ! grid index offsets for GMT and local time
- loctim=RF%local_time
- if( loctim < 0 ) loctim=loctim+24*3600
- gridboxtimestep=24*3600/gimr
- itau = idate_f(4)*3600+idate_f(5)*60+idate_f(6)
- itautoday= nint(real(mod(itau,24*3600)*gimr)/real(24*3600))
- iloctim = nint(real(loctim *gimr)/real(24*3600))
- ! determine longitude index wrt Greenwich from difference (local time - GMT)
- ! also process neigboring longitudes (i-2 , i-1 , i , i+1 , i+2) depending on
- ! number of longitudinal grid cells
- ncells = ceiling( gimr / 24. )
- window = ceiling( ncells / 2. )
- do ilon = 1, ncells
- i = 1 + mod( gimr + gimr/2 + iloctim - itautoday + (ilon - window),gimr )
- if (i .ge. i1 .and. i.le. i2) then
- RF%p_accu(i,j1:j2)= RF%p_accu(i,j1:j2)+sp_dat(region)%data(i,j1:j2,1)
- RF%np_accu(i)= RF%np_accu(i)+1
- ! loop over tracers to be written:
- do k = 1, RF%ntr
- ! global tracer index:
- itr = RF%itr(k)
- !!$#ifdef with_m7
- !!$
- !!$ ! ---------------------
- !!$ ! AOD
- !!$ ! ---------------------
- !!$ if( RF%laod(k) ) then
- !!$
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ allocate( ....... ) )
- !!$
- !!$ call PMx_Integrate_3d( region, RF%sizepmx(k), pmx, status )
- !!$ IF_NOTOK_RETURN(status=1)
- !!$
- !!$ ! root only:
- !!$ if ( myid == root ) then
- !!$
- !!$ status = pnf90_put_var( RF%ncid, RF%varid_tr(k), &
- !!$ reshape( pmx(ims:ime,jms:jme,lms:lme), (/imr,jmr,lmr,1/) ), &
- !!$ start=(/1,1,1,RF%trec/), count=(/imr,jmr,lmr,1/) )
- !!$
- !!$ end if
- !!$
- !!$ deallocate( ............. )
- !!$
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ ! .............. PUT HERE THE CODE FOR AOD ..................!
- !!$ else
- !!$
- !!$#endif
- ! transported or chemistry only ?
- if ( (itr >= 1) .and. (itr <= ntracet) ) then
- RF%accu(i,j1:j2,1:lmr,k)= RF%accu(i,j1:j2,1:lmr,k)+&
- (mass_dat(region)%rm(i,j1:j2,1:lmr,itr)/ &
- m_dat(region)%data(i,j1:j2,1:lmr))*fscale(itr)
- RF%naccu(i,k)=RF%naccu(i,k)+1
- else if ( (itr >= ntracet+1) .and. (itr <= ntrace) ) then
- RF%accu(i,j1:j2,1:lmr,k)= RF%accu(i,j1:j2,1:lmr,k)+&
- (chem_dat(region)%rm(i,j1:j2,1:lmr,itr)/ &
- m_dat(region)%data(i,j1:j2,1:lmr))*fscale(itr)
- RF%naccu(i,k)=RF%naccu(i,k)+1
- end if
- enddo
- endif
- enddo
- endif ! do not accumulate fields on 00:00
- call goLabel(); status = 0
- END SUBROUTINE RF_LT_Write
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_LT_Done
- !
- ! !DESCRIPTION: write final data, then close file #4
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_LT_Done( RF, region, status )
- !
- ! !USES:
- !
- use MeteoData, only : global_lli, levi
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_LT), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- ! - move averaging & writing here
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len =*), parameter :: rname = mname//'/RF_LT_Done'
- integer :: imr, jmr
- real, allocatable :: field_out(:,:,:)
- real, allocatable :: field_out_b(:,:)
- integer :: i, ls, le, k, itr, i1, i2, j1, j2, lmr
- ! --- begin -------------------------------------
- call goLabel(rname)
- !---------------------
- ! average & write data
- !---------------------
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr=i2-i1+1
- jmr=j2-j1+1
- lmr = levi%nlev
- allocate(field_out_b(i1:i2,j1:j2)); field_out_b = 0.0
- do i = i1, i2
- if (RF%np_accu(i).gt.0) then
- field_out_b(i,:) =RF%p_accu(i,:)/RF%np_accu(i)
- endif
- enddo
- call MDF_Put_Var( RF%ncid, RF%varid_ps, reshape(field_out_b(i1:i2,j1:j2), &
- (/imr,jmr,1/) ), status, start=(/i1,j1,1/), count=(/imr,jmr,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
-
- deallocate(field_out_b)
- TRACERS: do k = 1, RF%ntr
- ! global tracer index:
- itr = RF%itr(k)
- if ( (itr >= 1) .and. (itr <= ntrace) ) then
- ! normalize fields, if necessary
- allocate(field_out(i1:i2,j1:j2,1:lmr)); field_out = 0.0
- do i = i1,i2
- if (RF%naccu(i,k).gt.0) then
- field_out(i,:,1:lmr) =RF%accu(i,:,1:lmr,k)/RF%naccu(i,k)
- endif
- enddo
- ! write fields:
- call MDF_Put_Var( RF%ncid, RF%varid_tr(k) , &
- reshape(field_out(i1:i2,j1:j2,1:lmr) , &
- (/imr,jmr,lmr,1/) ) , &
- status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- deallocate(field_out)
- endif
- end do TRACERS
- !---------------------
- ! DONE
- !---------------------
- call MDF_Close( RF%ncid , status)
- IF_NOTOK_RETURN(status=1)
- deallocate(RF%accu)
- deallocate(RF%naccu)
- deallocate(RF%p_accu)
- deallocate(RF%np_accu)
- call goLabel() ; status = 0
- END SUBROUTINE RF_LT_Done
- !EOC
- #ifdef with_budgets
-
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ! FILE ##5 : 2D dry and wet deposition fields
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_DEPS_Init
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine RF_DEPS_Init( RF, fdir, model, expid, filetype, region, &
- idate_f, dhour, tracer_names, status )
- !
- ! !USES:
- !
- use Binas, only : xmair
- use GO, only : goReadFromLine, goUpCase
- use GO, only : NewDate
- use dims, only : im, jm
- use chem_param, only : ntrace, names, ra
- use partools, only : MPI_INFO_NULL, localComm
- use MeteoData, only : global_lli, levi
- !
- ! !OUTPUT PARAMETERS:
- !
- type(TPdumpFile_DEPS), intent(out) :: RF
- integer, intent(out) :: status
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in) :: fdir
- character(len=*), intent(in) :: model
- character(len=*), intent(in) :: expid
- character(len=*), intent(in) :: filetype
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- integer, intent(in) :: dhour
- character(len=*), intent(in) :: tracer_names
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retor -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_DEPS_Init'
- ! --- local ------------------------------------
- character(len=256) :: fname
- integer :: varid
- character(len=256) :: trnames
- character(len=8) :: trname, tmname
- integer :: k, itr
- character(len=32) :: varname, varname_enti, varname_spec
- character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
- character(len=64) :: cf_spec_stnd, cf_spec_long
- character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
- character(len=512) :: comment
- logical :: with_wdep
- integer :: imr, jmr, i1, i2, j1, j2
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! -- store arguments, init var
- RF%dhour = dhour
- RF%tracer_names = tracer_names
- RF%ntr = 0
- trnames = tracer_names
- ! -- get dims
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr=i2-i1+1
- jmr=j2-j1+1
- ! Switch to default .false., requires an extra call to PDUMP_Files_Write2 in OUTPUT_PDUMP_DONE
- n_deps_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, mess='DPS_Init' )
- !n_deps_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, .true., 'DPS_Init' )
-
- if ( n_deps_rec == 0 ) then ! degenerated case
- deps_apply = .false.
- status=0
- return
- end if
- ! -- tracer index for requested tracers:
- if ( len_trim(trnames) == 0 ) then
- deps_apply = .false.
- write (gol,'("WARNING - NO tracers selected for depositions output!")') ; call goPr
- write (gol,'(" - deps_apply set to False.")' ) ; call goPr
- status=0
- return
- else
- write (gol,'("selected tracers for depositions output:")'); call goPr
- end if
- do
- if ( len_trim(trnames) == 0 ) exit
-
- ! next number:
- if ( RF%ntr == ntrace ) then
- write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
- TRACEBACK; status=1; return
- end if
- RF%ntr = RF%ntr + 1
- ! extract leading name:
- call goReadFromLine( trnames, trname, status, sep=' ' )
- IF_NOTOK_RETURN(status=1)
- ! store pdump name:
- RF%name_tr(RF%ntr) = trname
- ! convert to tm5 name:
- select case ( trname )
- case ( 'HCHO' ) ; tmname = 'CH2O'
- case ( 'Rn', 'Radon' ) ; tmname = 'Rn222'
- case ( 'Pb', 'Lead' ) ; tmname = 'Pb210'
- case default ; tmname = trname
- end select
- ! wet deposition ?
- with_wdep = .false.
- select case ( trname )
- case ( 'HNO3' ) ; with_wdep = .true.
- case ( 'NOy' ) ; with_wdep = .true.
- case ( 'NH3' ) ; with_wdep = .true.
- case ( 'NH4' ) ; with_wdep = .true.
- case ( 'SO4' ) ; with_wdep = .true.
- end select
- RF%with_wdep(RF%ntr) = with_wdep
- ! NOy is a special ...
- select case ( tmname )
- case ( 'NOy' )
- ! defined as ntrace+1
- RF%itr(RF%ntr) = iNOy
- write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4,"; wdep : ",l1)') &
- -1,trim(trname), '*', -1.0, with_wdep; call goPr
- case default
- ! loop over all names:
- RF%itr(RF%ntr) = -1
- do itr = 1, ntrace
- ! case indendent match ?
- if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
- write (gol,'(" ",i3," ",a10," (",a10,") ",f12.4," ; wdep : ",l1)') &
- itr, trim(trname), trim(names(itr)), ra(itr), with_wdep; call goPr
- RF%itr(RF%ntr) = itr
- exit
- end if
- end do
- end select
- ! not found ?
- if ( RF%itr(RF%ntr) < 0 ) then
- write (gol,'("tracer name not supported:") ') ; call goPr
- write (gol,'(" list all : ",a) ') trim(tracer_names) ; call goPr
- write (gol,'(" list element : ",i3) ') RF%ntr ; call goPr
- write (gol,'(" pdump name : ",a) ') trim(trname) ; call goPr
- write (gol,'(" tm5 name : ",a) ') trim(tmname) ; call goPr
- write (gol,'(" tm5 tracers : ") ') ; call goPr
- do itr = 1, ntrace
- write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
- end do
- TRACEBACK; status=1; return
- end if
- end do
- ! empty file ?
- if ( RF%ntr < 1 ) then
- write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
- TRACEBACK; status=1; return
- end if
- ! allocate storage:
- allocate( RF%ddep_budget(imr,jmr,RF%ntr) ) ; RF%ddep_budget = 0.0
- allocate( RF%wdep_budget(imr,jmr,RF%ntr) ) ; RF%wdep_budget = 0.0
- ! store current time (when budgets are reset):
- RF%t0_budget = NewDate(time6=idate_f)
- ! o open file
- write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
- trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
- #ifdef MPI
- ! overwrite existing files (clobber), provide MPI stuff:
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
- mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
- if (status/=0) then
- write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
- write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
- TRACEBACK; status=1; return
- end if
- #else
- ! overwrite existing files (clobber)
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! o global attributes
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'dry and wet deposition' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define dimensions
- call MDF_Def_Dim( RF%ncid, 'lon' , global_lli(region)%nlon, RF%dimid_lon , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lat' , global_lli(region)%nlat, RF%dimid_lat , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'time' , n_deps_rec , RF%dimid_time , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'datelen', 6 , RF%dimid_datelen, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define variables
- call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_east', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lon = varid
- call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_north', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lat = varid
- call MDF_Def_Var( RF%ncid, 'time', mdf_float, (/RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'days since 1950-01-01 00:00:00', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'calender' , 'gregorian' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_time = varid
- call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen,RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid , 'long_name', 'date and time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid , 'units' , 'year, month, day, hour, minute, second', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_date = varid
- call MDF_Def_Var( RF%ncid, 'accum', mdf_float , (/RF%dimid_time/) , varid, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid , 'long_name', 'length of accumulated time interval', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid , 'units' , 'second' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_accum = varid
- allocate( RF%time(n_deps_rec) )
- allocate( RF%date(6,n_deps_rec) )
- allocate( RF%dt(n_deps_rec) )
- ! loop over tracer to be written:
- do k = 1, RF%ntr
- ! global tracer index
- itr = RF%itr(k)
- ! ~~ dry deposition
- ! CF standard name for concentration/mixing ratio/column:
- cf_enti_stnd = 'surface_dry_deposition_mole_flux'
- cf_enti_unit = 'mole m-2 s-1'
- cf_enti_long = 'dry deposition of '
- ! start of dataset name:
- varname_enti = 'dry'
- ! no comment yet
- comment = ''
- ! standard names from CF conventions:
- select case ( RF%name_tr(k) )
- case ( 'CO', 'co' )
- varname_spec = 'co'
- cf_spec_stnd = 'carbon_monoxide'
- cf_spec_long = 'CO'
- case ( 'O3', 'o3' )
- varname_spec = 'o3'
- cf_spec_stnd = 'ozone'
- cf_spec_long = 'O3'
- case ( 'O3s', 'o3s' )
- varname_spec = 'o3s'
- cf_spec_stnd = 'ozone_from_stratosphere'
- cf_spec_long = 'O3s'
- case ( 'NO', 'no' )
- varname_spec = 'no'
- cf_spec_stnd = 'nitrogen_monoxide'
- cf_spec_long = 'NO'
- case ( 'NO2', 'no2' )
- varname_spec = 'no2'
- cf_spec_stnd = 'nitrogen_dioxide'
- cf_spec_long = 'NO2'
- case ( 'NOy', 'noy' )
- varname_spec = 'noy'
- cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
- cf_spec_long = 'NOy'
- comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
- 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
- case ( 'CH2O', 'ch2o', 'CHOH', 'choh' )
- varname_spec = 'ch2o'
- cf_spec_stnd = 'formaldehyde'
- cf_spec_long = 'CH2O'
- case ( 'SO2', 'so2' )
- varname_spec = 'so2'
- cf_spec_stnd = 'sulfur_dioxide'
- cf_spec_long = 'SO2'
- case ( 'CH4', 'ch4' )
- varname_spec = 'ch4'
- cf_spec_stnd = 'methane'
- cf_spec_long = 'CH4'
- case ( 'OH', 'oh' )
- varname_spec = 'oh'
- cf_spec_stnd = 'hydroxyl_radical'
- cf_spec_long = 'OH'
- case ( 'H2O2', 'h2o2' )
- varname_spec = 'h2o2'
- cf_spec_stnd = 'hydrogen_peroxide'
- cf_spec_long = 'H2O2'
- case ( 'HNO3', 'hno3' )
- varname_spec = 'hno3'
- cf_spec_stnd = 'nitric_acid'
- cf_spec_long = 'HNO3'
- case ( 'NH3', 'nh3' )
- varname_spec = 'nh3'
- cf_spec_stnd = 'ammonia'
- cf_spec_long = 'NH3'
- case ( 'ORGNTR','orgntr' )
- varname_spec = 'orgntr'
- cf_spec_stnd = 'organic_nitrate'
- cf_spec_long = 'ORGNTR'
- case ( 'NH4', 'nh4' )
- varname_spec = 'nh4'
- cf_spec_stnd = 'ammonium'
- cf_spec_long = 'NH4'
- case ( 'PAN', 'pan' )
- varname_spec = 'pan'
- cf_spec_stnd = 'peroxyacetyl_nitrate'
- cf_spec_long = 'PAN'
- case ( 'Rn', 'rn', 'Radon', 'radon' )
- varname_spec = 'rn'
- cf_spec_stnd = 'radon'
- cf_spec_long = 'Rn'
- case ( 'Pb', 'pb', 'Lead', 'lead' )
- varname_spec = 'pb'
- cf_spec_stnd = 'lead'
- cf_spec_long = 'Pb'
- case default
- write (gol,'("do not know how to match tracer with CF standard names : ",a)') RF%name_tr(k); call goErr
- TRACEBACK; status=1; return
- end select
- write (varname,'(a,"_",a)') trim(varname_enti), trim(varname_spec)
- ! define variable:
- call MDF_Def_Var( RF%ncid, trim(varname), MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! total names:
- cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)
- cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)
- cf_name_unit = trim(cf_enti_unit)
- ! write attributes:
- call MDF_Put_Att( RF%ncid , varid, 'standard_name' , trim(cf_name_stnd), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'long_name' , trim(cf_name_long), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'units' , trim(cf_name_unit), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( itr <= ntrace ) then
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- else
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( len_trim(comment) > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- ! store varid
- RF%varid_ddep(k) = varid
-
- ! ~~ wet deposition
- if ( RF%with_wdep(k) ) then
- ! CF standard name for concentration/mixing ratio/column:
- cf_enti_stnd = 'surface_wet_deposition_mole_flux'
- cf_enti_unit = 'mole m-2 s-1'
- cf_enti_long = 'wet deposition of '
- ! start of dataset name:
- varname_enti = 'wet'
- ! by default no comment:
- comment = ''
- ! standard names from CF conventions:
- select case ( RF%name_tr(k) )
- case ( 'NOy', 'noy' )
- varname_spec = 'noy'
- cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
- cf_spec_long = 'NOy'
- comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
- 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
- case ( 'HNO3', 'hno3' )
- varname_spec = 'hno3'
- cf_spec_stnd = 'nitric_acid'
- cf_spec_long = 'HNO3'
- case ( 'NH3', 'nh3' )
- varname_spec = 'nh3'
- cf_spec_stnd = 'ammonia'
- cf_spec_long = 'NH3'
- case ( 'NH4', 'nh4' )
- varname_spec = 'nh4'
- cf_spec_stnd = 'ammonium'
- cf_spec_long = 'NH4'
- case ( 'SO2', 'so2' )
- varname_spec = 'so2'
- cf_spec_stnd = 'sulfur_dioxide'
- cf_spec_long = 'SO2'
- case default
- write (gol,'("unsupported tracer name for CF standard name : ",a)') RF%name_tr(k); call goPr
- TRACEBACK; status=1; return
- end select
- write (varname,'(a,"_",a)') trim(varname_enti), trim(varname_spec)
- ! define variable:
- call MDF_Def_Var( RF%ncid, trim(varname), MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! total names:
- cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)
- cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)
- cf_name_unit = trim(cf_enti_unit)
- ! write attributes:
- call MDF_Put_Att( RF%ncid , varid, 'standard_name' , trim(cf_name_stnd), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'long_name' , trim(cf_name_long), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'units' , trim(cf_name_unit), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( itr <= ntrace ) then
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', ra(itr)*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- else
- call MDF_Put_Att( RF%ncid, varid, 'moleweight_tracer', -1.0 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( len_trim(comment) > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- ! store varid
- RF%varid_wdep(k) = varid
- end if
- end do
- allocate( RF%data2d_dry(i1:i2, j1:j2, n_deps_rec, RF%ntr) )
- allocate( RF%data2d_wet(i1:i2, j1:j2, n_deps_rec, RF%ntr) )
- ! RF%data2d_dry = 0.
- ! RF%data2d_wet = 0.
- ! o end defintion mode
- call MDF_EndDef( RF%ncid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o
- ! no records written yet
- RF%trec = 0
- call goLabel()
- ! ok
- status = 0
- end subroutine RF_DEPS_Init
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_DEPS_Write
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_DEPS_Write( RF, region, idate_f, status )
- !
- ! !USES:
- !
- use GO, only : TDate, NewDate, Set, iTotal, rTotal, operator(-), wrtgol
- use Grid, only : AreaOper
- use MeteoData, only : global_lli, levi, lli
- #ifndef without_chemistry
- use ebischeme, only : buddrydep_dat => buddep_dat
- #endif
- #ifndef without_wet_deposition
- use wet_deposition, only : buddep_dat
- #endif
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_DEPS), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_DEPS_Write'
- ! --- local ------------------------------------
- integer :: imr, jmr, lmr
- type(TDate) :: t, t0
- real :: time
- real :: dt_sec
- integer :: k, itr, i1, i2, j1, j2
- real, allocatable :: budget(:,:)
- real, allocatable :: budget_loc(:,:)
- real, allocatable :: depflux(:,:)
- integer :: icomp
- ! --- begin -------------------------------------
- ! for multiple of dhour only ...
- if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
- status=0; return
- end if
- call goLabel(rname)
- ! grid size
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr = i2-i1+1
- jmr = j2-j1+1
- lmr = levi%nlev
- ! temporary storage:
- allocate( budget_loc(imr,jmr) )
- allocate( depflux (imr,jmr) )
- ! next time record:
- RF%trec = RF%trec + 1
- if(okdebug)then
- write(gol,*) "RF_DEPS_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
- end if
- ! time since 1950-1-1 00:00
- t0 = NewDate( time6=time_reftime6 )
- t = NewDate( time6=idate_f )
- time = rTotal( t - t0, 'day' )
- ! length of time interval:
- dt_sec = iTotal( t - RF%t0_budget, 'sec' )
- ! zero time interval ? routine should not have been called ...
- if ( dt_sec == 0 ) then
- write (gol,'("routine called after zero lenght time interval:")'); call goErr
- call wrtgol( ' t0_budget : ', RF%t0_budget ); call goErr
- call wrtgol( ' t : ', t ); call goErr
- !status=1
- TRACEBACK
- end if
- ! reset timer:
- call Set( RF%t0_budget, time6=idate_f )
- !---------------
- ! Write GRID
- !---------------
- if ( RF%trec == 1 ) then
- ! longitudes
- call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! latitudes
- call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- !---------------
- ! FILL DIAGNOSTIC ARRAYS
- !---------------
-
- !--------------- time
-
- rf%time(rf%trec) = time
- rf%date(:,rf%trec) = real(idate_f)
- rf%dt(rf%trec) = dt_sec
- !--------------- dry deposition
-
- do k = 1, RF%ntr
- ! global tracer index:
- itr = RF%itr(k)
- ! extract current budget
- #ifndef without_chemistry
- if ( itr == iNOy ) then
- ! add contributions of all NOy components:
- budget_loc = 0.0
- do icomp = 1, nNOyt
- budget_loc = budget_loc + buddrydep_dat(region)%dry(:,:,iNOyt(icomp))
- end do
- else
- ! extract budget for requested tracer:
- budget_loc = buddrydep_dat(region)%dry(:,:,itr)
- end if
- #else
- budget_loc = 0.0
- #endif
-
- ! deposition flux ~ (current budget - previous budget)/dt
- depflux = ( budget_loc - RF%ddep_budget(:,:,k) ) / dt_sec ! mole/s
- call AreaOper( lli(region), depflux, '/', 'm2', status ) ! mole/m2/s
- IF_NOTOK_RETURN(status=1)
- ! save current budget & store record
- RF%ddep_budget(:,:,k) = budget_loc
- rf%data2d_dry(:,:,RF%trec,k)= depflux
- end do
- !--------------- wet deposition
- do k = 1, RF%ntr
- ! skip ?
- if ( .not. RF%with_wdep(k) ) cycle
- ! global tracer index:
- itr = RF%itr(k)
- ! extract current budget
- #ifndef without_wet_deposition
- if ( itr == iNOy ) then
- ! add contributions of all NOy components:
- budget_loc = 0.0
- do icomp = 1, nNOyt
- ! add wet depositions for large scale and convective precip; total column:
- budget_loc = budget_loc + sum(buddep_dat(region)%lsp(:,:,:,iNOyt(icomp)),3) + &
- sum(buddep_dat(region)% cp(:,:,:,iNOyt(icomp)),3)
- end do
- else
- ! extract budget for requested tracer;
- ! add wet depositions for large scale and convective precip; total column:
- budget_loc = sum(buddep_dat(region)%lsp(:,:,:,itr),3) + &
- sum(buddep_dat(region)% cp(:,:,:,itr),3)
- end if
- #else
- budget_loc = 0.0
- #endif
- ! deposition flux ~ (current budget - previous budget)/dt
- depflux = ( budget_loc - RF%wdep_budget(:,:,k) ) / dt_sec ! mole/s
- call AreaOper( lli(region), depflux, '/', 'm2', status ) ! mole/m2/s
- IF_NOTOK_RETURN(status=1)
- ! save current budget & store record
- RF%wdep_budget(:,:,k) = budget_loc
- RF%data2d_wet(:,:,RF%trec,k)= depflux
- end do
- !----------------
- ! WRITE
- !----------------
- if ( RF%trec == n_deps_rec ) then
- call MDF_Put_Var( RF%ncid, RF%varid_time, rf%time, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_date, rf%date, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! accumulation interval
- call MDF_Put_Var( RF%ncid, RF%varid_accum, rf%dt , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! deposition flux
- do k = 1, RF%ntr
- call MDF_Put_Var( RF%ncid, RF%varid_ddep(k), rf%data2d_dry(:,:,:,k), status, start=(/i1,j1,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( .not. RF%with_wdep(k) ) cycle
- call MDF_Put_Var( RF%ncid, RF%varid_wdep(k), rf%data2d_wet(:,:,:,k), status, start=(/i1,j1,1/) )
- IF_NOTOK_MDF(fid=RF%ncid)
- end do
- end if
-
- !----------------
- ! DONE
- !----------------
- deallocate( budget_loc )
- deallocate( depflux )
- call goLabel()
- status = 0
- END SUBROUTINE RF_DEPS_Write
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_DEPS_Done
- !
- ! !DESCRIPTION: close file #5
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_DEPS_Done( RF, status )
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_DEPS), intent(inout) :: RF
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_DEPS_Done'
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! close file
- call MDF_Close( RF%ncid , status)
- IF_NOTOK_RETURN(status=1)
-
- ! clear
- deallocate( RF%ddep_budget )
- deallocate( RF%wdep_budget )
- deallocate( rf%time, rf%date, rf%dt, rf%data2d_dry, rf%data2d_wet )
- call goLabel() ; status = 0
- END SUBROUTINE RF_DEPS_Done
- !EOC
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ! FILE #6 : deposition velocities
- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_DEPV_Init
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- subroutine RF_DEPV_Init( RF, fdir, model, expid, filetype, region, &
- idate_f, dhour, tracer_names, status )
- !
- ! !USES:
- !
- use Binas, only : xmair
- use GO, only : goReadFromLine, goUpCase
- use GO, only : NewDate
- use dims, only : im, jm
- use chem_param, only : ntrace, names, ra
- use partools, only : MPI_INFO_NULL, localComm
- use MeteoData, only : global_lli, levi
- !
- ! !OUTPUT PARAMETERS:
- !
- type(TPdumpFile_DEPV), intent(out) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- character(len=*), intent(in) :: fdir
- character(len=*), intent(in) :: model
- character(len=*), intent(in) :: expid
- character(len=*), intent(in) :: filetype
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- integer, intent(in) :: dhour
- character(len=*), intent(in) :: tracer_names
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_DEPV_Init'
- ! --- local ------------------------------------
- character(len=256) :: fname
- integer :: varid, i1, i2, j1, j2
- character(len=256) :: trnames
- character(len=8) :: trname, tmname
- integer :: k, itr
- character(len=32) :: varname, varname_enti, varname_spec
- character(len=64) :: cf_enti_stnd, cf_enti_long, cf_enti_unit
- character(len=64) :: cf_spec_stnd, cf_spec_long
- character(len=256) :: cf_name_stnd, cf_name_long, cf_name_unit
- character(len=512) :: comment
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! store arguments
- RF%dhour = dhour
- RF%tracer_names = tracer_names
- RF%ntr = 0
- trnames = tracer_names
- ! get dims
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- n_depv_rec = GET_N_TIME_RECORDS( idate_f, dhour*3600, mess='DEPV_Init' )
- if ( n_depv_rec == 0 ) then ! degenerated cases
- depv_apply = .false.
- status=0
- return
- end if
- ! tracer index for requested tracers
- if ( len_trim(trnames) == 0 ) then
- depv_apply = .false.
- write (gol,'("WARNING - NO tracers selected for depositions velocity output!")') ; call goPr
- write (gol,'(" - depv_apply set to False.")' ) ; call goPr
- status=0
- return
- else
- write (gol,'("selected tracers for deposition velocity output:")'); call goPr
- end if
-
- do
- if ( len_trim(trnames) == 0 ) exit
- ! next number:
- if ( RF%ntr == ntrace ) then
- write (gol,'("number of elements in tracer names list exceeds ntrace=",i6)') ntrace; call goErr
- TRACEBACK; status=1; return
- end if
- RF%ntr = RF%ntr + 1
- ! extract leading name:
- call goReadFromLine( trnames, trname, status, sep=' ' )
- IF_NOTOK_RETURN(status=1)
- ! store pdump name:
- RF%name_tr(RF%ntr) = trname
- ! convert to tm5 name:
- select case ( trname )
- case ( 'HCHO' ) ; tmname = 'CH2O'
- case ( 'Rn', 'Radon' ) ; tmname = 'Rn222'
- case ( 'Pb', 'Lead' ) ; tmname = 'Pb210'
- case default ; tmname = trname
- end select
- ! loop over all names:
- RF%itr(RF%ntr) = -1
- do itr = 1, ntrace
- ! case indendent match ?
- if ( goUpCase(trim(tmname)) == goUpCase(trim(names(itr))) ) then
- write (gol,'(" ",i3," ",a10," (",a10,")",f12.4)') &
- itr, trim(trname), trim(names(itr)), ra(itr); call goPr
- RF%itr(RF%ntr) = itr
- exit
- end if
- end do
- ! not found ?
- if ( RF%itr(RF%ntr) < 0 ) then
- write (gol,'("tracer name not supported:") ') ; call goPr
- write (gol,'(" list all : ",a) ') trim(tracer_names) ; call goPr
- write (gol,'(" list element : ",i3) ') RF%ntr ; call goPr
- write (gol,'(" pdump name : ",a) ') trim(trname) ; call goPr
- write (gol,'(" tm5 name : ",a) ') trim(tmname) ; call goPr
- write (gol,'(" tm5 tracers : ") ') ; call goPr
- do itr = 1, ntrace
- write (gol,'(" ",i3," ",a)') itr, trim(names(itr)); call goPr
- end do
- TRACEBACK; status=1; return
- end if
- end do
- ! empty file ?
- if ( RF%ntr < 1 ) then
- write (gol,'("no tracers extracted from list :",a)') tracer_names; call goErr
- TRACEBACK; status=1; return
- end if
-
- ! o open file
-
- ! write filename
- write (fname,'(a,"/",a,a,"_",a,"_",a,"_",i4.4,"_",i2.2,"_",i2.2,".nc")') &
- trim(fdir), trim(model), trim(fname_grid(region)), trim(expid), trim(filetype), idate_f(1:3)
- ! open:
- #ifdef MPI
- ! overwrite existing files (clobber), provide MPI stuff:
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status, &
- mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
- if (status/=0) then
- write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
- write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
- TRACEBACK; status=1; return
- end if
- #else
- ! overwrite existing files (clobber)
- call MDF_Create( trim(fname), MDF_NETCDF4, MDF_REPLACE, RF%ncid, status )
- IF_NOTOK_RETURN(status=1)
- #endif
- ! o global attributes
-
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'title' , 'volume mixing ratios' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_author' , trim(dataset_author) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'institution' , trim(institution), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, MDF_GLOBAL, 'dataset_version' , trim(dataset_version) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define dimensions
- call MDF_Def_Dim( RF%ncid, 'lon' , global_lli(region)%nlon, RF%dimid_lon , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'lat' , global_lli(region)%nlat, RF%dimid_lat , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'time' , n_depv_rec , RF%dimid_time , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Def_Dim( RF%ncid, 'datelen', 6 , RF%dimid_datelen, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o define variables
- call MDF_Def_Var( RF%ncid, 'lon', mdf_float, (/RF%dimid_lon/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'longitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_east', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lon = varid
- call MDF_Def_Var( RF%ncid, 'lat', mdf_float, (/RF%dimid_lat/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'latitude' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'degrees_north', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_lat = varid
- call MDF_Def_Var( RF%ncid, 'time', mdf_float, (/RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'standard_name', 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name' , 'time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'days since 1950-01-01 00:00:00', status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'calender' , 'gregorian' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_time = varid
- allocate( rf%time(n_depv_rec) )
-
- call MDF_Def_Var( RF%ncid, 'date', MDF_FLOAT, (/RF%dimid_datelen, RF%dimid_time/), varid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'long_name', 'date and time' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid, varid, 'units' , 'year, month, day, hour, minute, second' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- RF%varid_date = varid
- allocate( rf%date(6,n_depv_rec) )
- ! loop over tracer to be written:
- do k = 1, RF%ntr
- ! global tracer index
- itr = RF%itr(k)
- ! CF standard name for concentration/mixing ratio/column:
- cf_enti_stnd = 'surface_dry_deposition_velocity_due_to_turbulence'
- cf_enti_unit = 'mole m-2 s-1'
- cf_enti_long = 'dry deposition of '
- ! start of dataset name:
- varname_enti = 'ddepvel'
- ! by default no comment:
- comment = ''
- ! standard names from CF conventions:
- select case ( RF%name_tr(k) )
- case ( 'CO', 'co' )
- varname_spec = 'co'
- cf_spec_stnd = 'carbon_monoxide'
- cf_spec_long = 'CO'
- case ( 'O3', 'o3' )
- varname_spec = 'o3'
- cf_spec_stnd = 'ozone'
- cf_spec_long = 'O3'
- case ( 'O3s', 'o3s' )
- varname_spec = 'o3s'
- cf_spec_stnd = 'ozone_from_stratosphere'
- cf_spec_long = 'O3s'
- case ( 'NO', 'no' )
- varname_spec = 'no'
- cf_spec_stnd = 'nitrogen_monoxide'
- cf_spec_long = 'NO'
- case ( 'NO2', 'no2' )
- varname_spec = 'no2'
- cf_spec_stnd = 'nitrogen_dioxide'
- cf_spec_long = 'NO2'
- case ( 'NOy', 'noy' )
- varname_spec = 'noy'
- cf_spec_stnd = 'all_nitrogen_oxides_as_nitrogen'
- cf_spec_long = 'NOy'
- comment = 'NOy = NOx + HNO3 + PAN + org.ntr., '// &
- 'with NOx = NO + NO2 + NO3 + HNO4 + N2O5'
- case ( 'CH2O', 'ch2o', 'CHOH', 'choh' )
- varname_spec = 'ch2o'
- cf_spec_stnd = 'formaldehyde'
- cf_spec_long = 'CH2O'
- case ( 'SO2', 'so2' )
- varname_spec = 'so2'
- cf_spec_stnd = 'sulfur_dioxide'
- cf_spec_long = 'SO2'
- case ( 'CH4', 'ch4' )
- varname_spec = 'ch4'
- cf_spec_stnd = 'methane'
- cf_spec_long = 'CH4'
- case ( 'OH', 'oh' )
- varname_spec = 'oh'
- cf_spec_stnd = 'hydroxyl_radical'
- cf_spec_long = 'OH'
- case ( 'H2O2', 'h2o2' )
- varname_spec = 'h2o2'
- cf_spec_stnd = 'hydrogen_peroxide'
- cf_spec_long = 'H2O2'
- case ( 'HNO3', 'hno3' )
- varname_spec = 'hno3'
- cf_spec_stnd = 'nitric_acid'
- cf_spec_long = 'HNO3'
- case ( 'PAN', 'pan' )
- varname_spec = 'pan'
- cf_spec_stnd = 'peroxyacetyl_nitrate'
- cf_spec_long = 'PAN'
- case ( 'Rn', 'rn', 'Radon', 'radon' )
- varname_spec = 'rn'
- cf_spec_stnd = 'radon'
- cf_spec_long = 'Rn'
- case ( 'Pb', 'pb', 'Lead', 'lead' )
- varname_spec = 'pb'
- cf_spec_stnd = 'lead'
- cf_spec_long = 'Pb'
- case ( 'NH3', 'nh3' )
- varname_spec = 'nh3'
- cf_spec_stnd = 'ammonia'
- cf_spec_long = 'NH3'
- case ( 'NH4', 'nh4' )
- varname_spec = 'nh4'
- cf_spec_stnd = 'ammonium'
- cf_spec_long = 'NH4'
- case default
- write (gol,'("unsupported tracer name for CF standard name : ",a)') RF%name_tr(k); call goPr
- TRACEBACK; status=1; return
- end select
- write (varname,'(a,"_",a)') trim(varname_enti), trim(varname_spec)
- write (gol,'(" varname : ",a)') trim(varname); call goPr
- ! define variable:
- call MDF_Def_Var( RF%ncid, trim(varname), MDF_FLOAT, (/RF%dimid_lon, RF%dimid_lat, RF%dimid_time/), varid, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Var_Par_Access( RF%ncid, varid, access_mode, status )
- IF_NOTOK_MDF(fid=RF%ncid)
- ! total names:
- cf_name_stnd = trim(cf_enti_stnd)//'_of_'//trim(cf_spec_stnd)
- cf_name_long = trim(cf_enti_long)//' of '//trim(cf_spec_long)
- cf_name_unit = trim(cf_enti_unit)
- ! write attributes:
- call MDF_Put_Att( RF%ncid , varid, 'standard_name' , trim(cf_name_stnd), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'long_name' , trim(cf_name_long), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'units' , trim(cf_name_unit), status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_tracer', ra(itr)*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_air' , xmair*1e3 , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Att( RF%ncid , varid, 'moleweight_unit' , 'kg mole-1' , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- if ( len_trim(comment) > 0 ) then
- call MDF_Put_Att( RF%ncid, varid, 'comment' , trim(comment) , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- ! store varid
- RF%varid_tr(k) = varid
- end do
- allocate( rf%data2d(i1:i2, j1:j2, n_depv_rec, rf%ntr) )
-
- ! o end defintion mode
- call MDF_EndDef( RF%ncid , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! o
- ! no records written yet
- RF%trec = 0
- call goLabel() ; status = 0
- END SUBROUTINE RF_DEPV_Init
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_DEPV_Write
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_DEPV_Write( RF, region, idate_f, status )
- !
- ! !USES:
- !
- use GO, only : TDate, NewDate, Set, iTotal, rTotal, operator(-), wrtgol
- use Grid, only : AreaOper
- use MeteoData, only : global_lli
- #ifndef without_dry_deposition
- use dry_deposition, only : vd
- #endif
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_DEPV), intent(inout) :: RF
- !
- ! !INPUT PARAMETERS:
- !
- integer, intent(in) :: region
- integer, intent(in) :: idate_f(6)
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_DEPV_Write'
- ! --- local ------------------------------------
- integer :: imr, jmr
- type(TDate) :: t, t0
- real :: time
- integer :: k, itr, i1, i2, j1, j2
- real, allocatable :: depvel(:,:)
- ! --- begin -------------------------------------
- ! for multiple of dhour only ...
- if ( (modulo(idate_f(4),RF%dhour)/=0) .or. any(idate_f(5:6)/=0) ) then
- status=0; return
- end if
- call goLabel(rname)
- ! grid size
- call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
- imr=i2-i1+1
- jmr=j2-j1+1
- ! next time record:
- RF%trec = RF%trec + 1
- if(okdebug)then
- write(gol,*) "RF_DEPV_Write - idate_f(6), RF%trec=", idate_f, RF%trec; call goPr
- end if
- ! time since 1950-1-1 00:00
- t0 = NewDate( time6=time_reftime6 )
- t = NewDate( time6=idate_f )
- time = rTotal( t - t0, 'day' )
- ! Only once : Dimensions
- if ( RF%trec == 1 ) then
- ! write longitudes:
- call MDF_Put_Var( RF%ncid, RF%varid_lon, global_lli(region)%lon_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! write latitudes:
- call MDF_Put_Var( RF%ncid, RF%varid_lat, global_lli(region)%lat_deg , status)
- IF_NOTOK_MDF(fid=RF%ncid)
- end if
- !-------- FILL DIAGNOSTIC ARRAYS
- rf%time(rf%trec) = time
- rf%date(:,rf%trec) = real(idate_f)
-
- ! loop over tracers to be written:
- do k = 1, RF%ntr
- itr = RF%itr(k) ! global tracer index
- #ifndef without_dry_deposition
- rf%data2d(:,:,RF%trec,k) = vd(region,itr)%surf ! deposition velocity
- #else
- rf%data2d(:,:,RF%trec,k) = 0.0
- #endif
- end do
-
- !-------- WRITE
- if ( RF%trec == n_depv_rec ) then
- call MDF_Put_Var( RF%ncid, RF%varid_time, rf%time, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- call MDF_Put_Var( RF%ncid, RF%varid_date, rf%date, status)
- IF_NOTOK_MDF(fid=RF%ncid)
- ! loop over tracers to be written:
- do k = 1, RF%ntr
- call MDF_Put_Var( RF%ncid, RF%varid_tr(k), rf%data2d(:,:,:,k), status, start=(/i1,j1,1/))
- IF_NOTOK_MDF(fid=RF%ncid)
- end do
-
- end if
-
- call goLabel()
- status = 0
- END SUBROUTINE RF_DEPV_Write
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: RF_DEPV_Done
- !
- ! !DESCRIPTION:
- !\\
- !\\
- ! !INTERFACE:
- !
- SUBROUTINE RF_DEPV_Done( RF, status )
- !
- ! !INPUT/OUTPUT PARAMETERS:
- !
- type(TPdumpFile_DEPV), intent(inout) :: RF
- !
- ! !OUTPUT PARAMETERS:
- !
- integer, intent(out) :: status
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk - retro -> pdump
- ! 7 Aug 2012 - Ph. Le Sager - netcdf4 thru mdf
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- character(len=*), parameter :: rname = mname//'/RF_DEPV_Done'
- ! --- begin -------------------------------------
- call goLabel(rname)
- ! close file
- call MDF_Close( RF%ncid , status)
- IF_NOTOK_RETURN(status=1)
- deallocate( rf%time, rf%date, rf%data2d )
- call goLabel() ; status = 0
- END SUBROUTINE RF_DEPV_Done
- !EOC
-
- #endif
-
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !FUNCTION: strlowercase
- !
- ! !DESCRIPTION:
- !
- ! This function returns a copy of the input string 'struppercase' with all
- ! letters changed to lowercase. All other characters remain unchanged.
- !\\
- !\\
- ! !INTERFACE:
- !
- FUNCTION strlowercase(struppercase)
- !
- ! !USES:
- !
- IMPLICIT NONE
- !
- ! !INPUT PARAMETERS:
- !
- CHARACTER(LEN=*), INTENT(IN) :: struppercase
- !
- ! !RETURN VALUE:
- !
- CHARACTER(LEN=LEN(struppercase)) :: strlowercase
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- CHARACTER(LEN=1) :: u
- INTEGER :: i,j
- strlowercase = struppercase
- DO i=1,LEN(struppercase)
- u = struppercase(i:i)
- j = IACHAR(u)
- IF(j < 65 .OR. j > 90) CYCLE
- strlowercase(i:i) = ACHAR(j+32)
- END DO
- !-------------------------------------------------------------------------------
- END FUNCTION STRLOWERCASE
- !EOC
- !--------------------------------------------------------------------------
- ! TM5 !
- !--------------------------------------------------------------------------
- !BOP
- !
- ! !FUNCTION: struppercase
- !
- ! !DESCRIPTION:
- !
- ! This function returns a copy of the input string 'struppercase' with all
- ! letters changed to lowercase. All other characters remain unchanged.
- !\\
- !\\
- ! !INTERFACE:
- !
- FUNCTION STRUPPERCASE(strlowercase)
- !
- ! !USES:
- !
- IMPLICIT NONE
- !
- ! !INPUT PARAMETERS:
- !
- CHARACTER(LEN=*), INTENT(IN) :: strlowercase
- !
- ! !RETURN VALUE:
- !
- CHARACTER(LEN=LEN(strlowercase)) :: struppercase
- !
- ! !REVISION HISTORY:
- ! 1 Oct 2010 - Achim Strunk -
- !
- !EOP
- !------------------------------------------------------------------------
- !BOC
- CHARACTER(LEN=1) :: u
- INTEGER :: i,j
- struppercase = strlowercase
- DO i=1,LEN(strlowercase)
- u = strlowercase(i:i)
- j = IACHAR(u)
- IF(j < 97 .OR. j > 122) CYCLE
- struppercase(i:i) = ACHAR(j-32)
- END DO
- !-------------------------------------------------------------------------------
- END FUNCTION STRUPPERCASE
- !EOC
- END MODULE USER_OUTPUT_PDUMP
|