user_output_pdump.F90 227 KB

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