TECLIM
/
PlaSim


			
							1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783
							<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/xhtml;charset=UTF-8"/>
<title>PUMA: /Users/home/WC/puma/src/puma.f90 Source File</title>

<link href="tabs.css" rel="stylesheet" type="text/css"/>
<link href="doxygen.css" rel="stylesheet" type="text/css" />
<link href="navtree.css" rel="stylesheet" type="text/css"/>
<script type="text/javascript" src="jquery.js"></script>
<script type="text/javascript" src="resize.js"></script>
<script type="text/javascript" src="navtree.js"></script>
<script type="text/javascript">
  $(document).ready(initResizable);
</script>
<link href="search/search.css" rel="stylesheet" type="text/css"/>
<script type="text/javascript" src="search/search.js"></script>
<script type="text/javascript">
  $(document).ready(function() { searchBox.OnSelectItem(0); });
</script>

</head>
<body>
<div id="top"><!-- do not remove this div! -->


<div id="titlearea">
<table cellspacing="0" cellpadding="0">
 <tbody>
 <tr style="height: 56px;">
  
  <td id="projectlogo"><img alt="Logo" src="puma103.jpg"/></td>
  
  
  <td style="padding-left: 0.5em;">
   <div id="projectname">PUMA
   &#160;<span id="projectnumber">219</span>
   </div>
   <div id="projectbrief">Portable University Model of the Atmosphere</div>
  </td>
  
  
 </tr>
 </tbody>
</table>
</div>

<!-- Generated by Doxygen 1.7.5.1 -->
<script type="text/javascript">
var searchBox = new SearchBox("searchBox", "search",false,'Search');
</script>
  <div id="navrow1" class="tabs">
    <ul class="tablist">
      <li><a href="index.html"><span>Main&#160;Page</span></a></li>
      <li><a href="annotated.html"><span>Data&#160;Types&#160;List</span></a></li>
      <li class="current"><a href="files.html"><span>Files</span></a></li>
      <li>
        <div id="MSearchBox" class="MSearchBoxInactive">
        <span class="left">
          <img id="MSearchSelect" src="search/mag_sel.png"
               onmouseover="return searchBox.OnSearchSelectShow()"
               onmouseout="return searchBox.OnSearchSelectHide()"
               alt=""/>
          <input type="text" id="MSearchField" value="Search" accesskey="S"
               onfocus="searchBox.OnSearchFieldFocus(true)" 
               onblur="searchBox.OnSearchFieldFocus(false)" 
               onkeyup="searchBox.OnSearchFieldChange(event)"/>
          </span><span class="right">
            <a id="MSearchClose" href="javascript:searchBox.CloseResultsWindow()"><img id="MSearchCloseImg" border="0" src="search/close.png" alt=""/></a>
          </span>
        </div>
      </li>
    </ul>
  </div>
  <div id="navrow2" class="tabs2">
    <ul class="tablist">
      <li><a href="files.html"><span>File&#160;List</span></a></li>
      <li><a href="globals.html"><span>File&#160;Members</span></a></li>
    </ul>
  </div>
</div>
<div id="side-nav" class="ui-resizable side-nav-resizable">
  <div id="nav-tree">
    <div id="nav-tree-contents">
    </div>
  </div>
  <div id="splitbar" style="-moz-user-select:none;" 
       class="ui-resizable-handle">
  </div>
</div>
<script type="text/javascript">
  initNavTree('puma_8f90.html','');
</script>
<div id="doc-content">
<div class="header">
  <div class="headertitle">
<div class="title">/Users/home/WC/puma/src/puma.f90</div>  </div>
</div>
<div class="contents">
<a href="puma_8f90.html">Go to the documentation of this file.</a><div class="fragment"><pre class="fragment"><a name="l00001"></a>00001 <span class="keyword">module</span> <a class="code" href="classpumamod.html">pumamod</a>
<a name="l00002"></a>00002 
<a name="l00003"></a>00003 <span class="comment">!*********************************************!</span>
<a name="l00004"></a>00004 <span class="comment">! Portable University Model of the Atmosphere !</span>
<a name="l00005"></a>00005 <span class="comment">!*********************************************!</span>
<a name="l00006"></a>00006 <span class="comment">! Version: 17.0   16-Feb-2011                 !</span>
<a name="l00007"></a>00007 <span class="comment">!*********************************************!</span>
<a name="l00008"></a>00008 <span class="comment">! Klaus Fraedrich                             !</span>
<a name="l00009"></a>00009 <span class="comment">! Frank Lunkeit  - Edilbert Kirk              !</span>
<a name="l00010"></a>00010 <span class="comment">! Frank Sielmann - Torben Kunz                !</span>
<a name="l00011"></a>00011 <span class="comment">! Hartmut Borth                               !</span>
<a name="l00012"></a>00012 <span class="comment">!*********************************************!</span>
<a name="l00013"></a>00013 <span class="comment">! Meteorologisches Institut                   !</span>
<a name="l00014"></a>00014 <span class="comment">! KlimaCampus - Universitaet Hamburg          !</span>
<a name="l00015"></a>00015 <span class="comment">!*********************************************!</span>
<a name="l00016"></a>00016 <span class="comment">! http://www.mi.uni-hamburg.de/puma           !</span>
<a name="l00017"></a>00017 <span class="comment">!*********************************************!</span>
<a name="l00018"></a>00018 
<a name="l00019"></a>00019 <span class="comment">!**************************************************************!</span>
<a name="l00020"></a>00020 <span class="comment">! The number of processes for processing on parallel machines  !</span>
<a name="l00021"></a>00021 <span class="comment">! NLAT/2 must be dividable by &lt;npro&gt;. npro can be set by the   !</span>
<a name="l00022"></a>00022 <span class="comment">! option -n &lt;npro&gt; when calling the puma executable            !</span>
<a name="l00023"></a>00023 <span class="comment">! This option is only available if the code is compiled with   !</span>
<a name="l00024"></a>00024 <span class="comment">! an mpi compiler.                                             !</span>
<a name="l00025"></a>00025 <span class="comment">!**************************************************************!</span>
<a name="l00026"></a><a class="code" href="classpumamod.html#ae915be5ffac65dd8af555f2d75153398">00026</a> <span class="keywordtype">integer</span> :: npro = 1
<a name="l00027"></a>00027 
<a name="l00028"></a>00028 <span class="comment">!**************************************************************!</span>
<a name="l00029"></a>00029 <span class="comment">! The horizontal resolution of PUMA is set by defining the     !</span>
<a name="l00030"></a>00030 <span class="comment">! number of latitudes &lt;nlev&gt; with the 1st. command line        !</span>
<a name="l00031"></a>00031 <span class="comment">! parameter and the number of levels with the 2nd. command     !</span>
<a name="l00032"></a>00032 <span class="comment">! parameter. A typical call for T42 is:                        !</span>
<a name="l00033"></a>00033 <span class="comment">! puma.x 64 10                                                 !</span>
<a name="l00034"></a>00034 <span class="comment">! which sets nlat=64 and nlev=10                               !</span>
<a name="l00035"></a>00035 <span class="comment">!**************************************************************!</span>
<a name="l00036"></a>00036 <span class="keywordtype">integer</span> :: nlat = 32
<a name="l00037"></a>00037 
<a name="l00038"></a>00038 <span class="comment">!example values:  32,  48,  64, 128,  192,  256,  512,  1024</span>
<a name="l00039"></a>00039 <span class="comment">!truncation:     T21, T31, T42, T85, T127, T170, T341,  T682</span>
<a name="l00040"></a>00040 
<a name="l00041"></a>00041 <span class="keywordtype">integer</span> :: nlev = 10 
<a name="l00042"></a>00042 
<a name="l00043"></a>00043 <span class="comment">!*****************************************************!</span>
<a name="l00044"></a>00044 <span class="comment">! Grid related paramters, which are computed from the !</span>
<a name="l00045"></a>00045 <span class="comment">! command line arguments &lt;nlat&gt; and &lt;nlev&gt;            !</span>
<a name="l00046"></a>00046 <span class="comment">! Preset values are for T21 (nlat=32) and nlev=10     !</span>
<a name="l00047"></a>00047 <span class="comment">! ****************************************************!</span>
<a name="l00048"></a>00048 
<a name="l00049"></a>00049 <span class="keywordtype">integer</span> :: nlem =    9 <span class="comment">! Levels - 1</span>
<a name="l00050"></a>00050 <span class="keywordtype">integer</span> :: nlep =   11 <span class="comment">! Levels + 1</span>
<a name="l00051"></a>00051 <span class="keywordtype">integer</span> :: nlsq =  100 <span class="comment">! Levels squared</span>
<a name="l00052"></a>00052 
<a name="l00053"></a>00053 <span class="keywordtype">integer</span> :: nlon =   64 <span class="comment">! Longitudes = 2 * latitudes</span>
<a name="l00054"></a>00054 <span class="keywordtype">integer</span> :: nlah =   16 <span class="comment">! Half of latitudes</span>
<a name="l00055"></a>00055 <span class="keywordtype">integer</span> :: ntru =   21 <span class="comment">! (nlon-1) / 3</span>
<a name="l00056"></a>00056 <span class="keywordtype">integer</span> :: ntp1 =   22 <span class="comment">! ntru + 1</span>
<a name="l00057"></a>00057 <span class="keywordtype">integer</span> :: nzom =   44 <span class="comment">! Number of zonal modes</span>
<a name="l00058"></a>00058 <span class="keywordtype">integer</span> :: nrsp =  506 <span class="comment">! (ntru+1) * (ntru+2)</span>
<a name="l00059"></a>00059 <span class="keywordtype">integer</span> :: ncsp =  253 <span class="comment">! nrsp / 2</span>
<a name="l00060"></a>00060 <span class="keywordtype">integer</span> :: nspp =  506 <span class="comment">! nodes per process</span>
<a name="l00061"></a>00061 <span class="keywordtype">integer</span> :: nesp =  506 <span class="comment">! number of extended modes</span>
<a name="l00062"></a>00062 
<a name="l00063"></a>00063 <span class="keywordtype">integer</span> :: nlpp =   32 <span class="comment">! Latitudes per process</span>
<a name="l00064"></a>00064 <span class="keywordtype">integer</span> :: nhpp =   16 <span class="comment">! Half latitudes per process</span>
<a name="l00065"></a>00065 <span class="keywordtype">integer</span> :: nhor = 2048 <span class="comment">! Horizontal part</span>
<a name="l00066"></a><a class="code" href="classpumamod.html#aa9e811d28ba93c3dadb44bc26ae09600">00066</a> <span class="keywordtype">integer</span> :: nugp = 2048 <span class="comment">! Horizontal total</span>
<a name="l00067"></a><a class="code" href="classpumamod.html#ac20b6aa2c443341280ab5e4ddc9bebd7">00067</a> <span class="keywordtype">integer</span> :: npgp = 1024 <span class="comment">! Horizontal total packed words</span>
<a name="l00068"></a>00068 
<a name="l00069"></a><a class="code" href="classpumamod.html#ab963b44aa3f4546a551dd941e4e322c8">00069</a> <span class="keywordtype">integer</span> :: nud  =    6 <span class="comment">! I/O unit for diagnostic output</span>
<a name="l00070"></a>00070 
<a name="l00071"></a>00071 <span class="comment">!***********!</span>
<a name="l00072"></a>00072 <span class="comment">! filenames !</span>
<a name="l00073"></a>00073 <span class="comment">!***********!</span>
<a name="l00074"></a><a class="code" href="classpumamod.html#a71c27dcf11504a05aa050a3ee4d436d1">00074</a> <span class="keywordtype">character (256)</span> :: puma_namelist       = <span class="stringliteral">&quot;puma_namelist&quot;</span>
<a name="l00075"></a><a class="code" href="classpumamod.html#a047f25dcb732cdf09b1f74fd3115126a">00075</a> <span class="keywordtype">character (256)</span> :: puma_output         = <span class="stringliteral">&quot;puma_output&quot;</span>
<a name="l00076"></a><a class="code" href="classpumamod.html#ad11e2fd3e6aa83543bbc8acd0c59b7a0">00076</a> <span class="keywordtype">character (256)</span> :: puma_diag           = <span class="stringliteral">&quot;puma_diag&quot;</span>
<a name="l00077"></a><a class="code" href="classpumamod.html#a98f71e6dad074de1b2cb0fd1c5e531c3">00077</a> <span class="keywordtype">character (256)</span> :: puma_restart        = <span class="stringliteral">&quot;puma_restart&quot;</span>
<a name="l00078"></a><a class="code" href="classpumamod.html#ab188caa1d64091345227ae3bf0e83edd">00078</a> <span class="keywordtype">character (256)</span> :: puma_status         = <span class="stringliteral">&quot;puma_status&quot;</span>
<a name="l00079"></a><a class="code" href="classpumamod.html#a5f70e9c47b9e4690322963b92bb809de">00079</a> <span class="keywordtype">character (256)</span> :: efficiency_dat      = <span class="stringliteral">&quot;efficiency.dat&quot;</span>
<a name="l00080"></a><a class="code" href="classpumamod.html#ae6491cb06d104f50f9803d15f195f951">00080</a> <span class="keywordtype">character (256)</span> :: ppp_puma_txt        = <span class="stringliteral">&quot;ppp-puma.txt&quot;</span>
<a name="l00081"></a><a class="code" href="classpumamod.html#a97179af6f9ebee802a4333f951b0f436">00081</a> <span class="keywordtype">character (256)</span> :: puma_sp_init        = <span class="stringliteral">&quot;puma_sp_init&quot;</span>
<a name="l00082"></a>00082 
<a name="l00083"></a>00083 <span class="comment">! *****************************************************************</span>
<a name="l00084"></a>00084 <span class="comment">! * For multiruns the instance number is appended to the filename *</span>
<a name="l00085"></a>00085 <span class="comment">! * e.g.: puma_namelist_1 puma_diag_1 etc. for instance # 1       *</span>
<a name="l00086"></a>00086 <span class="comment">! *****************************************************************</span>
<a name="l00087"></a>00087 
<a name="l00088"></a>00088 <span class="comment">! ****************************************************************</span>
<a name="l00089"></a>00089 <span class="comment">! * Don&#39;t touch the following parameter definitions !            *</span>
<a name="l00090"></a>00090 <span class="comment">! ****************************************************************</span>
<a name="l00091"></a><a class="code" href="classpumamod.html#a6cfe02b5d7dfcb7850792dcc03ae3a45">00091</a> <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: PUMA   = 0        <span class="comment">! Model ID</span>
<a name="l00092"></a><a class="code" href="classpumamod.html#a6014a04a0c8a568ae850cff922ec8c36">00092</a> <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: PLASIM = 1        <span class="comment">! Model ID</span>
<a name="l00093"></a>00093 
<a name="l00094"></a>00094 parameter(NROOT = 0)                    <span class="comment">! Master node</span>
<a name="l00095"></a>00095 
<a name="l00096"></a>00096 parameter(PI     = 3.141592653589793D0) <span class="comment">! Pi</span>
<a name="l00097"></a>00097 parameter(TWOPI  = PI + PI)             <span class="comment">! 2 Pi</span>
<a name="l00098"></a>00098 
<a name="l00099"></a>00099 parameter(AKAP_EARTH   = 0.286 )      <span class="comment">! Kappa Earth</span>
<a name="l00100"></a>00100 parameter(AKAP_MARS    = 0.2273)      <span class="comment">! Kappa Mars</span>
<a name="l00101"></a>00101 parameter(ALR_EARTH    = 0.0065)      <span class="comment">! Lapse rate Earth</span>
<a name="l00102"></a>00102 parameter(ALR_MARS     = 0.0025)      <span class="comment">! Lapse rate Mars</span>
<a name="l00103"></a>00103 parameter(GA_EARTH     = 9.81)        <span class="comment">! Gravity Earth</span>
<a name="l00104"></a>00104 parameter(GA_MARS      = 3.74)        <span class="comment">! Gravity Mars</span>
<a name="l00105"></a>00105 parameter(GASCON_EARTH = 287.0)       <span class="comment">! Gas constant for dry air on Earth</span>
<a name="l00106"></a>00106 parameter(GASCON_MARS  = 188.9)       <span class="comment">! Gas constant for dry air on Mars </span>
<a name="l00107"></a>00107 parameter(PSURF_EARTH  = 101100.0)    <span class="comment">! Mean Surface pressure [Pa] on Earth</span>
<a name="l00108"></a>00108                         <span class="comment">! Trenberth 1981, J. Geoph. Res., Vol.86, 5238-5246</span>
<a name="l00109"></a>00109 parameter(PLARAD_EARTH = 6371000.0)   <span class="comment">! Earth radius</span>
<a name="l00110"></a>00110 parameter(PLARAD_MARS  = 3397000.0)   <span class="comment">! Mars radius</span>
<a name="l00111"></a>00111 parameter(SID_DAY_EARTH= 86164.)      <span class="comment">! Siderial day Earth 23h 56m 04s</span>
<a name="l00112"></a>00112 parameter(SID_DAY_MARS = 88642.)      <span class="comment">! Siderial day Mars  24h 37m 22s</span>
<a name="l00113"></a>00113 
<a name="l00114"></a>00114 parameter(WW_EARTH = TWOPI/SID_DAY_EARTH) <span class="comment">! reciprocal of time scale </span>
<a name="l00115"></a>00115                                           <span class="comment">! on Earth [1/sec]</span>
<a name="l00116"></a>00116 parameter(WW_MARS  = TWOPI/SID_DAY_MARS)  <span class="comment">! reciprocal of time scale</span>
<a name="l00117"></a>00117                                           <span class="comment">! on Mars [1/sec]</span>
<a name="l00118"></a>00118 
<a name="l00119"></a>00119 parameter(CV_EARTH = PLARAD_EARTH * WW_EARTH) <span class="comment">! Velocity scale on Earth [m/s]</span>
<a name="l00120"></a>00120 parameter(CV_MARS  = PLARAD_MARS * WW_MARS)   <span class="comment">! Velocity scale on Mars [m/s]</span>
<a name="l00121"></a>00121 
<a name="l00122"></a>00122 parameter(CT_EARTH = CV_EARTH*CV_EARTH/GASCON_EARTH) <span class="comment">!Temperature scale [K] </span>
<a name="l00123"></a>00123                                                      <span class="comment">! on Earth </span>
<a name="l00124"></a>00124 parameter(CT_MARS = CV_MARS*CV_MARS/GASCON_MARS)     <span class="comment">!Temperature scale [K] </span>
<a name="l00125"></a>00125                                                      <span class="comment">! on Mars </span>
<a name="l00126"></a>00126 
<a name="l00127"></a>00127 parameter(PNU    = 0.02)             <span class="comment">! Time filter</span>
<a name="l00128"></a>00128 parameter(PNU21  = 1.0 - 2.0*PNU)    <span class="comment">! Time filter 2</span>
<a name="l00129"></a>00129 
<a name="l00130"></a>00130 <span class="comment">! *****************************************************************</span>
<a name="l00131"></a>00131 <span class="comment">! * EZ: Factor to multiply the spherical harmonic Y_(1,0) to get  *</span>
<a name="l00132"></a>00132 <span class="comment">! * the non-dimensional planetary vorticity 2 sin(phi). In PUMA   *</span>
<a name="l00133"></a>00133 <span class="comment">! * Y_(1,0) = sqrt(3/2)*sin(phi) (normalization factor 1/sqrt(2)).*</span>
<a name="l00134"></a>00134 <span class="comment">! * The time scale must be given by Tscale = 1/Omega              *   </span>
<a name="l00135"></a>00135 <span class="comment">! *****************************************************************</span>
<a name="l00136"></a>00136 parameter(EZ     = 1.632993161855452D0) <span class="comment">! ez = 1 / sqrt(3/8)</span>
<a name="l00137"></a>00137 
<a name="l00138"></a>00138 
<a name="l00139"></a>00139 <span class="comment">! **************************************************************</span>
<a name="l00140"></a>00140 <span class="comment">! * Planetary parameters &amp; Scales                              *</span>
<a name="l00141"></a>00141 <span class="comment">! * -----------------------------                              *</span>
<a name="l00142"></a>00142 <span class="comment">! * The Puma model is formulated in non-dimensional form with  * </span>
<a name="l00143"></a>00143 <span class="comment">! * the planetary radius as length scale and the reciprocal of * </span>
<a name="l00144"></a>00144 <span class="comment">! * the planetary rotation rate as time scale. The temperature * </span>
<a name="l00145"></a>00145 <span class="comment">! * scale is given by the geopotential scale divided by the    * </span>
<a name="l00146"></a>00146 <span class="comment">! * gas constant.                                              *  </span>
<a name="l00147"></a>00147 <span class="comment">! * For the time scale the length of the siderial day is used  *</span>
<a name="l00148"></a>00148 <span class="comment">! * as basic unit                                              *</span>
<a name="l00149"></a>00149 <span class="comment">! * The parameters are initialized for Earth settings. They    *</span>
<a name="l00150"></a>00150 <span class="comment">! * may be modified by the namelist file &lt;puma_namelist&gt;       *</span>
<a name="l00151"></a>00151 <span class="comment">! *                                                            *</span>
<a name="l00152"></a>00152 <span class="comment">! * The scales are derived internal quantities                 *</span>
<a name="l00153"></a>00153 <span class="comment">! **************************************************************</span>
<a name="l00154"></a>00154 <span class="keywordtype">real</span> :: sid_day      = SID_DAY_EARTH <span class="comment">! Length of sideral day [sec] on Earth</span>
<a name="l00155"></a><a class="code" href="classpumamod.html#a0c307462fbf87e3081b2a385e18d2aed">00155</a> <span class="keywordtype">real</span> :: plarad       = PLARAD_EARTH  <span class="comment">! Planetary radius [m] on Earth</span>
<a name="l00156"></a><a class="code" href="classpumamod.html#ae3f731196cc45fe58378593cedcbb674">00156</a> <span class="keywordtype">real</span> :: gascon       = GASCON_EARTH  <span class="comment">! Dry air gas consant [J/K kg] on Earth </span>
<a name="l00157"></a><a class="code" href="classpumamod.html#a3d53197ec6d14527904d37910baf20ba">00157</a> <span class="keywordtype">real</span> :: akap         = AKAP_EARTH    <span class="comment">! Kappa [] on Earth</span>
<a name="l00158"></a><a class="code" href="classpumamod.html#a16fd3c35a535517745304e4e978dad36">00158</a> <span class="keywordtype">real</span> :: alr          = ALR_EARTH     <span class="comment">! average lapse rate [K/km] on Earth</span>
<a name="l00159"></a><a class="code" href="classpumamod.html#afab1546c76a48d45df0296c921674b29">00159</a> <span class="keywordtype">real</span> :: ga           = GA_EARTH      <span class="comment">! Gravity [m/sec*sec] on Earth</span>
<a name="l00160"></a><a class="code" href="classpumamod.html#aecc1e882fcb2823bd6f2bc1448c1953d">00160</a> <span class="keywordtype">real</span> :: psurf        = PSURF_EARTH   <span class="comment">! Mean surface pressure for EARTH [Pa] </span>
<a name="l00161"></a>00161 
<a name="l00162"></a><a class="code" href="classpumamod.html#ac1247b3015d439d0c9f1b6b7ff94722b">00162</a> <span class="keywordtype">real</span> :: ww           = WW_EARTH      <span class="comment">! reciprocal of time scale [1/sec] (Omega)</span>
<a name="l00163"></a><a class="code" href="classpumamod.html#a565ac5e5bafeaa6e81c64ce72e63ccf1">00163</a> <span class="keywordtype">real</span> :: cv           = CV_EARTH      <span class="comment">! velocity scale [m/sec] on Earth</span>
<a name="l00164"></a><a class="code" href="classpumamod.html#a7a6d067e0dfb359595d82114a0362ff2">00164</a> <span class="keywordtype">real</span> :: ct           = CT_EARTH      <span class="comment">! temperature scale [K] on Earth  </span>
<a name="l00165"></a>00165 
<a name="l00166"></a>00166 <span class="comment">! **************************</span>
<a name="l00167"></a>00167 <span class="comment">! * Global Integer Scalars *</span>
<a name="l00168"></a>00168 <span class="comment">! **************************</span>
<a name="l00169"></a>00169 
<a name="l00170"></a><a class="code" href="classpumamod.html#ac3cfb3fcdded6ec157594b899e3ea6f8">00170</a> <span class="keywordtype">logical</span> :: lrestart =  .false. <span class="comment">! Existing &quot;puma_restart&quot; sets to .true.</span>
<a name="l00171"></a><a class="code" href="classpumamod.html#aea52fae2a0b29f7669124cb727b07a5f">00171</a> <span class="keywordtype">logical</span> :: lselect  =  .false. <span class="comment">! true: disable some zonal waves</span>
<a name="l00172"></a><a class="code" href="classpumamod.html#ae1611527d39b509b932ec189dd6885c3">00172</a> <span class="keywordtype">logical</span> :: lspecsel =  .false. <span class="comment">! true: disable some spectral modes</span>
<a name="l00173"></a>00173 
<a name="l00174"></a><a class="code" href="classpumamod.html#a7b22b37e933bb9e2b91022f17891b322">00174</a> <span class="keywordtype">integer</span> :: model    = PUMA
<a name="l00175"></a>00175 
<a name="l00176"></a>00176 <span class="keywordtype">integer</span> :: kick     =  1 <span class="comment">! kick &gt; 0 initializes eddy generation</span>
<a name="l00177"></a>00177 <span class="keywordtype">integer</span> :: nafter   =  0 <span class="comment">! write data interval 0: controlled by nwpd</span>
<a name="l00178"></a>00178 <span class="keywordtype">integer</span> :: nwpd     =  1 <span class="comment">! number of writes per day</span>
<a name="l00179"></a>00179 <span class="keywordtype">integer</span> :: ncoeff   =  0 <span class="comment">! number of modes to print</span>
<a name="l00180"></a>00180 <span class="keywordtype">integer</span> :: ndel     =  6 <span class="comment">! ndel</span>
<a name="l00181"></a>00181 <span class="keywordtype">integer</span> :: ndiag    = 12 <span class="comment">! write diagnostics interval</span>
<a name="l00182"></a>00182 <span class="keywordtype">integer</span> :: ngui     =  0 <span class="comment">! activate Graphical User Interface</span>
<a name="l00183"></a>00183 <span class="keywordtype">integer</span> :: nkits    =  3 <span class="comment">! number of initial timesteps</span>
<a name="l00184"></a>00184 <span class="keywordtype">integer</span> :: nlevt    =  9 <span class="comment">! tropospheric levels (set_vertical_grid)</span>
<a name="l00185"></a>00185 <span class="keywordtype">integer</span> :: noutput  =  1 <span class="comment">! global switch for output on (1) or off (0)</span>
<a name="l00186"></a><a class="code" href="classpumamod.html#ae565fd4c9d0d1e8f563b457690df60e1">00186</a> <span class="keywordtype">integer</span> :: nwspini  =  1 <span class="comment">! write sp_init after initialization</span>
<a name="l00187"></a>00187 <span class="keywordtype">integer</span> :: nrun     =  0 <span class="comment">! if (nstop == 0) nstop = nstep + nrun</span>
<a name="l00188"></a><a class="code" href="classpumamod.html#a44f4e89edb1112fb56a0acd8fe2de68c">00188</a> <span class="keywordtype">integer</span> :: nstep1   =  0 <span class="comment">! start step (for cpu statistics)</span>
<a name="l00189"></a>00189 <span class="keywordtype">integer</span> :: nstep    = -1 <span class="comment">! current timestep step 0: 01-Jan-0001  00:00</span>
<a name="l00190"></a>00190 <span class="keywordtype">integer</span> :: nstop    =  0 <span class="comment">! finishing timestep</span>
<a name="l00191"></a>00191 <span class="keywordtype">integer</span> :: ntspd    =  0 <span class="comment">! number of timesteps per day 0 = auto</span>
<a name="l00192"></a>00192 <span class="keywordtype">integer</span> :: mpstep   =  0 <span class="comment">! minutes per step 0 = automatic</span>
<a name="l00193"></a>00193 <span class="keywordtype">integer</span> :: ncu      =  0 <span class="comment">! check unit (debug output)</span>
<a name="l00194"></a><a class="code" href="classpumamod.html#aeed68a00c7949544bc4fef6fb12750e7">00194</a> <span class="keywordtype">integer</span> :: nwrioro  =  1 <span class="comment">! controls output of orography</span>
<a name="l00195"></a><a class="code" href="classpumamod.html#ac8490b47e54184cb4a1cea076d0a30a3">00195</a> <span class="keywordtype">integer</span> :: nextout  =  0 <span class="comment">! 1: extended output (entropy production)</span>
<a name="l00196"></a><a class="code" href="classpumamod.html#a8f8ac2af640bb3457498cf2ca2cf382a">00196</a> <span class="keywordtype">integer</span> :: nruido   =  0 <span class="comment">! 1: global constant, temporal noise</span>
<a name="l00197"></a>00197 <span class="comment">!                          2: spatio-temporal noise</span>
<a name="l00198"></a>00198 <span class="comment">!                          3: spatio-temporal equator symmetric</span>
<a name="l00199"></a><a class="code" href="classpumamod.html#af9d1e5f558a9b0151f81e27c4ea6c361">00199</a> <span class="keywordtype">integer</span> :: nseedlen =  0 <span class="comment">! length of random seed (set by lib call)</span>
<a name="l00200"></a><a class="code" href="classpumamod.html#a5deccef8dbe1e1e9bfb869f67d8a16f1">00200</a> <span class="keywordtype">integer</span> :: nmonths  =  0 <span class="comment">! Simulation time (1 month =  30 days)</span>
<a name="l00201"></a><a class="code" href="classpumamod.html#a6bebc837456862a7db9c50bcd686e1e6">00201</a> <span class="keywordtype">integer</span> :: nyears   =  1 <span class="comment">! simulation time (1 year  = 360 days)</span>
<a name="l00202"></a>00202 <span class="keywordtype">integer</span> :: nsponge  =  0 <span class="comment">! 1: Create sponge layer</span>
<a name="l00203"></a>00203 <span class="keywordtype">integer</span> :: nhelsua  =  0 <span class="comment">! 1: Set up Held &amp; Suarez T_R field</span>
<a name="l00204"></a>00204 <span class="comment">!                             instead of original PUMA T_R field</span>
<a name="l00205"></a>00205 <span class="comment">!                          2: Set up Held &amp; Suarez T_R field</span>
<a name="l00206"></a>00206 <span class="comment">!                             instead of original PUMA T_R field</span>
<a name="l00207"></a>00207 <span class="comment">!                             AND use latitudinally varying</span>
<a name="l00208"></a>00208 <span class="comment">!                             heating timescale in PUMA (H&amp;Z(94)),</span>
<a name="l00209"></a>00209 <span class="comment">!                             irrelevant for PumaPreProcessor (ppp)</span>
<a name="l00210"></a>00210 <span class="comment">!                          3: Use latitudinally varying</span>
<a name="l00211"></a>00211 <span class="comment">!                             heating timescale in PUMA (H&amp;Z(94)),</span>
<a name="l00212"></a>00212 <span class="comment">!                             irrelevant for PumaPreProcessor (ppp)</span>
<a name="l00213"></a><a class="code" href="classpumamod.html#a996f9145950ee7b3955819b122de4957">00213</a> <span class="keywordtype">integer</span>  :: ndiagp  = 0 <span class="comment">! 0/1 switch for grid point diabatic heating </span>
<a name="l00214"></a><a class="code" href="classpumamod.html#a4ad70fab2e818be277ec41afde36c5d2">00214</a> <span class="keywordtype">integer</span>  :: nconv   = 0 <span class="comment">! 0/1 switch for convecive heating</span>
<a name="l00215"></a>00215 <span class="keywordtype">integer</span>  :: nvg     = 0 <span class="comment">! type of vertical grid</span>
<a name="l00216"></a>00216                         <span class="comment">! 0 = linear</span>
<a name="l00217"></a>00217                         <span class="comment">! 1 = Scinocca &amp; Haynes</span>
<a name="l00218"></a>00218                         <span class="comment">! 2 = Polvani &amp; Kushner</span>
<a name="l00219"></a><a class="code" href="classpumamod.html#a0423d8412d0d82630764dd724fbe763a">00219</a> <span class="keywordtype">integer</span>  :: nenergy = 0 <span class="comment">! energy diagnostics (on/off 1/0)</span>
<a name="l00220"></a><a class="code" href="classpumamod.html#a6ebc03f03149556f450c2c2c927189f2">00220</a> <span class="keywordtype">integer</span>  :: nentropy= 0 <span class="comment">! entropy diagnostics (on/off 1/0)</span>
<a name="l00221"></a><a class="code" href="classpumamod.html#a8e7c1d42543d35f7caba5ebd36dcfd54">00221</a> <span class="keywordtype">integer</span>  :: ndheat  = 0 <span class="comment">! energy recycling (on/off 1/0)</span>
<a name="l00222"></a>00222 
<a name="l00223"></a><a class="code" href="classpumamod.html#a5e7e19a6f3a971a303fc7efc2676e5f1">00223</a> <span class="keywordtype">integer</span>  :: nradcv = 0 <span class="comment">! use two restoration fields</span>
<a name="l00224"></a>00224 
<a name="l00225"></a>00225 
<a name="l00226"></a>00226 
<a name="l00227"></a>00227 <span class="comment">! ***********************</span>
<a name="l00228"></a>00228 <span class="comment">! * Global Real Scalars *</span>
<a name="l00229"></a>00229 <span class="comment">! ***********************</span>
<a name="l00230"></a>00230 
<a name="l00231"></a><a class="code" href="classpumamod.html#a976863e22669d1d80cb62a3af35e3d4d">00231</a> <span class="keywordtype">real</span> :: alpha  =     1.0  <span class="comment">! Williams filter factor</span>
<a name="l00232"></a>00232 <span class="keywordtype">real</span> :: alrs  =      0.0  <span class="comment">! stratospheric lapse rate [K/m]</span>
<a name="l00233"></a>00233 <span class="keywordtype">real</span> :: delt              <span class="comment">! 2 pi / ntspd timestep interval</span>
<a name="l00234"></a>00234 <span class="keywordtype">real</span> :: delt2             <span class="comment">! 2 * delt</span>
<a name="l00235"></a>00235 <span class="keywordtype">real</span> :: dtep   =    60.0  <span class="comment">! delta T equator &lt;-&gt; pole  [K]</span>
<a name="l00236"></a>00236 <span class="keywordtype">real</span> :: dtns   =   -70.0  <span class="comment">! delta T   north &lt;-&gt; south [K]</span>
<a name="l00237"></a>00237 <span class="keywordtype">real</span> :: dtrop  = 12000.0  <span class="comment">! Tropopause height [m]</span>
<a name="l00238"></a>00238 <span class="keywordtype">real</span> :: dttrp  =     2.0  <span class="comment">! Tropopause smoothing [K]</span>
<a name="l00239"></a>00239 <span class="keywordtype">real</span> :: dtzz   =    10.0  <span class="comment">! delta(Theta)/H additional lapserate in</span>
<a name="l00240"></a>00240                           <span class="comment">! Held &amp; Suarez T_R field</span>
<a name="l00241"></a>00241 <span class="keywordtype">real</span> :: orofac =    1.0   <span class="comment">! factor to scale the orograpy</span>
<a name="l00242"></a>00242 <span class="keywordtype">real</span> :: plavor =    EZ    <span class="comment">! planetary vorticity</span>
<a name="l00243"></a><a class="code" href="classpumamod.html#ac68939034981424cca40dd948549d1a0">00243</a> <span class="keywordtype">real</span> :: psmean = PSURF_EARTH <span class="comment">! Mean of Ps on Earth</span>
<a name="l00244"></a>00244 <span class="keywordtype">real</span> :: rotspd =     1.0  <span class="comment">! rotation speed 1.0 = normal Earth rotation</span>
<a name="l00245"></a>00245 <span class="keywordtype">real</span> :: sigmax =  6.0e-7  <span class="comment">! sigma for top half level</span>
<a name="l00246"></a>00246 <span class="keywordtype">real</span> :: tdiss  =    0.25  <span class="comment">! diffusion time scale [days]</span>
<a name="l00247"></a>00247 <span class="keywordtype">real</span> :: tac    =   360.0  <span class="comment">! length of annual cycle [days] (0 = no cycle)</span>
<a name="l00248"></a>00248 <span class="keywordtype">real</span> :: pac    =     0.0  <span class="comment">! phase of the annual cycle [days]</span>
<a name="l00249"></a>00249 <span class="keywordtype">real</span> :: tgr    =   288.0  <span class="comment">! Ground Temperature in mean profile [K]</span>
<a name="l00250"></a><a class="code" href="classpumamod.html#a529184e9404faf138c07e7f28afee2e1">00250</a> <span class="keywordtype">real</span> :: dvdiff =     0.0  <span class="comment">! vertical diffusion coefficient [m2/s]</span>
<a name="l00251"></a>00251 <span class="comment">!                         ! dvdiff =0. means no vertical diffusion</span>
<a name="l00252"></a><a class="code" href="classpumamod.html#a4fc16343d9407e3714e301309177a08a">00252</a> <span class="keywordtype">real</span> :: disp   =     0.0  <span class="comment">! noise dispersion</span>
<a name="l00253"></a>00253 <span class="keywordtype">real</span> :: tauta  =    40.0  <span class="comment">! heating timescale far from surface</span>
<a name="l00254"></a>00254 <span class="keywordtype">real</span> :: tauts  =     4.0  <span class="comment">! heating timescale close to surface</span>
<a name="l00255"></a><a class="code" href="classpumamod.html#a594702993f401d2641f71890a8f9f6f5">00255</a> <span class="keywordtype">real</span> :: pspon  = 50.      <span class="comment">! apply sponge layer where p &lt; pspon</span>
<a name="l00256"></a>00256 <span class="comment">!                         ! pressure [Pa]</span>
<a name="l00257"></a><a class="code" href="classpumamod.html#ad1a6236311cdfb3949ec1b1c262b59ac">00257</a> <span class="keywordtype">real</span> :: sponk  =  0.5     <span class="comment">! max. damping coefficient for sponge layer,</span>
<a name="l00258"></a>00258 <span class="comment">!                         ! unit: [1/day]</span>
<a name="l00259"></a>00259 
<a name="l00260"></a>00260 <span class="comment">! **************************</span>
<a name="l00261"></a>00261 <span class="comment">! * Global Spectral Arrays *</span>
<a name="l00262"></a>00262 <span class="comment">! **************************</span>
<a name="l00263"></a>00263 
<a name="l00264"></a><a class="code" href="classpumamod.html#a607c73cd3e6556d8dfa4337bb71bad61">00264</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sd(:,:)  <span class="comment">! Spectral Divergence</span>
<a name="l00265"></a><a class="code" href="classpumamod.html#a4ec415d0ab8671b481436b79bc708c4d">00265</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdd(:,:) <span class="comment">! Difference between instances</span>
<a name="l00266"></a><a class="code" href="classpumamod.html#a9e5f2e6b01b35c141b673be058d6ba52">00266</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: st(:,:)  <span class="comment">! Spectral Temperature</span>
<a name="l00267"></a><a class="code" href="classpumamod.html#ac4bf8bb0f46d1d2f91f95e10be02a738">00267</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: std(:,:) <span class="comment">! Difference between instances</span>
<a name="l00268"></a><a class="code" href="classpumamod.html#aad136f237f5ca5d94b6f0e0e742864df">00268</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: st1(:,:) <span class="comment">! Spectral Temperature at t-1 (for NEXTOUT == 1)</span>
<a name="l00269"></a><a class="code" href="classpumamod.html#a69fc3701590281746d17dcb2f80c1c03">00269</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: st2(:,:) <span class="comment">! Spectral Temperature at t-2 (for NEXTOUT == 1)</span>
<a name="l00270"></a><a class="code" href="classpumamod.html#a6da929d3d47a0b47afc30657bf43cb74">00270</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sz(:,:)  <span class="comment">! Spectral Vorticity</span>
<a name="l00271"></a><a class="code" href="classpumamod.html#a2de620590b09238085f6a8c4810c4392">00271</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szd(:,:) <span class="comment">! Difference between instances</span>
<a name="l00272"></a><a class="code" href="classpumamod.html#a62dbb101d0fe728fa2231fa3482ee7b1">00272</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sp(:)    <span class="comment">! Spectral Pressure (ln Ps)</span>
<a name="l00273"></a><a class="code" href="classpumamod.html#a99ec3c13cdd619b700160372a330f531">00273</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spd(:)   <span class="comment">! Difference between instances</span>
<a name="l00274"></a><a class="code" href="classpumamod.html#a02a75a47225d636193b203a0d7ccc4ee">00274</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sq(:,:)  <span class="comment">! For compatibility with PlaSim</span>
<a name="l00275"></a><a class="code" href="classpumamod.html#a8509c5063893002e614541f3f546db2f">00275</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sp1(:)   <span class="comment">! Spectral Pressure at t-1 (for NEXTOUT == 1)</span>
<a name="l00276"></a><a class="code" href="classpumamod.html#ac0a89b4b892f00ce4069b1adc76ac1ad">00276</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sp2(:)   <span class="comment">! Spectral Pressure at t-2 (for NEXTOUT == 1)</span>
<a name="l00277"></a><a class="code" href="classpumamod.html#ab0c826a52384cc9195a2244e7003cab8">00277</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: so(:)    <span class="comment">! Spectral Orography</span>
<a name="l00278"></a>00278 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sr1(:,:) <span class="comment">! Spectral Restoration Temperature</span>
<a name="l00279"></a>00279 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sr2(:,:) <span class="comment">! Spectral Restoration Temperature</span>
<a name="l00280"></a>00280 
<a name="l00281"></a><a class="code" href="classpumamod.html#aa56f906a0a8233f5a59a2dd2375d7bfe">00281</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdp(:,:) <span class="comment">! Spectral Divergence  Partial</span>
<a name="l00282"></a><a class="code" href="classpumamod.html#aad8ec9e8e440a8a077624b05430d1d65">00282</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stp(:,:) <span class="comment">! Spectral Temperature Partial</span>
<a name="l00283"></a><a class="code" href="classpumamod.html#a1d691f7ffd430d06377c953ac7b1615a">00283</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szp(:,:) <span class="comment">! Spectral Vorticity   Partial</span>
<a name="l00284"></a><a class="code" href="classpumamod.html#a8c0d3d0d8eaeee34966b2ed8cdab6880">00284</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spp(:)   <span class="comment">! Spectral Pressure    Partial</span>
<a name="l00285"></a><a class="code" href="classpumamod.html#ad94d9ab7dd97c7f24ccfca4e9c1dcadd">00285</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sop(:)   <span class="comment">! Spectral Orography   Partial</span>
<a name="l00286"></a><a class="code" href="classpumamod.html#a610ade488da8477514d377f4d3113078">00286</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: srp1(:,:)<span class="comment">! Spectral Restoration Partial</span>
<a name="l00287"></a><a class="code" href="classpumamod.html#aedc7ade1364d2e510fe5a9e17d2ee551">00287</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: srp2(:,:)<span class="comment">! Spectral Restoration Partial</span>
<a name="l00288"></a>00288 
<a name="l00289"></a><a class="code" href="classpumamod.html#a6469b0773780c7e85cc8fe80dab7360c">00289</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdt(:,:) <span class="comment">! Spectral Divergence  Tendency</span>
<a name="l00290"></a><a class="code" href="classpumamod.html#a38a8cfb3cd3b1ccf0fd5b7283e0949be">00290</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stt(:,:) <span class="comment">! Spectral Temperature Tendency</span>
<a name="l00291"></a><a class="code" href="classpumamod.html#a9414c9820ee505006ea2ef90a1e4786c">00291</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szt(:,:) <span class="comment">! Spectral Vorticity   Tendency</span>
<a name="l00292"></a><a class="code" href="classpumamod.html#a86dd88d1dc1d0d21eeb13c11905d7b66">00292</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spt(:)   <span class="comment">! Spectral Pressure    Tendency</span>
<a name="l00293"></a>00293 
<a name="l00294"></a><a class="code" href="classpumamod.html#a4285b7b3267876729285e16aca07035e">00294</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdm(:,:) <span class="comment">! Spectral Divergence  Minus</span>
<a name="l00295"></a><a class="code" href="classpumamod.html#a636c3a27cc6a7aa8f63fd4d322406517">00295</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stm(:,:) <span class="comment">! Spectral Temperature Minus</span>
<a name="l00296"></a><a class="code" href="classpumamod.html#a7961c979cb0a5cb3cfb7cce5a9d16d6b">00296</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szm(:,:) <span class="comment">! Spectral Vorticity   Minus</span>
<a name="l00297"></a><a class="code" href="classpumamod.html#a2bc3d91e2e9c16048446dbd12448ed2d">00297</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spm(:)   <span class="comment">! Spectral Pressure    Minus</span>
<a name="l00298"></a>00298 
<a name="l00299"></a><a class="code" href="classpumamod.html#ae752a8854b0014c33704f7390b78687d">00299</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sak(:)   <span class="comment">! Hyper diffusion</span>
<a name="l00300"></a><a class="code" href="classpumamod.html#a98103b850b9c24c95bac646961ae0209">00300</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: srcn(:)  <span class="comment">! 1.0 / (n * (n+1))</span>
<a name="l00301"></a><a class="code" href="classpumamod.html#aaf3b11d526905c319b065f60804ba566">00301</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: span(:)  <span class="comment">! Pressure for diagnostics</span>
<a name="l00302"></a>00302 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spnorm(:)<span class="comment">! Factors for output normalization</span>
<a name="l00303"></a>00303 
<a name="l00304"></a><a class="code" href="classpumamod.html#a7902698a1673a4c65dd8e7443a7fcc6f">00304</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nindex(:)  <span class="comment">! Holds wavenumber</span>
<a name="l00305"></a><a class="code" href="classpumamod.html#a8a778542c0d1ac00f0d4ccffe08f7190">00305</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nscatsp(:) <span class="comment">! Used for reduce_scatter op</span>
<a name="l00306"></a><a class="code" href="classpumamod.html#a14bc87e591fb027289ef3d9eb40b8a70">00306</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nselzw(:)  <span class="comment">! Enable/disable selected zonal waves</span>
<a name="l00307"></a><a class="code" href="classpumamod.html#a4f4aaa4c774bb1500caa0de7ca16bbe8">00307</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nselsp(:)  <span class="comment">! Enable/disable slected spectral modes</span>
<a name="l00308"></a>00308 
<a name="l00309"></a>00309 <span class="comment">! ***************************</span>
<a name="l00310"></a>00310 <span class="comment">! * Global Gridpoint Arrays *</span>
<a name="l00311"></a>00311 <span class="comment">! ***************************</span>
<a name="l00312"></a>00312 
<a name="l00313"></a><a class="code" href="classpumamod.html#a50103ebf2d2ba2366f2eca07abaabeb4">00313</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gd(:,:)     <span class="comment">! Divergence</span>
<a name="l00314"></a><a class="code" href="classpumamod.html#a3001f3699640a16cd7f91c6aa528af16">00314</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gt(:,:)     <span class="comment">! Temperature</span>
<a name="l00315"></a><a class="code" href="classpumamod.html#af24b389b45d2a20b68ea5bfc7cc48d17">00315</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gz(:,:)     <span class="comment">! Vorticity</span>
<a name="l00316"></a><a class="code" href="classpumamod.html#aaed48b35d778e5c3095fcd1083bbe804">00316</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gu(:,:)     <span class="comment">! u * cos(phi)</span>
<a name="l00317"></a><a class="code" href="classpumamod.html#a88b0140b2435578aa69cb4ac9781b91c">00317</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gv(:,:)     <span class="comment">! v * sin(phi)</span>
<a name="l00318"></a><a class="code" href="classpumamod.html#a6626db807402c61328ae36fddbeec5f1">00318</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gp(:)       <span class="comment">! Ln(Ps)</span>
<a name="l00319"></a><a class="code" href="classpumamod.html#a562c8285b90afd93ee2add1099a55e0f">00319</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gq(:,:)     <span class="comment">! For compatibilty with PlaSim</span>
<a name="l00320"></a><a class="code" href="classpumamod.html#aee702bf92e2a4578e4ff0adbdafcaadb">00320</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gfu(:,:)    <span class="comment">! Term Fu in Primitive Equations</span>
<a name="l00321"></a><a class="code" href="classpumamod.html#a3398d85c059c2cbe3948907b12a9058e">00321</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gfv(:,:)    <span class="comment">! Term Fv in Primitive Equations</span>
<a name="l00322"></a><a class="code" href="classpumamod.html#a54c30e8bd1e5b308c4111eaac995f578">00322</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gut(:,:)    <span class="comment">! Term u * T</span>
<a name="l00323"></a><a class="code" href="classpumamod.html#a1b9d24404ad1e089ee401e7c00ec79f0">00323</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gvt(:,:)    <span class="comment">! Term v * T</span>
<a name="l00324"></a><a class="code" href="classpumamod.html#a9c3f9d77d6c9acc5e900cb8fce8f8ac3">00324</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gke(:,:)    <span class="comment">! Kinetic energy u * u + v * v</span>
<a name="l00325"></a><a class="code" href="classpumamod.html#add5a9e2d129fa1c8bfe199f84263c9f7">00325</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gpj(:)      <span class="comment">! d(Ln(Ps)) / d(mu)</span>
<a name="l00326"></a><a class="code" href="classpumamod.html#a1102b7714ee109056cd4b64bb9ba96e4">00326</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: rcsq(:)     <span class="comment">! 1 / cos2(phi)</span>
<a name="l00327"></a><a class="code" href="classpumamod.html#a631f8bc1450b1c083f26a35cab8d87cc">00327</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: ruido(:,:,:)<span class="comment">! noise (nlon,nlat,nlev)</span>
<a name="l00328"></a><a class="code" href="classpumamod.html#a839f7aa31c37072113405a43e334292e">00328</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: ruidop(:,:) <span class="comment">! noise partial (nhor,nlev)</span>
<a name="l00329"></a><a class="code" href="classpumamod.html#a697a2f43424ec02c33ad0e069f60edd2">00329</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtdamp(:,:) <span class="comment">! 3D reciprocal damping times [1/sec] </span>
<a name="l00330"></a>00330                                  <span class="comment">! for relaxation in grid point space </span>
<a name="l00331"></a>00331                                  <span class="comment">! for radiative restoration temperature </span>
<a name="l00332"></a>00332                                  <span class="comment">! (e.g. for Held&amp;Suarez)</span>
<a name="l00333"></a><a class="code" href="classpumamod.html#a550fb7dbedcb399eeee029f09e0261c7">00333</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr1(:,:)    <span class="comment">! constant radiative restoration time scale</span>
<a name="l00334"></a><a class="code" href="classpumamod.html#acb504294dc512bdee020e63fcc43c51c">00334</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr2(:,:)    <span class="comment">! variable radiative restoration time scale</span>
<a name="l00335"></a><a class="code" href="classpumamod.html#ab154b81faaea8224202d205d5377ecb5">00335</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtdampc(:,:)<span class="comment">! the same as gtdamp, but for convective  </span>
<a name="l00336"></a>00336                                  <span class="comment">! restoration temperature</span>
<a name="l00337"></a><a class="code" href="classpumamod.html#a3ad097353e5e4017c75dd08d77f374f3">00337</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr1c(:,:)   <span class="comment">! constant convective restoration time scale</span>
<a name="l00338"></a><a class="code" href="classpumamod.html#a0063c8f28d68f19195b2154874bb4605">00338</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr2c(:,:)   <span class="comment">! variable convective restoration time scale</span>
<a name="l00339"></a>00339 
<a name="l00340"></a>00340 <span class="comment">! *********************</span>
<a name="l00341"></a>00341 <span class="comment">! * Diagnostic Arrays *</span>
<a name="l00342"></a>00342 <span class="comment">! *********************</span>
<a name="l00343"></a>00343 
<a name="l00344"></a><a class="code" href="classpumamod.html#a8cd6f320c3166f241ade820dc3eadb39">00344</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: ndil(:) <span class="comment">! Set diagnostics level</span>
<a name="l00345"></a>00345 
<a name="l00346"></a><a class="code" href="classpumamod.html#a9dbdc63a5f305db50a26a47cc34d00c7">00346</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: csu(:,:) <span class="comment">! Cross section u [m/s]</span>
<a name="l00347"></a><a class="code" href="classpumamod.html#a3ab8cd6714b1bbb4233200b9acba2904">00347</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: csv(:,:) <span class="comment">! Cross section v [m/s]</span>
<a name="l00348"></a><a class="code" href="classpumamod.html#aec021878423837a34bb3de710083412f">00348</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: cst(:,:) <span class="comment">! Cross section T [Celsius]</span>
<a name="l00349"></a>00349 
<a name="l00350"></a><a class="code" href="classpumamod.html#aeea321b5684fff3240d0367b970bde23">00350</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: denergy(:,:)     <span class="comment">! energy diagnostics</span>
<a name="l00351"></a><a class="code" href="classpumamod.html#a22d2a10d8b9f03d90130b1ccef2ec7c9">00351</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: dentropy(:,:)    <span class="comment">! entropy diagnostics</span>
<a name="l00352"></a>00352 
<a name="l00353"></a>00353 <span class="comment">! *******************</span>
<a name="l00354"></a>00354 <span class="comment">! * Latitude Arrays *</span>
<a name="l00355"></a>00355 <span class="comment">! *******************</span>
<a name="l00356"></a>00356 
<a name="l00357"></a>00357 <span class="keywordtype">character (3)</span>,<span class="keywordtype">allocatable</span> :: chlat(:) <span class="comment">! label for latitudes</span>
<a name="l00358"></a>00358 <span class="keywordtype">real (kind=8)</span>,<span class="keywordtype">allocatable</span> :: sid(:)   <span class="comment">! sin(phi)</span>
<a name="l00359"></a>00359 <span class="keywordtype">real (kind=8)</span>,<span class="keywordtype">allocatable</span> :: gwd(:)   <span class="comment">! Gaussian weight (phi)</span>
<a name="l00360"></a><a class="code" href="classpumamod.html#a4577fee5af720d3d5cee446b6bd36d0c">00360</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: csq(:)            <span class="comment">! cos2(phi)</span>
<a name="l00361"></a><a class="code" href="classpumamod.html#a121f56c4792fab7bbc57da6a356ba13f">00361</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: rcs(:)            <span class="comment">! 1/cos(phi)</span>
<a name="l00362"></a>00362 
<a name="l00363"></a>00363 <span class="comment">! ****************</span>
<a name="l00364"></a>00364 <span class="comment">! * Level Arrays *</span>
<a name="l00365"></a>00365 <span class="comment">! ****************</span>
<a name="l00366"></a>00366 
<a name="l00367"></a><a class="code" href="classpumamod.html#aa0e5d4127d9cbc662e69de401ab0878f">00367</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: t0(:)            <span class="comment">! reference temperature</span>
<a name="l00368"></a>00368 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: t0d(:)           <span class="comment">! vertical t0 gradient</span>
<a name="l00369"></a><a class="code" href="classpumamod.html#aa37496e277d03000616cdb2e5b22d7c0">00369</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: taur(:)          <span class="comment">! tau R [days]</span>
<a name="l00370"></a><a class="code" href="classpumamod.html#aaddf02e0bb890f2c703effae4cf26a68">00370</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: tauf(:)          <span class="comment">! tau F [days]</span>
<a name="l00371"></a><a class="code" href="classpumamod.html#a4c165b031088a68ae36d654a5763aef8">00371</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: damp(:)          <span class="comment">! 1.0 / (2 Pi * taur)</span>
<a name="l00372"></a><a class="code" href="classpumamod.html#a859085f4ee94ade9cc560157a833370e">00372</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: fric(:)          <span class="comment">! 1.0 / (2 Pi * tauf  )</span>
<a name="l00373"></a>00373 
<a name="l00374"></a><a class="code" href="classpumamod.html#abc2d5c00d5e5856e8cbc8ed5bee74d11">00374</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: bm1(:,:,:)
<a name="l00375"></a>00375 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: dsigma(:)
<a name="l00376"></a>00376 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: rdsig(:)
<a name="l00377"></a>00377 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sigma(:)         <span class="comment">! full level sigma</span>
<a name="l00378"></a><a class="code" href="classpumamod.html#aef4b93fe13f4ff77ca4ad9b9b5245918">00378</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sigmh(:)         <span class="comment">! half level sigma</span>
<a name="l00379"></a>00379 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: tkp(:)
<a name="l00380"></a><a class="code" href="classpumamod.html#a273a105c71e26860f1f83ca28020bbda">00380</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: c(:,:)
<a name="l00381"></a><a class="code" href="classpumamod.html#a0d93d94e3ecf78ee4c82020b9e1ee95f">00381</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: xlphi(:,:)       <span class="comment">! matrix Lphi (g)</span>
<a name="l00382"></a><a class="code" href="classpumamod.html#a2f42df0a3ac789b2cb6e996a00f16fb4">00382</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: xlt(:,:)         <span class="comment">! matrix LT (tau)</span>
<a name="l00383"></a>00383 
<a name="l00384"></a>00384 <span class="comment">! ******************</span>
<a name="l00385"></a>00385 <span class="comment">! * Parallel Stuff *</span>
<a name="l00386"></a>00386 <span class="comment">! ******************</span>
<a name="l00387"></a>00387 
<a name="l00388"></a><a class="code" href="classpumamod.html#af617e09ab068329347fe45e390e46923">00388</a> <span class="keywordtype">integer</span> :: myworld = 0                   <span class="comment">! MPI variable</span>
<a name="l00389"></a><a class="code" href="classpumamod.html#a34212fc920287542d5b665298e229090">00389</a> <span class="keywordtype">integer</span> :: mpinfo  = 0                   <span class="comment">! MPI variable</span>
<a name="l00390"></a><a class="code" href="classpumamod.html#abe37e4023fe000a8d7a8f39be8dd8354">00390</a> <span class="keywordtype">integer</span> :: mypid   = 0                   <span class="comment">! My Process Id</span>
<a name="l00391"></a><a class="code" href="classpumamod.html#ab552a94bc8d5d3e4a56303ac4249b894">00391</a> <span class="keywordtype">real</span>    :: tmstart = 0.0                 <span class="comment">! CPU time at start</span>
<a name="l00392"></a><a class="code" href="classpumamod.html#a6b2cc93bbb820f9aa438282188e75eef">00392</a> <span class="keywordtype">real</span>    :: tmstop  = 0.0                 <span class="comment">! CPU time at stop</span>
<a name="l00393"></a><a class="code" href="classpumamod.html#a0961a19034b2c5becab0fe77c8e767b6">00393</a> <span class="keywordtype">character(80)</span>, <span class="keywordtype">allocatable</span> :: ympname(:) <span class="comment">! Processor name</span>
<a name="l00394"></a>00394 
<a name="l00395"></a>00395 
<a name="l00396"></a>00396 <span class="comment">! **********************</span>
<a name="l00397"></a>00397 <span class="comment">! * Multirun variables *</span>
<a name="l00398"></a>00398 <span class="comment">! **********************</span>
<a name="l00399"></a>00399 
<a name="l00400"></a><a class="code" href="classpumamod.html#afdffea792867b992f5d1d117bea912e9">00400</a> <span class="keywordtype">integer</span> :: mrworld =  0   <span class="comment">! MPI communication</span>
<a name="l00401"></a><a class="code" href="classpumamod.html#a52d0e34b3a5be19fc3b8d0f11cae3cd2">00401</a> <span class="keywordtype">integer</span> :: mrinfo  =  0   <span class="comment">! MPI info</span>
<a name="l00402"></a><a class="code" href="classpumamod.html#a7243d78ff49021834f74c4f372747e25">00402</a> <span class="keywordtype">integer</span> :: mrpid   = -1   <span class="comment">! MPI instance id</span>
<a name="l00403"></a><a class="code" href="classpumamod.html#aca86db6e1c10c1b9517477ce5edbe883">00403</a> <span class="keywordtype">integer</span> :: mrnum   =  0   <span class="comment">! MPI number of instances</span>
<a name="l00404"></a><a class="code" href="classpumamod.html#af045ac8932ed34ae0d921a49d9696202">00404</a> <span class="keywordtype">integer</span> :: mintru  =  0   <span class="comment">! Lowest resolution of all instances</span>
<a name="l00405"></a><a class="code" href="classpumamod.html#adefb6afc38014b7c141a67f0036bb9fd">00405</a> <span class="keywordtype">integer</span> :: mrdim   =  0   <span class="comment">! Exchange dimension  (min. NRSP)</span>
<a name="l00406"></a>00406 <span class="keywordtype">integer</span> :: nsync   =  0   <span class="comment">! Synchronization on or off</span>
<a name="l00407"></a><a class="code" href="classpumamod.html#a6f3661b2cfef35aad460858a54bac179">00407</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: mrtru(:) <span class="comment">! Truncations of members</span>
<a name="l00408"></a>00408 
<a name="l00409"></a>00409 <span class="keywordtype">real</span>    :: syncstr  =  0.0 <span class="comment">! Coupling strength (0 .. 1)</span>
<a name="l00410"></a><a class="code" href="classpumamod.html#a24c3f399235c4ea5f2d8e1f867f8776d">00410</a> <span class="keywordtype">real</span>    :: synctime =  0.0 <span class="comment">! Coupling time [days]</span>
<a name="l00411"></a>00411 
<a name="l00412"></a>00412 <span class="comment">! ******************************************</span>
<a name="l00413"></a>00413 <span class="comment">! * GUI (Graphical User Interface for X11) *</span>
<a name="l00414"></a>00414 <span class="comment">! ******************************************</span>
<a name="l00415"></a>00415 
<a name="l00416"></a>00416 parameter (NPARCS = 10)         <span class="comment">! Number of GUI parameters</span>
<a name="l00417"></a>00417 <span class="keywordtype">integer</span> :: nguidbg   =  0       <span class="comment">! Flag for GUI debug output</span>
<a name="l00418"></a><a class="code" href="classpumamod.html#a55d8354fd0488524eb882076f145db4c">00418</a> <span class="keywordtype">integer</span> :: nshutdown =  0       <span class="comment">! Flag for shutdown request</span>
<a name="l00419"></a><a class="code" href="classpumamod.html#ae562873ebeeb138df379c847e7e01ee4">00419</a> <span class="keywordtype">integer</span> :: ndatim(6) = -1       <span class="comment">! Date &amp; time array</span>
<a name="l00420"></a><a class="code" href="classpumamod.html#ae2c4727393fa343e9b1bc8a3c74aaadc">00420</a> <span class="keywordtype">real(kind=4)</span> :: parc(NPARCS)    <span class="comment">! Values of GUI parameters</span>
<a name="l00421"></a><a class="code" href="classpumamod.html#ade587d2c84caf94c7f54e8d358d42455">00421</a> <span class="keywordtype">real(kind=4)</span> :: crap(NPARCS)    <span class="comment">! Backup of parc(NPARCS)</span>
<a name="l00422"></a><a class="code" href="classpumamod.html#ad6ef8c9bbafbe30d455ecbedd0091142">00422</a> <span class="keywordtype">logical</span> :: ldtep   = .FALSE.    <span class="comment">! DTEP changed by GUI</span>
<a name="l00423"></a><a class="code" href="classpumamod.html#ad987421134978995be7290187c82fda2">00423</a> <span class="keywordtype">logical</span> :: ldtns   = .FALSE.    <span class="comment">! DTNS changed by GUI</span>
<a name="l00424"></a><a class="code" href="classpumamod.html#a903a55d5d849abb77aa4ccb8534add13">00424</a> <span class="keywordtype">character(len=32)</span> :: yplanet = <span class="stringliteral">&quot;Earth&quot;</span>
<a name="l00425"></a>00425 
<a name="l00426"></a>00426 <span class="comment">! ***************</span>
<a name="l00427"></a>00427 <span class="comment">! * Random seed *</span>
<a name="l00428"></a>00428 <span class="comment">! ***************</span>
<a name="l00429"></a>00429 
<a name="l00430"></a><a class="code" href="classpumamod.html#a79c75848ef94fd2ff5e362ea59c98cbe">00430</a> <span class="keywordtype">integer</span>              :: seed(8) = 0 <span class="comment">! settable in namelist</span>
<a name="l00431"></a><a class="code" href="classpumamod.html#a1909f4521ecd22aa8e00db6e17c10ad9">00431</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: meed(:)     <span class="comment">! machine dependent seed</span>
<a name="l00432"></a><a class="code" href="classpumamod.html#a936da81a07a9bfa83bea326d29f5a5d9">00432</a> <span class="keywordtype">real</span>                 :: ganext = 0.0<span class="comment">! y part of gaussian noise</span>
<a name="l00433"></a>00433 
<a name="l00434"></a>00434 <span class="keyword">end module pumamod</span>
<a name="l00435"></a>00435 
<a name="l00436"></a>00436 <span class="comment">!***************!</span>
<a name="l00437"></a>00437 <span class="comment">! MODULE RADMOD !</span>
<a name="l00438"></a>00438 <span class="comment">!***************!</span>
<a name="l00439"></a>00439 
<a name="l00440"></a><a class="code" href="classradmod.html">00440</a> <span class="keyword">module</span> <a class="code" href="classradmod.html">radmod</a>       <span class="comment">! Dummy declaration for compatibility</span>
<a name="l00441"></a>00441 use <span class="keywordflow">pumamod</span>         <span class="comment">! with PLASIM (needed in guimod)</span>
<a name="l00442"></a>00442 <span class="keyword">end module radmod</span>
<a name="l00443"></a>00443 
<a name="l00444"></a>00444 
<a name="l00445"></a>00445 <span class="comment">! ***************** !</span>
<a name="l00446"></a>00446 <span class="comment">! * MODULE PPPMOD * !</span>
<a name="l00447"></a>00447 <span class="comment">! ***************** !</span>
<a name="l00448"></a>00448 
<a name="l00449"></a><a class="code" href="classprepmod.html">00449</a> <span class="keyword">module</span> <a class="code" href="classprepmod.html">prepmod</a>
<a name="l00450"></a><a class="code" href="classprepmod.html#af7c26e3eb6ac74ce7f869f994f3f9096">00450</a> <span class="keywordtype">integer</span> :: num_ppp  = 0
<a name="l00451"></a><a class="code" href="classprepmod.html#ab9f52241ed0e8b24728713f99adbef26">00451</a> <span class="keywordtype">integer</span> :: nlat_ppp = 0
<a name="l00452"></a><a class="code" href="classprepmod.html#ab4424b6e9966133154f2c7521b4f20c7">00452</a> <span class="keywordtype">integer</span> :: nlev_ppp = 0
<a name="l00453"></a>00453 
<a name="l00454"></a><a class="code" href="structprepmod_1_1ppp__type.html">00454</a> <span class="keyword">type</span> <a class="code" href="structprepmod_1_1ppp__type.html">ppp_type</a>
<a name="l00455"></a><a class="code" href="structprepmod_1_1ppp__type.html#ab9ad26f6cbb64570cc4171b5bb1ad15e">00455</a>    <span class="keywordtype">character (80)</span>   :: name    <span class="comment">! name of variable or array</span>
<a name="l00456"></a><a class="code" href="structprepmod_1_1ppp__type.html#a50ade2f5ae307f4416d1c41fc74ea2f0">00456</a>    <span class="keywordtype">logical</span>          :: isint   <span class="comment">! .true. for integer</span>
<a name="l00457"></a><a class="code" href="structprepmod_1_1ppp__type.html#ad89d33651c91bc5a6594a9522916f4c7">00457</a>    <span class="keywordtype">integer</span>          :: n       <span class="comment">! length of vector (1 for scalar)</span>
<a name="l00458"></a><a class="code" href="structprepmod_1_1ppp__type.html#a4e5bc8c49dff8e4b1dff9722c55e3b43">00458</a>    <span class="keywordtype">integer</span>, <span class="keywordtype">pointer</span> :: pint    <span class="comment">! pointer to integer value or array</span>
<a name="l00459"></a><a class="code" href="structprepmod_1_1ppp__type.html#a98966af6cabcf5a13a3ef4fab52de965">00459</a>    <span class="keywordtype">real</span>   , <span class="keywordtype">pointer</span> :: preal   <span class="comment">! pointer to real    value or array</span>
<a name="l00460"></a>00460 <span class="keyword">end type ppp_type</span>
<a name="l00461"></a>00461 
<a name="l00462"></a><a class="code" href="classprepmod.html#afa7847e6f1a2a1e05e5318e9ec47ad51">00462</a> <span class="keywordtype">type(ppp_type)</span> :: ppp_tab(30)
<a name="l00463"></a>00463 
<a name="l00464"></a>00464 <span class="keyword">interface</span>
<a name="l00465"></a><a class="code" href="interfaceprepmod_1_1ppp__def__int.html#af7c4b83a645bb166b51a24e0844c8c0e">00465</a>    <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(pname,nvar,ndim)
<a name="l00466"></a>00466       <span class="keywordtype">character (*)</span>   :: pname
<a name="l00467"></a>00467       <span class="keywordtype">integer</span>, <span class="keywordtype">target</span> :: nvar
<a name="l00468"></a>00468       <span class="keywordtype">integer</span>         :: ndim
<a name="l00469"></a>00469 <span class="keyword">   end subroutine ppp_def_int</span>
<a name="l00470"></a><a class="code" href="interfaceprepmod_1_1ppp__def__real.html#a9a526e7c4c29459fbd3f636f64f85b1f">00470</a>    <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__real.html">ppp_def_real</a>(pname,rvar,ndim)
<a name="l00471"></a>00471       <span class="keywordtype">character (*)</span>   :: pname
<a name="l00472"></a>00472       <span class="keywordtype">real</span>   , <span class="keywordtype">target</span> :: rvar(*)
<a name="l00473"></a>00473       <span class="keywordtype">integer</span>         :: ndim
<a name="l00474"></a>00474 <span class="keyword">   end subroutine ppp_def_real</span>
<a name="l00475"></a>00475 <span class="keyword">end interface</span>
<a name="l00476"></a>00476 
<a name="l00477"></a>00477 <span class="keyword">end module prepmod</span>
<a name="l00478"></a>00478 
<a name="l00479"></a>00479 
<a name="l00480"></a>00480 <span class="comment">! *********************</span>
<a name="l00481"></a>00481 <span class="comment">! * PROGRAM PUMA_MAIN *</span>
<a name="l00482"></a>00482 <span class="comment">! *********************</span>
<a name="l00483"></a>00483 
<a name="l00484"></a><a class="code" href="puma_8f90.html#ab9b07e4288c177e089731e7560c18ac1">00484</a> <span class="keyword">program</span> <a class="code" href="puma_8f90.html#ab9b07e4288c177e089731e7560c18ac1">puma_main</a>
<a name="l00485"></a>00485 use <span class="keywordflow">pumamod</span>
<a name="l00486"></a>00486 
<a name="l00487"></a>00487 <span class="comment">! ***********</span>
<a name="l00488"></a>00488 <span class="comment">! * History *</span>
<a name="l00489"></a>00489 <span class="comment">! ***********</span>
<a name="l00490"></a>00490 
<a name="l00491"></a>00491 <span class="comment">! 1972 - W. Bourke:</span>
<a name="l00492"></a>00492 <span class="comment">!        An efficient one-level primitive equation spectral model</span>
<a name="l00493"></a>00493 <span class="comment">!        Mon. Weath. Rev., 100, pp. 683-689</span>
<a name="l00494"></a>00494 
<a name="l00495"></a>00495 <span class="comment">! 1975 - B.J. Hoskins and A.J. Simmons: </span>
<a name="l00496"></a>00496 <span class="comment">!        A multi-layer spectral model and the semi-implicit method</span>
<a name="l00497"></a>00497 <span class="comment">!        Qart. J. R. Met. Soc., 101, pp. 637-655</span>
<a name="l00498"></a>00498 
<a name="l00499"></a>00499 <span class="comment">! 1993 - I.N. James and J.P. Dodd:</span>
<a name="l00500"></a>00500 <span class="comment">!        A Simplified Global Circulation Model</span>
<a name="l00501"></a>00501 <span class="comment">!        Users&#39; Manual, Dept. of Meteorology, University of Reading</span>
<a name="l00502"></a>00502 
<a name="l00503"></a>00503 <span class="comment">! 1998 - Klaus Fraedrich, Edilbert Kirk, Frank Lunkeit</span>
<a name="l00504"></a>00504 <span class="comment">!        Portable University Model of the Atmosphere</span>
<a name="l00505"></a>00505 <span class="comment">!        DKRZ Technical Report No. 16</span>
<a name="l00506"></a>00506 
<a name="l00507"></a>00507 <span class="comment">! 2009 - PUMA Version 16.0</span>
<a name="l00508"></a>00508 <span class="comment">!        http://www.mi.uni-hamburg.de/puma</span>
<a name="l00509"></a>00509 
<a name="l00510"></a>00510 <span class="comment">! ******************</span>
<a name="l00511"></a>00511 <span class="comment">! * Recent Changes *</span>
<a name="l00512"></a>00512 <span class="comment">! ******************</span>
<a name="l00513"></a>00513 
<a name="l00514"></a>00514 <span class="comment">! 10-Jun-2002 - Puma Workshop - Documentation of subroutine SPECTRAL</span>
<a name="l00515"></a>00515 <span class="comment">! 04-Jul-2002 - Frank Lunkeit - Annual cycle</span>
<a name="l00516"></a>00516 <span class="comment">! 08-Jul-2002 - Edilbert Kirk - Factor for rotation speed</span>
<a name="l00517"></a>00517 <span class="comment">! 25-Sep-2002 - Puma Workshop - Documentation of subroutine CALCGP</span>
<a name="l00518"></a>00518 <span class="comment">! 11-Nov-2002 - Edilbert Kirk - Add Orography to output file</span>
<a name="l00519"></a>00519 <span class="comment">! 26-Feb-2003 - Edilbert Kirk - Read preprocessed initial file</span>
<a name="l00520"></a>00520 <span class="comment">! 07-Sep-2004 - Edilbert Kirk - Graphical User Interface</span>
<a name="l00521"></a>00521 <span class="comment">! 23-Aug-2006 - Torben Kunz   - Held &amp; Suarez forcing</span>
<a name="l00522"></a>00522 <span class="comment">! 23-Aug-2006 - Torben Kunz   - new spacing schemes of sigma levels</span>
<a name="l00523"></a>00523 <span class="comment">! 23-Aug-2006 - Edilbert Kirk - individual selection of zonal waves</span>
<a name="l00524"></a>00524 <span class="comment">! 23-Aug-2006 - Edilbert Kirk - optimized Legendre trasnformation module</span>
<a name="l00525"></a>00525 <span class="comment">! 19-Feb-2007 - Edilbert Kirk - new flexible restart I/O</span>
<a name="l00526"></a>00526 <span class="comment">! 15-Sep-2009 - Edilbert Kirk - static arrays replaced by allocatable</span>
<a name="l00527"></a>00527 <span class="comment">! 15-Sep-2009 - Frank Lunkeit - diagnostics for entropy production</span>
<a name="l00528"></a>00528 <span class="comment">! 27-Sep-2010 - Edilbert Kirk - cleaned up ruido routines</span>
<a name="l00529"></a>00529 
<a name="l00530"></a>00530 call <a class="code" href="mpimod_8f90.html#a41bbd9334a3d0412c73399d699bbb237">mpstart</a>
<a name="l00531"></a>00531 call <a class="code" href="puma_8f90.html#a37eac16619683a2be841fc68b9281299">setfilenames</a>
<a name="l00532"></a>00532 call <a class="code" href="puma_8f90.html#ab7757291a70ca39d0c7a7e8db515c058">opendiag</a>
<a name="l00533"></a>00533 call <a class="code" href="puma_8f90.html#a811c67568d6f12806d6b6f86813d2bc4">read_resolution</a>
<a name="l00534"></a>00534 call <a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">resolution</a>
<a name="l00535"></a>00535 <span class="keyword">if</span> (mrnum == 2) <span class="keyword">then</span>
<a name="l00536"></a>00536    call <a class="code" href="mpimod_8f90.html#acb4a2403b5f65a70e7e5ff01ea4577f7">mrdimensions</a>
<a name="l00537"></a>00537 <span class="keyword">endif</span>
<a name="l00538"></a>00538 call <a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">allocate_arrays</a>
<a name="l00539"></a>00539 call <a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">prolog</a>
<a name="l00540"></a>00540 call <a class="code" href="puma_8f90.html#af02944c9cc5103c31e4ed9b779e7cc79">master</a>
<a name="l00541"></a>00541 call <a class="code" href="puma_8f90.html#a35d7c22447dc50ab86832b4615994d32">epilog</a>
<a name="l00542"></a>00542 call <a class="code" href="guimod_8f90.html#ad58ecd458338fd5891f0838eda94bb0c">guistop</a>
<a name="l00543"></a>00543 call <a class="code" href="mpimod_8f90.html#ac80e83b9bc0a4b459fed5f3b79cfafa0">mpstop</a>
<a name="l00544"></a>00544 stop
<a name="l00545"></a>00545 <span class="keyword">end program puma_main</span>
<a name="l00546"></a>00546 
<a name="l00547"></a>00547 
<a name="l00548"></a>00548 <span class="comment">! ***************************</span>
<a name="l00549"></a>00549 <span class="comment">! * SUBROUTINE SETFILENAMES *</span>
<a name="l00550"></a>00550 <span class="comment">! ***************************</span>
<a name="l00551"></a>00551 
<a name="l00552"></a><a class="code" href="puma_8f90.html#a37eac16619683a2be841fc68b9281299">00552</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a37eac16619683a2be841fc68b9281299">setfilenames</a>
<a name="l00553"></a>00553 use <span class="keywordflow">pumamod</span>
<a name="l00554"></a>00554 
<a name="l00555"></a>00555 <span class="keywordtype">character (3)</span> :: mrext
<a name="l00556"></a>00556 
<a name="l00557"></a>00557 <span class="keyword">if</span> (mrpid &lt;  0) return <span class="comment">! no multirun</span>
<a name="l00558"></a>00558 
<a name="l00559"></a>00559 <span class="keyword">write</span>(mrext,<span class="stringliteral">&#39;(&quot;_&quot;,i2.2)&#39;</span>) mrpid
<a name="l00560"></a>00560 
<a name="l00561"></a>00561 puma_namelist       = trim(puma_namelist      ) // mrext
<a name="l00562"></a>00562 puma_output         = trim(puma_output        ) // mrext
<a name="l00563"></a>00563 puma_diag           = trim(puma_diag          ) // mrext
<a name="l00564"></a>00564 puma_restart        = trim(puma_restart       ) // mrext
<a name="l00565"></a>00565 puma_status         = trim(puma_status        ) // mrext
<a name="l00566"></a>00566 efficiency_dat      = trim(efficiency_dat     ) // mrext
<a name="l00567"></a>00567 ppp_puma_txt        = trim(ppp_puma_txt       ) // mrext
<a name="l00568"></a>00568 puma_sp_init        = trim(puma_sp_init       ) // mrext
<a name="l00569"></a>00569 
<a name="l00570"></a>00570 return
<a name="l00571"></a>00571 <span class="keyword">end</span>
<a name="l00572"></a>00572 
<a name="l00573"></a>00573 
<a name="l00574"></a>00574 <span class="comment">! ***********************</span>
<a name="l00575"></a>00575 <span class="comment">! * SUBROUTINE OPENDIAG *</span>
<a name="l00576"></a>00576 <span class="comment">! ***********************</span>
<a name="l00577"></a>00577 
<a name="l00578"></a><a class="code" href="puma_8f90.html#ab7757291a70ca39d0c7a7e8db515c058">00578</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ab7757291a70ca39d0c7a7e8db515c058">opendiag</a>
<a name="l00579"></a>00579 use <span class="keywordflow">pumamod</span>
<a name="l00580"></a>00580 
<a name="l00581"></a>00581 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00582"></a>00582    <span class="keyword">open</span>(nud,file=puma_diag)
<a name="l00583"></a>00583 <span class="keyword">endif</span>
<a name="l00584"></a>00584 
<a name="l00585"></a>00585 return
<a name="l00586"></a>00586 <span class="keyword">end</span>
<a name="l00587"></a>00587 
<a name="l00588"></a>00588 
<a name="l00589"></a>00589 <span class="comment">! ******************************</span>
<a name="l00590"></a>00590 <span class="comment">! * SUBROUTINE ALLOCATE_ARRAYS *</span>
<a name="l00591"></a>00591 <span class="comment">! ******************************</span>
<a name="l00592"></a>00592 
<a name="l00593"></a><a class="code" href="puma_8f90.html#a486bae2289e6e28e652b41555030d3e6">00593</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">allocate_arrays</a>
<a name="l00594"></a>00594 use <span class="keywordflow">pumamod</span>
<a name="l00595"></a>00595 
<a name="l00596"></a>00596 <span class="keyword">allocate</span>(sd(nesp,nlev))   ; sd(:,:)  = 0.0 <span class="comment">! Spectral Divergence</span>
<a name="l00597"></a>00597 <span class="keyword">allocate</span>(st(nesp,nlev))   ; st(:,:)  = 0.0 <span class="comment">! Spectral Temperature</span>
<a name="l00598"></a>00598 <span class="keyword">allocate</span>(sz(nesp,nlev))   ; sz(:,:)  = 0.0 <span class="comment">! Spectral Vorticity</span>
<a name="l00599"></a>00599 <span class="keyword">allocate</span>(sp(nesp))        ; sp(:)    = 0.0 <span class="comment">! Spectral Pressure (ln Ps)</span>
<a name="l00600"></a>00600 <span class="keyword">allocate</span>(so(nesp))        ; so(:)    = 0.0 <span class="comment">! Spectral Orography</span>
<a name="l00601"></a>00601 <span class="keyword">allocate</span>(sr1(nesp,nlev))  ; sr1(:,:) = 0.0 <span class="comment">! Spectral Restoration Temperature</span>
<a name="l00602"></a>00602 <span class="keyword">allocate</span>(sr2(nesp,nlev))  ; sr2(:,:) = 0.0 <span class="comment">! Spectral Restoration Temperature</span>
<a name="l00603"></a>00603 <span class="keyword">allocate</span>(sdp(nspp,nlev))  ; sdp(:,:) = 0.0 <span class="comment">! Spectral Divergence  Partial</span>
<a name="l00604"></a>00604 <span class="keyword">allocate</span>(stp(nspp,nlev))  ; stp(:,:) = 0.0 <span class="comment">! Spectral Temperature Partial</span>
<a name="l00605"></a>00605 <span class="keyword">allocate</span>(szp(nspp,nlev))  ; szp(:,:) = 0.0 <span class="comment">! Spectral Vorticity   Partial</span>
<a name="l00606"></a>00606 <span class="keyword">allocate</span>(spp(nspp))       ; spp(:)   = 0.0 <span class="comment">! Spectral Pressure    Partial</span>
<a name="l00607"></a>00607 <span class="keyword">allocate</span>(sop(nspp))       ; sop(:)   = 0.0 <span class="comment">! Spectral Orography   Partial</span>
<a name="l00608"></a>00608 <span class="keyword">allocate</span>(srp1(nspp,nlev)) ; srp1(:,:)= 0.0 <span class="comment">! Spectral Restoration Partial</span>
<a name="l00609"></a>00609 <span class="keyword">allocate</span>(srp2(nspp,nlev)) ; srp2(:,:)= 0.0 <span class="comment">! Spectral Restoration Partial</span>
<a name="l00610"></a>00610 <span class="keyword">allocate</span>(sdt(nspp,nlev))  ; sdt(:,:) = 0.0 <span class="comment">! Spectral Divergence  Tendency</span>
<a name="l00611"></a>00611 <span class="keyword">allocate</span>(stt(nspp,nlev))  ; stt(:,:) = 0.0 <span class="comment">! Spectral Temperature Tendency</span>
<a name="l00612"></a>00612 <span class="keyword">allocate</span>(szt(nspp,nlev))  ; szt(:,:) = 0.0 <span class="comment">! Spectral Vorticity   Tendency</span>
<a name="l00613"></a>00613 <span class="keyword">allocate</span>(spt(nspp))       ; spt(:)   = 0.0 <span class="comment">! Spectral Pressure    Tendency</span>
<a name="l00614"></a>00614 <span class="keyword">allocate</span>(sdm(nspp,nlev))  ; sdm(:,:) = 0.0 <span class="comment">! Spectral Divergence  Minus</span>
<a name="l00615"></a>00615 <span class="keyword">allocate</span>(stm(nspp,nlev))  ; stm(:,:) = 0.0 <span class="comment">! Spectral Temperature Minus</span>
<a name="l00616"></a>00616 <span class="keyword">allocate</span>(szm(nspp,nlev))  ; szm(:,:) = 0.0 <span class="comment">! Spectral Vorticity   Minus</span>
<a name="l00617"></a>00617 <span class="keyword">allocate</span>(spm(nspp))       ; spm(:)   = 0.0 <span class="comment">! Spectral Pressure    Minus</span>
<a name="l00618"></a>00618 <span class="keyword">allocate</span>(sak(nesp))       ; sak(:)   = 0.0 <span class="comment">! Hyper diffusion</span>
<a name="l00619"></a>00619 <span class="keyword">allocate</span>(srcn(nesp))      ; srcn(:)  = 0.0 <span class="comment">! 1.0 / (n * (n+1))</span>
<a name="l00620"></a>00620 <span class="keyword">allocate</span>(span(nesp))      ; span(:)  = 0.0 <span class="comment">! Pressure for diagnostics</span>
<a name="l00621"></a>00621 <span class="keyword">allocate</span>(spnorm(nesp))    ; spnorm(:)= 0.0 <span class="comment">! Factors for output normalization</span>
<a name="l00622"></a>00622 
<a name="l00623"></a>00623 <span class="keyword">allocate</span>(nindex(nesp))    ; nindex(:)  = ntru <span class="comment">! Holds wavenumber</span>
<a name="l00624"></a>00624 <span class="keyword">allocate</span>(nscatsp(npro))   ; nscatsp(:) = nspp <span class="comment">! Used for reduce_scatter op</span>
<a name="l00625"></a>00625 <span class="keyword">allocate</span>(nselzw(0:ntru))  ; nselzw(:)  =    1 <span class="comment">! Enable selected zonal waves</span>
<a name="l00626"></a>00626 <span class="keyword">allocate</span>(nselsp(ncsp))    ; nselsp(:)  =    1 <span class="comment">! Enable slected spectral modes</span>
<a name="l00627"></a>00627 
<a name="l00628"></a>00628 <span class="keyword">allocate</span>(gd(nhor,nlev))   ; gd(:,:)  = 0.0 <span class="comment">! Divergence</span>
<a name="l00629"></a>00629 <span class="keyword">allocate</span>(gt(nhor,nlev))   ; gt(:,:)  = 0.0 <span class="comment">! Temperature</span>
<a name="l00630"></a>00630 <span class="keyword">allocate</span>(gz(nhor,nlev))   ; gz(:,:)  = 0.0 <span class="comment">! Vorticity</span>
<a name="l00631"></a>00631 <span class="keyword">allocate</span>(gu(nhor,nlev))   ; gu(:,:)  = 0.0 <span class="comment">! u * cos(phi)</span>
<a name="l00632"></a>00632 <span class="keyword">allocate</span>(gv(nhor,nlev))   ; gv(:,:)  = 0.0 <span class="comment">! v * sin(phi)</span>
<a name="l00633"></a>00633 <span class="keyword">allocate</span>(gp(nhor))        ; gp(:)    = 0.0 <span class="comment">! Ln(Ps)</span>
<a name="l00634"></a>00634 <span class="keyword">allocate</span>(gfu(nhor,nlev))  ; gfu(:,:) = 0.0 <span class="comment">! Term Fu in Primitive Equations</span>
<a name="l00635"></a>00635 <span class="keyword">allocate</span>(gfv(nhor,nlev))  ; gfv(:,:) = 0.0 <span class="comment">! Term Fv in Primitive Equations</span>
<a name="l00636"></a>00636 <span class="keyword">allocate</span>(gut(nhor,nlev))  ; gut(:,:) = 0.0 <span class="comment">! Term u * T</span>
<a name="l00637"></a>00637 <span class="keyword">allocate</span>(gvt(nhor,nlev))  ; gvt(:,:) = 0.0 <span class="comment">! Term v * T</span>
<a name="l00638"></a>00638 <span class="keyword">allocate</span>(gke(nhor,nlev))  ; gke(:,:) = 0.0 <span class="comment">! Kinetic energy u * u + v * v</span>
<a name="l00639"></a>00639 <span class="keyword">allocate</span>(gpj(nhor))       ; gpj(:)   = 0.0 <span class="comment">! d(Ln(Ps)) / d(mu)</span>
<a name="l00640"></a>00640 
<a name="l00641"></a>00641 
<a name="l00642"></a>00642 <span class="keyword">allocate</span>(rcsq(nhor))      ; rcsq(:)  = 0.0 <span class="comment">! 1 / cos2(phi)</span>
<a name="l00643"></a>00643 
<a name="l00644"></a>00644 <span class="keyword">allocate</span>(ndil(nlev))        ; ndil(:)  = 0
<a name="l00645"></a>00645 <span class="keyword">allocate</span>(csu(nlat,nlev))    ; csu(:,:) = 0.0
<a name="l00646"></a>00646 <span class="keyword">allocate</span>(csv(nlat,nlev))    ; csv(:,:) = 0.0
<a name="l00647"></a>00647 <span class="keyword">allocate</span>(cst(nlat,nlev))    ; cst(:,:) = 0.0
<a name="l00648"></a>00648 
<a name="l00649"></a>00649 <span class="keyword">allocate</span>(chlat(nlat))       ; chlat(:) = <span class="stringliteral">&#39;   &#39;</span>
<a name="l00650"></a>00650 <span class="keyword">allocate</span>(sid(nlat))         ; sid(:)   = 0.0  <span class="comment">! sin(phi)</span>
<a name="l00651"></a>00651 <span class="keyword">allocate</span>(gwd(nlat))         ; gwd(:)   = 0.0  <span class="comment">! Gaussian weight (phi)</span>
<a name="l00652"></a>00652 <span class="keyword">allocate</span>(csq(nlat))         ; csq(:)   = 0.0  <span class="comment">! cos2(phi)</span>
<a name="l00653"></a>00653 <span class="keyword">allocate</span>(rcs(nlat))         ; rcs(:)   = 0.0  <span class="comment">! 1/cos(phi)</span>
<a name="l00654"></a>00654 
<a name="l00655"></a>00655 <span class="keyword">allocate</span>(t0(nlev))     ; t0(:)     = 250.0  <span class="comment">! reference temperature</span>
<a name="l00656"></a>00656 <span class="keyword">allocate</span>(t0d(nlev))    ; t0d(:)    =   0.0  <span class="comment">! vertical t0 gradient</span>
<a name="l00657"></a>00657 <span class="keyword">allocate</span>(taur(nlev))   ; taur(:)   =   0.0  <span class="comment">! tau R [days]</span>
<a name="l00658"></a>00658 <span class="keyword">allocate</span>(tauf(nlev))   ; tauf(:)   =   0.0  <span class="comment">! tau F [days]</span>
<a name="l00659"></a>00659 <span class="keyword">allocate</span>(damp(nlev))   ; damp(:)   =   0.0  <span class="comment">! 1.0 / (2 Pi * taur)</span>
<a name="l00660"></a>00660 <span class="keyword">allocate</span>(fric(nlev))   ; fric(:)   =   0.0  <span class="comment">! 1.0 / (2 Pi * tauf  )</span>
<a name="l00661"></a>00661 <span class="keyword">allocate</span>(dsigma(nlev)) ; dsigma(:) =   0.0
<a name="l00662"></a>00662 <span class="keyword">allocate</span>(rdsig(nlev))  ; rdsig(:)  =   0.0
<a name="l00663"></a>00663 <span class="keyword">allocate</span>(sigma(nlev))  ; sigma(:)  =   0.0
<a name="l00664"></a>00664 <span class="keyword">allocate</span>(sigmh(nlev))  ; sigmh(:)  =   0.0
<a name="l00665"></a>00665 <span class="keyword">allocate</span>(tkp(nlev))    ; tkp(:)    =   0.0
<a name="l00666"></a>00666 <span class="keyword">allocate</span>(c(nlev,nlev)) ; c(:,:)    =   0.0
<a name="l00667"></a>00667 <span class="keyword">allocate</span>(xlphi(nlev,nlev)) ; xlphi(:,:) = 0.0 <span class="comment">! matrix Lphi (g)</span>
<a name="l00668"></a>00668 <span class="keyword">allocate</span>(xlt(nlev,nlev))   ; xlt(:,:)   = 0.0 <span class="comment">! matrix LT (tau)</span>
<a name="l00669"></a>00669 <span class="keyword">allocate</span>(bm1(nlev,nlev,0:NTRU)) ; bm1(:,:,:)  = 0.0
<a name="l00670"></a>00670 
<a name="l00671"></a>00671 <span class="keyword">if</span> (mrnum == 2) <span class="keyword">then</span>
<a name="l00672"></a>00672    <span class="keyword">allocate</span>(sdd(nesp,nlev))   ; sdd(:,:)  = 0.0
<a name="l00673"></a>00673    <span class="keyword">allocate</span>(std(nesp,nlev))   ; std(:,:)  = 0.0
<a name="l00674"></a>00674    <span class="keyword">allocate</span>(szd(nesp,nlev))   ; szd(:,:)  = 0.0
<a name="l00675"></a>00675    <span class="keyword">allocate</span>(spd(nesp     ))   ; spd(:  )  = 0.0
<a name="l00676"></a>00676 <span class="keyword">endif</span>
<a name="l00677"></a>00677 
<a name="l00678"></a>00678 return
<a name="l00679"></a>00679 <span class="keyword">end subroutine allocate_arrays</span>
<a name="l00680"></a>00680 
<a name="l00681"></a>00681 
<a name="l00682"></a>00682 <span class="comment">! =================</span>
<a name="l00683"></a>00683 <span class="comment">! SUBROUTINE PROLOG</span>
<a name="l00684"></a>00684 <span class="comment">! =================</span>
<a name="l00685"></a>00685 
<a name="l00686"></a><a class="code" href="puma_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">00686</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">prolog</a>
<a name="l00687"></a>00687 use <span class="keywordflow">pumamod</span>
<a name="l00688"></a>00688 
<a name="l00689"></a>00689 <span class="keywordtype">character( 8)</span> :: cpuma       = <span class="stringliteral">&#39;PUMA-II &#39;</span>
<a name="l00690"></a>00690 <span class="keywordtype">character(80)</span> :: pumaversion = <span class="stringliteral">&#39;16.0 (27-Sep-2010)&#39;</span>
<a name="l00691"></a>00691 <span class="keywordtype">real</span> :: zsig(nlon*nlat)
<a name="l00692"></a>00692 
<a name="l00693"></a>00693 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00694"></a>00694    call cpu_time(tmstart)
<a name="l00695"></a>00695    <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(/,&quot; ****************************************************&quot;)&#39;</span>)
<a name="l00696"></a>00696    <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; * PUMA &quot;,a43,&quot; *&quot;)&#39;</span>) trim(pumaversion)
<a name="l00697"></a>00697    <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; ****************************************************&quot;)&#39;</span>)
<a name="l00698"></a>00698    <span class="keyword">if</span> (mrnum == 0) <span class="keyword">then</span>
<a name="l00699"></a>00699    <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; * NTRU =&quot;,i4,&quot;  NLEV =&quot;,i4,&quot;  NLON = &quot;,i4,&quot;   NLAT =&quot;,i4,&quot; *&quot;)&#39;</span>) &amp;
<a name="l00700"></a>00700       NTRU,NLEV,NLON,NLAT
<a name="l00701"></a>00701    <span class="keyword">else</span>
<a name="l00702"></a>00702       <span class="keyword">do</span> jpid = 1 , mrnum
<a name="l00703"></a>00703    <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; * PID  =&quot;,i4,&quot;  NTRU =&quot;,i4,&quot;  NLEV = &quot;,i4,&quot;              *&quot;)&#39;</span>) &amp;
<a name="l00704"></a>00704          jpid-1,mrtru(jpid),NLEV
<a name="l00705"></a>00705       <span class="keyword">enddo</span>
<a name="l00706"></a>00706    <span class="keyword">endif</span>
<a name="l00707"></a>00707    <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; ****************************************************&quot;)&#39;</span>)
<a name="l00708"></a>00708    <span class="keyword">if</span> (NPRO &gt; 1) <span class="keyword">then</span>
<a name="l00709"></a>00709      <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(/,&quot; ****************************************************&quot;)&#39;</span>)
<a name="l00710"></a>00710      <span class="keyword">do</span> jpro = 1 , NPRO
<a name="l00711"></a>00711         <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; * CPU&quot;,i4,1x,a40,&quot; *&quot;)&#39;</span>) jpro-1,ympname(jpro)
<a name="l00712"></a>00712      <span class="keyword">enddo</span>
<a name="l00713"></a>00713      <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot; ****************************************************&quot;)&#39;</span>)
<a name="l00714"></a>00714    <span class="keyword">endif</span>
<a name="l00715"></a>00715    call <a class="code" href="restartmod_8f90.html#a1afb89bd2af13e06ddcbeeb393eeb191">restart_ini</a>(lrestart,puma_restart)
<a name="l00716"></a>00716    call <a class="code" href="gaussmod_8f90.html#a841a2f8e9025371eddc985235e1831ab">inigau</a>(NLAT,sid,gwd)
<a name="l00717"></a>00717    call <a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">inilat</a>
<a name="l00718"></a>00718    call <a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">legpri</a>
<a name="l00719"></a>00719    call <a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">readnl</a>
<a name="l00720"></a>00720    call <a class="code" href="puma_8f90.html#a859f80933ca252bcc87f27d3996fea05">ppp_interface</a>
<a name="l00721"></a>00721    call <a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">initpm</a>
<a name="l00722"></a>00722    call <a class="code" href="puma_8f90.html#a96b9223819624937b18b4e5b29e95a91">initsi</a>
<a name="l00723"></a>00723    call <a class="code" href="legsym_8f90.html#ae810767bcafdac840ab48c420efcb49a">altlat</a>(csq,NLAT) <span class="comment">! csq -&gt; alternating grid</span>
<a name="l00724"></a>00724    <span class="keyword">if</span> (ngui &gt; 0) call <a class="code" href="guimod_8f90.html#a77235ccfbc718d5f8b1edc4be08aed03">guistart</a>
<a name="l00725"></a>00725    <span class="keyword">if</span> (nrun == 0 .and. nstop  &gt; 0) nrun = nstop-<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>
<a name="l00726"></a>00726    <span class="keyword">if</span> (nrun == 0) nrun = ntspd * (nyears * 360 + nmonths * 30)
<a name="l00727"></a>00727    call <a class="code" href="puma_8f90.html#acbd8e7fdd2e1f60dbca741a700fb292a">initrandom</a>     <span class="comment">! set random seed</span>
<a name="l00728"></a>00728 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span>
<a name="l00729"></a>00729 
<a name="l00730"></a>00730 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nruido)
<a name="l00731"></a>00731 call <a class="code" href="puma_8f90.html#aea6c13c68157972ea21768a5ea43e154">initruido</a>      <span class="comment">! allocate ruido arrays</span>
<a name="l00732"></a>00732 
<a name="l00733"></a>00733 
<a name="l00734"></a>00734 <span class="keyword">if</span> (nshutdown &gt; 0) return <span class="comment">! If something went wrong in the init routines</span>
<a name="l00735"></a>00735 
<a name="l00736"></a>00736 <span class="comment">! ***********************</span>
<a name="l00737"></a>00737 <span class="comment">! * broadcast &amp; scatter *</span>
<a name="l00738"></a>00738 <span class="comment">! ***********************</span>
<a name="l00739"></a>00739 
<a name="l00740"></a>00740 call <a class="code" href="mpimod_8f90.html#a3d2a5d231fd9527bcbc1fde327326922">mpscdn</a>(sid,NHPP) <span class="comment">! real (kind=8)</span>
<a name="l00741"></a>00741 call <a class="code" href="mpimod_8f90.html#a3d2a5d231fd9527bcbc1fde327326922">mpscdn</a>(gwd,NHPP) <span class="comment">! real (kind=8)</span>
<a name="l00742"></a>00742 call <a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(csq,NLPP)
<a name="l00743"></a>00743 
<a name="l00744"></a>00744 <span class="keyword">do</span> jlat = 1 , NLPP
<a name="l00745"></a>00745    rcsq(1+(jlat-1)*NLON:jlat*NLON) = 1.0 / csq(jlat)
<a name="l00746"></a>00746 <span class="keyword">enddo</span>
<a name="l00747"></a>00747 
<a name="l00748"></a>00748 <span class="comment">!     broadcast integer</span>
<a name="l00749"></a>00749 
<a name="l00750"></a>00750 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(kick    ) <span class="comment">! add noise for kick &gt; 0</span>
<a name="l00751"></a>00751 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nafter  ) <span class="comment">! write data interval [steps]</span>
<a name="l00752"></a>00752 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nwpd    ) <span class="comment">! write data interval [writes per day]</span>
<a name="l00753"></a>00753 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ncoeff  ) <span class="comment">! number of modes to print</span>
<a name="l00754"></a>00754 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndel    ) <span class="comment">! ndel</span>
<a name="l00755"></a>00755 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(noutput ) <span class="comment">! global output switch</span>
<a name="l00756"></a>00756 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndiag   ) <span class="comment">! write diagnostics interval</span>
<a name="l00757"></a>00757 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ngui    ) <span class="comment">! GUI on (1) or off (0)</span>
<a name="l00758"></a>00758 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nkits   ) <span class="comment">! number of initial timesteps</span>
<a name="l00759"></a>00759 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nlevt   ) <span class="comment">! tropospheric levels</span>
<a name="l00760"></a>00760 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nrun    ) <span class="comment">! if (nstop == 0) nstop = nstep + nrun</span>
<a name="l00761"></a>00761 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>   ) <span class="comment">! current timestep</span>
<a name="l00762"></a>00762 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nstop   ) <span class="comment">! finishing timestep</span>
<a name="l00763"></a>00763 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ntspd   ) <span class="comment">! number of timesteps per day</span>
<a name="l00764"></a>00764 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(mpstep  ) <span class="comment">! minutes per step</span>
<a name="l00765"></a>00765 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nyears  ) <span class="comment">! simulation time</span>
<a name="l00766"></a>00766 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nmonths ) <span class="comment">! simulation time</span>
<a name="l00767"></a>00767 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nextout ) <span class="comment">! write extended output</span>
<a name="l00768"></a>00768 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nsponge)  <span class="comment">! Switch for sponge layer</span>
<a name="l00769"></a>00769 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nhelsua)  <span class="comment">! Held &amp; Suarez forcing</span>
<a name="l00770"></a>00770 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndiagp)   <span class="comment">! 0/1 switch for new grid point diabatic heating</span>
<a name="l00771"></a>00771 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nconv)    <span class="comment">! 0/1 switch for convective heating</span>
<a name="l00772"></a>00772 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nvg    )  <span class="comment">! Type of vertical grid</span>
<a name="l00773"></a>00773 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nenergy)  <span class="comment">! energy diagnostics</span>
<a name="l00774"></a>00774 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nentropy) <span class="comment">! entropy diagnostics</span>
<a name="l00775"></a>00775 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndheat)   <span class="comment">! energy recycling</span>
<a name="l00776"></a>00776 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nradcv)  <span class="comment">! use two restoration fields</span>
<a name="l00777"></a>00777 
<a name="l00778"></a>00778 <span class="comment">!     broadcast logical</span>
<a name="l00779"></a>00779 
<a name="l00780"></a>00780 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lrestart) <span class="comment">! true: read restart file, false: initial run</span>
<a name="l00781"></a>00781 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lselect ) <span class="comment">! true: disable some zonal waves</span>
<a name="l00782"></a>00782 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lspecsel) <span class="comment">! true: disable some spectral modes</span>
<a name="l00783"></a>00783 
<a name="l00784"></a>00784 <span class="comment">!     broadcast real</span>
<a name="l00785"></a>00785 
<a name="l00786"></a>00786 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(ww      ) 
<a name="l00787"></a>00787 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(v_scl   )   
<a name="l00788"></a>00788 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(ct      )   
<a name="l00789"></a>00789 
<a name="l00790"></a>00790 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(sid_day ) 
<a name="l00791"></a>00791 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(plarad  )   
<a name="l00792"></a>00792 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(gascon  )   
<a name="l00793"></a>00793 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(akap    )    
<a name="l00794"></a>00794 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(alr     )  
<a name="l00795"></a>00795 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(ga      ) 
<a name="l00796"></a>00796 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(psurf   )  
<a name="l00797"></a>00797 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(alpha   ) <span class="comment">! Williams factor for time filter</span>
<a name="l00798"></a>00798 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtep    ) <span class="comment">! equator-pole temperature difference</span>
<a name="l00799"></a>00799 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtns    )
<a name="l00800"></a>00800 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtrop   )
<a name="l00801"></a>00801 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dttrp   )
<a name="l00802"></a>00802 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tdiss   )
<a name="l00803"></a>00803 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tac     )
<a name="l00804"></a>00804 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(pac     )
<a name="l00805"></a>00805 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(plavor  )
<a name="l00806"></a>00806 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(rotspd  )
<a name="l00807"></a>00807 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(sigmax  ) <span class="comment">! sigma of top half level</span>
<a name="l00808"></a>00808 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tgr     )
<a name="l00809"></a>00809 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dvdiff  )
<a name="l00810"></a>00810 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(disp    )
<a name="l00811"></a>00811 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tauta   )
<a name="l00812"></a>00812 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tauts   )
<a name="l00813"></a>00813 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(pspon   )
<a name="l00814"></a>00814 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(sponk   )
<a name="l00815"></a>00815 
<a name="l00816"></a>00816 <span class="comment">!     broadcast integer arrays</span>
<a name="l00817"></a>00817 
<a name="l00818"></a>00818 call <a class="code" href="mpimod_8f90.html#a85cfae5acde5c37604edf690e9c2f7cf">mpbcin</a>(ndil  ,NLEV)
<a name="l00819"></a>00819 call <a class="code" href="mpimod_8f90.html#a85cfae5acde5c37604edf690e9c2f7cf">mpbcin</a>(nselzw,NTP1)
<a name="l00820"></a>00820 
<a name="l00821"></a>00821 <span class="comment">!     broadcast real arrays</span>
<a name="l00822"></a>00822 
<a name="l00823"></a>00823 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(damp  ,NLEV)
<a name="l00824"></a>00824 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(dsigma,NLEV)
<a name="l00825"></a>00825 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(fric  ,NLEV)
<a name="l00826"></a>00826 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(rdsig ,NLEV)
<a name="l00827"></a>00827 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(taur  ,NLEV)
<a name="l00828"></a>00828 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sigma ,NLEV)
<a name="l00829"></a>00829 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sigmh ,NLEV)
<a name="l00830"></a>00830 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(t0    ,NLEV)
<a name="l00831"></a>00831 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(t0d   ,NLEV)
<a name="l00832"></a>00832 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(tauf  ,NLEV)
<a name="l00833"></a>00833 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(tkp   ,NLEV)
<a name="l00834"></a>00834 
<a name="l00835"></a>00835 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(c     ,NLSQ)
<a name="l00836"></a>00836 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(xlphi ,NLSQ)
<a name="l00837"></a>00837 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(xlt   ,NLSQ)
<a name="l00838"></a>00838 
<a name="l00839"></a>00839 <span class="comment">!     scatter integer arrays</span>
<a name="l00840"></a>00840 
<a name="l00841"></a>00841 call <a class="code" href="mpimod_8f90.html#a8338d8609afcefbb1faa41f353c10ef9">mpscin</a>(nindex,NSPP)
<a name="l00842"></a>00842 call <a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(srcn  ,NSPP)
<a name="l00843"></a>00843 call <a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(sak   ,NSPP)
<a name="l00844"></a>00844 
<a name="l00845"></a>00845 call <a class="code" href="legsym_8f90.html#a86bc436e65d6c4ddde72bb3cce7dc8c8">legini</a>(nlat,nlpp,nesp,nlev,plavor,sid,gwd)
<a name="l00846"></a>00846 
<a name="l00847"></a>00847 <span class="keyword">if</span> (lrestart) <span class="keyword">then</span>
<a name="l00848"></a>00848    call <a class="code" href="puma_8f90.html#aa07fedd638dbdd8e1799b83d34eb35e3">read_atmos_restart</a>
<a name="l00849"></a>00849    <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00850"></a>00850       <span class="keyword">if</span> (kick &gt; 10) call <a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kick-10)
<a name="l00851"></a>00851    <span class="keyword">endif</span>
<a name="l00852"></a>00852 <span class="keyword">else</span>
<a name="l00853"></a>00853    call <a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">initfd</a>
<a name="l00854"></a>00854 <span class="keyword">endif</span>
<a name="l00855"></a>00855 
<a name="l00856"></a>00856 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00857"></a>00857    call <a class="code" href="puma_8f90.html#a9a888c599145a63cdd108dffa553b509">printseed</a> <span class="comment">! either namelist, clock initialized or from restart file</span>
<a name="l00858"></a>00858 <span class="keyword">endif</span>
<a name="l00859"></a>00859 
<a name="l00860"></a>00860 <span class="comment">!     broadcast spectral arrays</span>
<a name="l00861"></a>00861 
<a name="l00862"></a>00862 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sp,NESP)
<a name="l00863"></a>00863 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sd,NESP*NLEV)
<a name="l00864"></a>00864 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(st,NESP*NLEV)
<a name="l00865"></a>00865 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sz,NESP*NLEV)
<a name="l00866"></a>00866 
<a name="l00867"></a>00867 <span class="comment">!     scatter spectral arrays</span>
<a name="l00868"></a>00868 
<a name="l00869"></a>00869 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sd,sdp,NLEV)
<a name="l00870"></a>00870 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(st,stp,NLEV)
<a name="l00871"></a>00871 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sz,szp,NLEV)
<a name="l00872"></a>00872 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sr1,srp1,NLEV)
<a name="l00873"></a>00873 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sr2,srp2,NLEV)
<a name="l00874"></a>00874 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sp,spp,1)
<a name="l00875"></a>00875 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(so,sop,1)
<a name="l00876"></a>00876 
<a name="l00877"></a>00877 <span class="comment">!     scatter gridpoint arrays</span>
<a name="l00878"></a>00878 
<a name="l00879"></a>00879 <span class="keyword">if</span> (nruido &gt; 0) call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(ruido,ruidop,NLEV)
<a name="l00880"></a>00880 
<a name="l00881"></a>00881 <span class="comment">!</span>
<a name="l00882"></a>00882 <span class="comment">!     initialize energy and entropy diagnostics</span>
<a name="l00883"></a>00883 <span class="comment">!</span>
<a name="l00884"></a>00884 <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l00885"></a>00885  <span class="keyword">allocate</span>(denergy(NHOR,9))
<a name="l00886"></a>00886  denergy(:,:)=0.
<a name="l00887"></a>00887 <span class="keyword">endif</span>
<a name="l00888"></a>00888 <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l00889"></a>00889  <span class="keyword">allocate</span>(dentropy(NHOR,9))
<a name="l00890"></a>00890  dentropy(:,:)=0.
<a name="l00891"></a>00891 <span class="keyword">endif</span>
<a name="l00892"></a>00892 <span class="keyword">if</span>(ndheat &gt; 1 .and. mypid == NROOT) <span class="keyword">then</span>
<a name="l00893"></a>00893  <span class="keyword">open</span>(9,file=efficiency_dat,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l00894"></a>00894 <span class="keyword">endif</span>
<a name="l00895"></a>00895 <span class="comment">!</span>
<a name="l00896"></a>00896 <span class="comment">!     write first service record containing sigma coordinates</span>
<a name="l00897"></a>00897 <span class="comment">!</span>
<a name="l00898"></a>00898 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00899"></a>00899    <span class="keyword">if</span> (noutput &gt; 0) <span class="keyword">then</span>
<a name="l00900"></a>00900       istep = <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>
<a name="l00901"></a>00901       <span class="keyword">if</span> (istep &gt; 0) istep = istep + nafter <span class="comment">! next write after restart</span>
<a name="l00902"></a>00902       <span class="keyword">open</span>(40,file=puma_output,form=<span class="stringliteral">&#39;unformatted&#39;</span>)
<a name="l00903"></a>00903       call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(istep,imin,ihour,iday,imonth,iyear)
<a name="l00904"></a>00904       zsig(1:nlev) = sigmh(:)
<a name="l00905"></a>00905       zsig(nlev+1:) = 0.0
<a name="l00906"></a>00906       <span class="keyword">write</span>(40) 333,0,iyear*10000+imonth*100+iday,0,nlon,nlat,nlev,ntru
<a name="l00907"></a>00907       <span class="keyword">write</span>(40) zsig
<a name="l00908"></a>00908    <span class="keyword">endif</span> <span class="comment">! (noutput &gt; 0)</span>
<a name="l00909"></a>00909 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span>
<a name="l00910"></a>00910 return
<a name="l00911"></a>00911 <span class="keyword">end subroutine prolog</span>
<a name="l00912"></a>00912 
<a name="l00913"></a>00913 
<a name="l00914"></a>00914 <span class="comment">!===================!</span>
<a name="l00915"></a>00915 <span class="comment">! SUBROUTINE MASTER !</span>
<a name="l00916"></a>00916 <span class="comment">!================== !</span>
<a name="l00917"></a>00917 
<a name="l00918"></a><a class="code" href="puma_8f90.html#af02944c9cc5103c31e4ed9b779e7cc79">00918</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#af02944c9cc5103c31e4ed9b779e7cc79">master</a>
<a name="l00919"></a>00919 use <span class="keywordflow">pumamod</span>
<a name="l00920"></a>00920 
<a name="l00921"></a>00921 <span class="keyword">if</span> (nshutdown &gt; 0) return <span class="comment">! if something went wrong in prolog already</span>
<a name="l00922"></a>00922 
<a name="l00923"></a>00923 <span class="comment">! ***************************</span>
<a name="l00924"></a>00924 <span class="comment">! * short initial timesteps *</span>
<a name="l00925"></a>00925 <span class="comment">! ***************************</span>
<a name="l00926"></a>00926 
<a name="l00927"></a>00927 ikits = nkits
<a name="l00928"></a>00928 <span class="keyword">do</span> jkits = 1 , ikits
<a name="l00929"></a>00929    delt  = (TWOPI/ntspd) / (2**nkits)
<a name="l00930"></a>00930    delt2 = delt + delt
<a name="l00931"></a>00931    call <a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a>
<a name="l00932"></a>00932    call <a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">makebm</a>
<a name="l00933"></a>00933    call <a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">spectral</a>
<a name="l00934"></a>00934    nkits = nkits - 1
<a name="l00935"></a>00935 <span class="keyword">enddo</span>
<a name="l00936"></a>00936 
<a name="l00937"></a>00937 delt  = TWOPI/ntspd
<a name="l00938"></a>00938 delt2 = delt + delt
<a name="l00939"></a>00939 call <a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">makebm</a>
<a name="l00940"></a>00940 
<a name="l00941"></a>00941 nstep1 = <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> <span class="comment">! remember 1.st timestep</span>
<a name="l00942"></a>00942 
<a name="l00943"></a>00943 <span class="keyword">do</span> jstep = 1 , nrun
<a name="l00944"></a>00944    <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> = <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> + 1
<a name="l00945"></a>00945    call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(5),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(4),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(3),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(2),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(1))
<a name="l00946"></a>00946 
<a name="l00947"></a>00947 <span class="comment">!  ************************************************************</span>
<a name="l00948"></a>00948 <span class="comment">!  * calculation of non-linear quantities in grid point space *</span>
<a name="l00949"></a>00949 <span class="comment">!  ************************************************************</span>
<a name="l00950"></a>00950 
<a name="l00951"></a>00951    call <a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a>
<a name="l00952"></a>00952 
<a name="l00953"></a>00953    <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00954"></a>00954       <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nafter) == 0 .and. noutput &gt; 0) call <a class="code" href="puma_8f90.html#a0352cc6bbeedace31c54d9afba847ad6">outsp</a>
<a name="l00955"></a>00955       <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag ) == 0 .or. ngui &gt; 0) call <a class="code" href="puma_8f90.html#ad0981694b4fc7644f20d9ad785deba27">diag</a>
<a name="l00956"></a>00956       <span class="keyword">if</span> (ncu &gt; 0) call <a class="code" href="puma_8f90.html#ab608e12bdff55ab600a9d975673c5a53">checkunit</a>
<a name="l00957"></a>00957    <span class="keyword">endif</span>
<a name="l00958"></a>00958    <span class="keyword">if</span> (ngui &gt; 0) call <a class="code" href="guimod_8f90.html#a71eb8e326967dca8aad8bc84d9f8ad72">guistep_puma</a>
<a name="l00959"></a>00959 
<a name="l00960"></a>00960 <span class="comment">!  ******************************</span>
<a name="l00961"></a>00961 <span class="comment">!  * adiabatic part of timestep *</span>
<a name="l00962"></a>00962 <span class="comment">!  ******************************</span>
<a name="l00963"></a>00963 
<a name="l00964"></a>00964    call <a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">spectral</a>
<a name="l00965"></a>00965    <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nafter) == 0 .and. noutput &gt; 0) call <a class="code" href="puma_8f90.html#a1f5ebb3d7ab8cc007a6ed2d81b858f03">outgp</a>
<a name="l00966"></a>00966    <span class="keyword">if</span> (nshutdown &gt; 0) return
<a name="l00967"></a>00967 <span class="keyword">enddo</span>
<a name="l00968"></a>00968 return
<a name="l00969"></a>00969 <span class="keyword">end subroutine master</span>
<a name="l00970"></a>00970 
<a name="l00971"></a>00971 
<a name="l00972"></a>00972 <span class="comment">!     =================</span>
<a name="l00973"></a>00973 <span class="comment">!     SUBROUTINE EPILOG</span>
<a name="l00974"></a>00974 <span class="comment">!     =================</span>
<a name="l00975"></a>00975 
<a name="l00976"></a><a class="code" href="puma_8f90.html#a35d7c22447dc50ab86832b4615994d32">00976</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a35d7c22447dc50ab86832b4615994d32">epilog</a>
<a name="l00977"></a>00977       use <span class="keywordflow">pumamod</span>
<a name="l00978"></a>00978       <span class="keywordtype">real    (kind=8)</span> :: zut,zst
<a name="l00979"></a>00979       <span class="keywordtype">integer (kind=8)</span> :: imem,ipr,ipf,isw,idr,idw
<a name="l00980"></a>00980 
<a name="l00981"></a>00981       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">close</span>(40) <span class="comment">! close output file</span>
<a name="l00982"></a>00982 
<a name="l00983"></a>00983 <span class="comment">!     write restart file</span>
<a name="l00984"></a>00984 
<a name="l00985"></a>00985       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00986"></a>00986          call <a class="code" href="restartmod_8f90.html#affb1e8d0fa727d359e1292ada8ba0f2b">restart_prepare</a>(puma_status)
<a name="l00987"></a>00987          sp(1) = psmean <span class="comment">! save psmean</span>
<a name="l00988"></a>00988          call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">&#39;nstep&#39;</span>   ,<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>   )
<a name="l00989"></a>00989          call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">&#39;nlat&#39;</span>    ,NLAT    )
<a name="l00990"></a>00990          call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">&#39;nlon&#39;</span>    ,NLON    )
<a name="l00991"></a>00991          call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">&#39;nlev&#39;</span>    ,NLEV    )
<a name="l00992"></a>00992          call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">&#39;nrsp&#39;</span>    ,NRSP    )
<a name="l00993"></a>00993 
<a name="l00994"></a>00994 <span class="comment">!        Save current random number generator seed</span>
<a name="l00995"></a>00995 
<a name="l00996"></a>00996          call random_seed(get=meed)
<a name="l00997"></a>00997          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;seed&#39;</span>,meed,nseedlen,1,1)
<a name="l00998"></a>00998          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;ganext&#39;</span>,ganext,1,1,1)
<a name="l00999"></a>00999 
<a name="l01000"></a>01000          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;sz&#39;</span> ,sz ,NRSP,NESP,NLEV)
<a name="l01001"></a>01001          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;sd&#39;</span> ,sd ,NRSP,NESP,NLEV)
<a name="l01002"></a>01002          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;st&#39;</span> ,st ,NRSP,NESP,NLEV)
<a name="l01003"></a>01003          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;sr1&#39;</span>,sr1,NRSP,NESP,NLEV)
<a name="l01004"></a>01004          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;sr2&#39;</span>,sr2,NRSP,NESP,NLEV)
<a name="l01005"></a>01005          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;sp&#39;</span> ,sp ,NRSP,NESP,   1)
<a name="l01006"></a>01006          call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;so&#39;</span> ,so ,NRSP,NESP,   1)
<a name="l01007"></a>01007          <span class="keyword">if</span> (nruido &gt; 0) <span class="keyword">then</span>
<a name="l01008"></a>01008             call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">&#39;ruido&#39;</span>,ruido,nugp,nugp,nlev)
<a name="l01009"></a>01009          <span class="keyword">endif</span>
<a name="l01010"></a>01010       <span class="keyword">endif</span>
<a name="l01011"></a>01011 
<a name="l01012"></a>01012       call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">&#39;szm&#39;</span>,szm,NSPP,NLEV)
<a name="l01013"></a>01013       call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">&#39;sdm&#39;</span>,sdm,NSPP,NLEV)
<a name="l01014"></a>01014       call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">&#39;stm&#39;</span>,stm,NSPP,NLEV)
<a name="l01015"></a>01015       call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">&#39;spm&#39;</span>,spm,NSPP,   1)
<a name="l01016"></a>01016 
<a name="l01017"></a>01017 <span class="comment">!     write gridpoint arrays</span>
<a name="l01018"></a>01018 
<a name="l01019"></a>01019       <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr1)) <span class="keyword">then</span>
<a name="l01020"></a>01020          call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">&#39;gr1&#39;</span>,gr1,nhor,nlev)
<a name="l01021"></a>01021       <span class="keyword">endif</span>
<a name="l01022"></a>01022       <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr2)) <span class="keyword">then</span>
<a name="l01023"></a>01023          call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">&#39;gr2&#39;</span>,gr2,nhor,nlev)
<a name="l01024"></a>01024       <span class="keyword">endif</span>
<a name="l01025"></a>01025       <span class="keyword">if</span> (<span class="keyword">allocated</span>(gtdamp)) <span class="keyword">then</span>
<a name="l01026"></a>01026          call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">&#39;gtdamp&#39;</span>,gtdamp,nhor,nlev)
<a name="l01027"></a>01027       <span class="keyword">endif</span>
<a name="l01028"></a>01028 
<a name="l01029"></a>01029       <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr1c)) <span class="keyword">then</span>
<a name="l01030"></a>01030          call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">&#39;gr1c&#39;</span>,gr1c,nhor,nlev)
<a name="l01031"></a>01031       <span class="keyword">endif</span>
<a name="l01032"></a>01032       <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr2c)) <span class="keyword">then</span>
<a name="l01033"></a>01033          call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">&#39;gr2c&#39;</span>,gr2c,nhor,nlev)
<a name="l01034"></a>01034       <span class="keyword">endif</span>
<a name="l01035"></a>01035       <span class="keyword">if</span> (<span class="keyword">allocated</span>(gtdampc)) <span class="keyword">then</span>
<a name="l01036"></a>01036          call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">&#39;gtdampc&#39;</span>,gtdampc,nhor,nlev)
<a name="l01037"></a>01037       <span class="keyword">endif</span>
<a name="l01038"></a>01038 
<a name="l01039"></a>01039       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> 
<a name="l01040"></a>01040 <span class="comment">!        Get resource stats from function resources in file pumax.c</span>
<a name="l01041"></a>01041          ires = <a class="code" href="pumax_8c.html#a7e885dd959a1c4e56017782911c1f796">nresources</a>(zut,zst,imem,ipr,ipf,isw,idr,idw)
<a name="l01042"></a>01042          call cpu_time(tmstop)
<a name="l01043"></a>01043          tmrun = tmstop - tmstart
<a name="l01044"></a>01044          <span class="keyword">if</span> (<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> &gt; nstep1) <span class="keyword">then</span> 
<a name="l01045"></a>01045             zspy = tmrun * 360.0 * <span class="keywordtype">real(ntspd)</span> / (nstep - nstep1) <span class="comment">! sec / siy</span>
<a name="l01046"></a>01046             zypd = (24.0 * 3600.0 / zspy)                         <span class="comment">! siy / day</span>
<a name="l01047"></a>01047             <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(/,&quot;****************************************&quot;)&#39;</span>)
<a name="l01048"></a>01048             <span class="keyword">if</span> (zut &gt; 0.0) &amp;
<a name="l01049"></a>01049             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* User   time         : &quot;, f10.3,&quot; sec *&quot;)&#39;</span>) zut
<a name="l01050"></a>01050             <span class="keyword">if</span> (zst &gt; 0.0) &amp;
<a name="l01051"></a>01051             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* System time         : &quot;, f10.3,&quot; sec *&quot;)&#39;</span>) zst
<a name="l01052"></a>01052             <span class="keyword">if</span> (zut + zst &gt; 0.0) tmrun = zut + zst
<a name="l01053"></a>01053             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Total CPU time      : &quot;, f10.3,&quot; sec *&quot;)&#39;</span>) tmrun
<a name="l01054"></a>01054             <span class="keyword">if</span> (imem &gt; 0) &amp;
<a name="l01055"></a>01055             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Memory usage        : &quot;, f10.3,&quot; MB  *&quot;)&#39;</span>) imem * 0.000001
<a name="l01056"></a>01056             <span class="keyword">if</span> (ipr &gt; 0) &amp;
<a name="l01057"></a>01057             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Page reclaims       : &quot;, i6,&quot; pages   *&quot;)&#39;</span>) ipr
<a name="l01058"></a>01058             <span class="keyword">if</span> (ipf &gt; 0) &amp;
<a name="l01059"></a>01059             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Page faults         : &quot;, i6,&quot; pages   *&quot;)&#39;</span>) ipf
<a name="l01060"></a>01060             <span class="keyword">if</span> (isw &gt; 0) &amp;
<a name="l01061"></a>01061             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Page swaps          : &quot;, i6,&quot; pages   *&quot;)&#39;</span>) isw
<a name="l01062"></a>01062             <span class="keyword">if</span> (idr &gt; 0) &amp;
<a name="l01063"></a>01063             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Disk read           : &quot;, i6,&quot; blocks  *&quot;)&#39;</span>) idr
<a name="l01064"></a>01064             <span class="keyword">if</span> (idw &gt; 0) &amp;
<a name="l01065"></a>01065             <span class="keyword">write</span>(nud,  <span class="stringliteral">&#39;(&quot;* Disk write          : &quot;, i6,&quot; blocks  *&quot;)&#39;</span>) idw
<a name="l01066"></a>01066             <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;****************************************&quot;)&#39;</span>)
<a name="l01067"></a>01067             <span class="keyword">if</span> (zspy &lt; 600.0) <span class="keyword">then</span>
<a name="l01068"></a>01068                <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* Seconds per sim year: &quot;,i6,9x,&quot;*&quot;)&#39;</span>) nint(zspy)
<a name="l01069"></a>01069             <span class="keyword">else</span> <span class="keyword">if</span> (zspy &lt; 900000.0) <span class="keyword">then</span>
<a name="l01070"></a>01070                <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* Minutes per sim year  &quot;,i6,9x,&quot;*&quot;)&#39;</span>) nint(zspy/60.0)
<a name="l01071"></a>01071             <span class="keyword">else</span>
<a name="l01072"></a>01072                <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* Days per sim year:    &quot;,i6,5x,&quot;*&quot;)&#39;</span>) nint(zspy/86400.0)
<a name="l01073"></a>01073             <span class="keyword">endif</span>
<a name="l01074"></a>01074             <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* Sim years per day   :&quot;,i7,9x,&quot;*&quot;)&#39;</span>) nint(zypd)
<a name="l01075"></a>01075             <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;****************************************&quot;)&#39;</span>)
<a name="l01076"></a>01076          <span class="keyword">endif</span>
<a name="l01077"></a>01077       <span class="keyword">endif</span>
<a name="l01078"></a>01078 
<a name="l01079"></a>01079       return
<a name="l01080"></a>01080 <span class="keyword">      end subroutine epilog</span>
<a name="l01081"></a>01081 
<a name="l01082"></a>01082 <span class="comment">!     =============================</span>
<a name="l01083"></a>01083 <span class="comment">!     SUBROUTINE READ_ATMOS_RESTART</span>
<a name="l01084"></a>01084 <span class="comment">!     =============================</span>
<a name="l01085"></a>01085 
<a name="l01086"></a><a class="code" href="puma_8f90.html#aa07fedd638dbdd8e1799b83d34eb35e3">01086</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aa07fedd638dbdd8e1799b83d34eb35e3">read_atmos_restart</a>
<a name="l01087"></a>01087       use <span class="keywordflow">pumamod</span>
<a name="l01088"></a>01088 
<a name="l01089"></a>01089       <span class="keywordtype">integer</span> :: k = 0
<a name="l01090"></a>01090 
<a name="l01091"></a>01091 <span class="comment">!     read scalars and full spectral arrays</span>
<a name="l01092"></a>01092 
<a name="l01093"></a>01093       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01094"></a>01094          call <a class="code" href="restartmod_8f90.html#a31b0dacd7c45db47ddaedb4d402b44ba">get_restart_integer</a>(<span class="stringliteral">&#39;nstep&#39;</span>,<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>)
<a name="l01095"></a>01095          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;seed&#39;</span>,meed,nseedlen,1,1)
<a name="l01096"></a>01096          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;ganext&#39;</span>,ganext,1,1,1)
<a name="l01097"></a>01097          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;sz&#39;</span> ,sz ,NRSP,NESP,NLEV)
<a name="l01098"></a>01098          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;sd&#39;</span> ,sd ,NRSP,NESP,NLEV)
<a name="l01099"></a>01099          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;st&#39;</span> ,st ,NRSP,NESP,NLEV)
<a name="l01100"></a>01100          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;sr1&#39;</span>,sr1,NRSP,NESP,NLEV)
<a name="l01101"></a>01101          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;sr2&#39;</span>,sr2,NRSP,NESP,NLEV)
<a name="l01102"></a>01102          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;sp&#39;</span> ,sp ,NRSP,NESP,   1)
<a name="l01103"></a>01103          call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;so&#39;</span> ,so ,NRSP,NESP,   1)
<a name="l01104"></a>01104          <span class="keyword">if</span> (nruido &gt; 0) <span class="keyword">then</span>
<a name="l01105"></a>01105             call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">&#39;ruido&#39;</span>,ruido,nugp,nugp,nlev)
<a name="l01106"></a>01106          <span class="keyword">endif</span>
<a name="l01107"></a>01107          psmean = sp(1)
<a name="l01108"></a>01108          sp(1)  = 0.0
<a name="l01109"></a>01109          call random_seed(put=meed)
<a name="l01110"></a>01110       <span class="keyword">endif</span>
<a name="l01111"></a>01111 
<a name="l01112"></a>01112       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>)     <span class="comment">! broadcast current timestep</span>
<a name="l01113"></a>01113       call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(psmean)    <span class="comment">! broadcast mean surface pressure</span>
<a name="l01114"></a>01114 
<a name="l01115"></a>01115 <span class="comment">!     read and scatter spectral arrays</span>
<a name="l01116"></a>01116 
<a name="l01117"></a>01117       call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">&#39;szm&#39;</span>,szm,NSPP,NLEV)
<a name="l01118"></a>01118       call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">&#39;sdm&#39;</span>,sdm,NSPP,NLEV)
<a name="l01119"></a>01119       call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">&#39;stm&#39;</span>,stm,NSPP,NLEV)
<a name="l01120"></a>01120       call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">&#39;spm&#39;</span>,spm,NSPP,   1)
<a name="l01121"></a>01121 
<a name="l01122"></a>01122 <span class="comment">!     allocate, read and scatter gridpoint arrays</span>
<a name="l01123"></a>01123 
<a name="l01124"></a>01124       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">&#39;gr1&#39;</span>,ktmp)
<a name="l01125"></a>01125       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp)
<a name="l01126"></a>01126       <span class="keyword">if</span> (ktmp &gt; 0) <span class="keyword">then</span> 
<a name="l01127"></a>01127          <span class="keyword">allocate</span>(gr1(nhor,nlev))
<a name="l01128"></a>01128          call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">&#39;gr1&#39;</span>,gr1,nhor,nlev)
<a name="l01129"></a>01129       <span class="keyword">endif</span>
<a name="l01130"></a>01130       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">&#39;gr2&#39;</span>,ktmp)
<a name="l01131"></a>01131       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp)
<a name="l01132"></a>01132       <span class="keyword">if</span> (ktmp &gt; 0) <span class="keyword">then</span> 
<a name="l01133"></a>01133          <span class="keyword">allocate</span>(gr2(nhor,nlev))
<a name="l01134"></a>01134          call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">&#39;gr2&#39;</span>,gr2,nhor,nlev)
<a name="l01135"></a>01135       <span class="keyword">endif</span>
<a name="l01136"></a>01136       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">&#39;gtdamp&#39;</span>,ktmp)
<a name="l01137"></a>01137       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp)
<a name="l01138"></a>01138       <span class="keyword">if</span> (ktmp &gt; 0) <span class="keyword">then</span> 
<a name="l01139"></a>01139          <span class="keyword">allocate</span>(gtdamp(nhor,nlev))
<a name="l01140"></a>01140          call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">&#39;gtdamp&#39;</span>,gtdamp,nhor,nlev)
<a name="l01141"></a>01141       <span class="keyword">endif</span>
<a name="l01142"></a>01142       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">&#39;gr1c&#39;</span>,ktmp)
<a name="l01143"></a>01143       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp)
<a name="l01144"></a>01144       <span class="keyword">if</span> (ktmp &gt; 0) <span class="keyword">then</span> 
<a name="l01145"></a>01145          <span class="keyword">allocate</span>(gr1c(nhor,nlev))
<a name="l01146"></a>01146          call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">&#39;gr1c&#39;</span>,gr1c,nhor,nlev)
<a name="l01147"></a>01147       <span class="keyword">endif</span>
<a name="l01148"></a>01148       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">&#39;gr2c&#39;</span>,ktmp)
<a name="l01149"></a>01149       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp)
<a name="l01150"></a>01150       <span class="keyword">if</span> (ktmp &gt; 0) <span class="keyword">then</span> 
<a name="l01151"></a>01151          <span class="keyword">allocate</span>(gr2c(nhor,nlev))
<a name="l01152"></a>01152          call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">&#39;gr2c&#39;</span>,gr2c,nhor,nlev)
<a name="l01153"></a>01153       <span class="keyword">endif</span>
<a name="l01154"></a>01154       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">&#39;gtdampc&#39;</span>,ktmp)
<a name="l01155"></a>01155       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp)
<a name="l01156"></a>01156       <span class="keyword">if</span> (ktmp &gt; 0) <span class="keyword">then</span> 
<a name="l01157"></a>01157          <span class="keyword">allocate</span>(gtdampc(nhor,nlev))
<a name="l01158"></a>01158          call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">&#39;gtdampc&#39;</span>,gtdampc,nhor,nlev)
<a name="l01159"></a>01159       <span class="keyword">endif</span>
<a name="l01160"></a>01160 
<a name="l01161"></a>01161       return
<a name="l01162"></a>01162 <span class="keyword">      end subroutine read_atmos_restart</span>
<a name="l01163"></a>01163 
<a name="l01164"></a>01164 <span class="comment">!     =================</span>
<a name="l01165"></a>01165 <span class="comment">!     SUBROUTINE INITFD</span>
<a name="l01166"></a>01166 <span class="comment">!     =================</span>
<a name="l01167"></a>01167 
<a name="l01168"></a><a class="code" href="puma_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">01168</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">initfd</a>
<a name="l01169"></a>01169       use <span class="keywordflow">pumamod</span>
<a name="l01170"></a>01170 
<a name="l01171"></a>01171       <span class="keyword">if</span> (nkits &lt; 1) nkits = 1
<a name="l01172"></a>01172 
<a name="l01173"></a>01173 <span class="comment">!     Look for start data and read them if there</span>
<a name="l01174"></a>01174 
<a name="l01175"></a>01175       call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(129,so,    1,iread1)
<a name="l01176"></a>01176       call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(134,sp,    1,iread2)
<a name="l01177"></a>01177       call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(121,sr1,NLEV,iread3)
<a name="l01178"></a>01178       call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(122,sr2,NLEV,iread4)
<a name="l01179"></a>01179       call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(123,NLEV,iread123)
<a name="l01180"></a>01180       <span class="keyword">if</span> (mypid == NROOT .and. iread123 == 0) <span class="keyword">then</span>
<a name="l01181"></a>01181          <span class="keyword">if</span> (nhelsua &gt; 1) <span class="keyword">then</span>
<a name="l01182"></a>01182             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR no *_surf_0123.sra file for Held&amp;Suarez&quot;</span>
<a name="l01183"></a>01183             stop
<a name="l01184"></a>01184          <span class="keyword">endif</span>
<a name="l01185"></a>01185       <span class="keyword">endif</span>
<a name="l01186"></a>01186    
<a name="l01187"></a>01187       <span class="keyword">if</span> (ndiagp &gt; 0) <span class="keyword">then</span>  
<a name="l01188"></a>01188          call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(121,NLEV,iread121)
<a name="l01189"></a>01189          call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(122,NLEV,iread122)
<a name="l01190"></a>01190          <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(gtdamp)) <span class="keyword">then</span>
<a name="l01191"></a>01191             call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(123,NLEV,iread123)
<a name="l01192"></a>01192          <span class="keyword">endif</span>
<a name="l01193"></a>01193          <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01194"></a>01194             <span class="keyword">if</span> (iread121==0 .or. iread122==0 .or. iread123==0) <span class="keyword">then</span>
<a name="l01195"></a>01195                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR not all fields (121,122,123) for grid point heating found&quot;</span>
<a name="l01196"></a>01196                stop
<a name="l01197"></a>01197             <span class="keyword">endif</span>
<a name="l01198"></a>01198          <span class="keyword">endif</span>
<a name="l01199"></a>01199       <span class="keyword">endif</span>
<a name="l01200"></a>01200 
<a name="l01201"></a>01201       <span class="keyword">if</span> (nconv &gt; 0) <span class="keyword">then</span>
<a name="l01202"></a>01202          call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(124,NLEV,iread124)
<a name="l01203"></a>01203          call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(125,NLEV,iread125)
<a name="l01204"></a>01204          call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(126,NLEV,iread126)
<a name="l01205"></a>01205          <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01206"></a>01206             <span class="keyword">if</span> (iread124==0 .or. iread125==0 .or. iread126==0) <span class="keyword">then</span>
<a name="l01207"></a>01207                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR not all fields (124,125,126) for convective heating found&quot;</span>
<a name="l01208"></a>01208                stop
<a name="l01209"></a>01209             <span class="keyword">endif</span>
<a name="l01210"></a>01210          <span class="keyword">endif</span>
<a name="l01211"></a>01211       <span class="keyword">endif</span>
<a name="l01212"></a>01212 
<a name="l01213"></a>01213       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01214"></a>01214          <span class="keyword">if</span> (iread1==0 .or. iread2==0 .or. iread3==0 .or. iread4==0) <span class="keyword">then</span>
<a name="l01215"></a>01215             call <a class="code" href="puma_8f90.html#a4a662c6d6619fc6405eb110f62653dc0">setzt</a> <span class="comment">! setup for aqua-planet</span>
<a name="l01216"></a>01216          <span class="keyword">else</span>
<a name="l01217"></a>01217             psmean = psurf * exp(spnorm(1) * sp(1)) 
<a name="l01218"></a>01218             sp(1)  = 0.0
<a name="l01219"></a>01219             so(:) = so(:) / (cv * cv) <span class="comment">! descale from [m2/s2]</span>
<a name="l01220"></a>01220             sr1(:,:) = sr1(:,:) / ct  <span class="comment">! descale from [K]</span>
<a name="l01221"></a>01221             sr2(:,:) = sr2(:,:) / ct  <span class="comment">! descale from [K]</span>
<a name="l01222"></a>01222             sr1(1,:) = sr1(1,:) - t0(:) * sqrt(2.0) <span class="comment">! subtract profile</span>
<a name="l01223"></a>01223             <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(a,f8.2,a)&#39;</span>) <span class="stringliteral">&#39; Mean of Ps = &#39;</span>,0.01*psmean, <span class="stringliteral">&#39;[hPa]&#39;</span>
<a name="l01224"></a>01224          <span class="keyword">endif</span>
<a name="l01225"></a>01225       <span class="keyword">endif</span>
<a name="l01226"></a>01226 
<a name="l01227"></a>01227 <span class="comment">!     Add initial noise if wanted</span>
<a name="l01228"></a>01228 
<a name="l01229"></a>01229       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01230"></a>01230          call <a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">printprofile</a>
<a name="l01231"></a>01231          <span class="keyword">if</span> (kick &gt; 10) <span class="keyword">then</span>
<a name="l01232"></a>01232             call <a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kick-10)
<a name="l01233"></a>01233          <span class="keyword">else</span>
<a name="l01234"></a>01234             call <a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kick)
<a name="l01235"></a>01235          <span class="keyword">endif</span>
<a name="l01236"></a>01236       <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span>
<a name="l01237"></a>01237 
<a name="l01238"></a>01238       call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sp,spm,1)
<a name="l01239"></a>01239       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01240"></a>01240           st(1,:) = sr1(1,:)
<a name="l01241"></a>01241          stm(1,:) = sr1(1,:)
<a name="l01242"></a>01242           sz(3,:) = plavor
<a name="l01243"></a>01243          szm(3,:) = plavor
<a name="l01244"></a>01244       <span class="keyword">endif</span>
<a name="l01245"></a>01245       return
<a name="l01246"></a>01246 <span class="keyword">      end</span>
<a name="l01247"></a>01247 
<a name="l01248"></a>01248 
<a name="l01249"></a>01249 <span class="comment">!     ==========================</span>
<a name="l01250"></a>01250 <span class="comment">!     SUBROUTINE READ_RESOLUTION</span>
<a name="l01251"></a>01251 <span class="comment">!     ==========================</span>
<a name="l01252"></a>01252 
<a name="l01253"></a><a class="code" href="puma_8f90.html#a811c67568d6f12806d6b6f86813d2bc4">01253</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a811c67568d6f12806d6b6f86813d2bc4">read_resolution</a>
<a name="l01254"></a>01254       use <span class="keywordflow">pumamod</span>
<a name="l01255"></a>01255 
<a name="l01256"></a>01256       <span class="keywordtype">character (80)</span> :: ylat
<a name="l01257"></a>01257       <span class="keywordtype">character (80)</span> :: ylev
<a name="l01258"></a>01258 
<a name="l01259"></a>01259       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01260"></a>01260          call get_command_argument(1,ylat)
<a name="l01261"></a>01261          call get_command_argument(2,ylev)
<a name="l01262"></a>01262          <span class="keyword">read</span>(ylat,*) nlat
<a name="l01263"></a>01263          <span class="keyword">read</span>(ylev,*) nlev
<a name="l01264"></a>01264       <span class="keyword">endif</span>
<a name="l01265"></a>01265 
<a name="l01266"></a>01266       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nlat)
<a name="l01267"></a>01267       call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nlev)
<a name="l01268"></a>01268       return
<a name="l01269"></a>01269 <span class="keyword">      end</span>
<a name="l01270"></a>01270 
<a name="l01271"></a>01271 
<a name="l01272"></a>01272 <span class="comment">!     =====================</span>
<a name="l01273"></a>01273 <span class="comment">!     SUBROUTINE RESOLUTION</span>
<a name="l01274"></a>01274 <span class="comment">!     =====================</span>
<a name="l01275"></a>01275 
<a name="l01276"></a><a class="code" href="puma_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">01276</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">resolution</a>
<a name="l01277"></a>01277       use <span class="keywordflow">pumamod</span>
<a name="l01278"></a>01278 
<a name="l01279"></a>01279       nlem = nlev - 1
<a name="l01280"></a>01280       nlep = nlev + 1
<a name="l01281"></a>01281       nlsq = nlev * nlev
<a name="l01282"></a>01282 
<a name="l01283"></a>01283       nlon = nlat + nlat <span class="comment">! Longitudes</span>
<a name="l01284"></a>01284       nlah = nlat / 2
<a name="l01285"></a>01285       nlpp = nlat / npro
<a name="l01286"></a>01286       nhpp = nlah / npro
<a name="l01287"></a>01287       nhor = nlon * nlpp
<a name="l01288"></a>01288       nugp = nlon * nlat
<a name="l01289"></a>01289       npgp = nugp / 2
<a name="l01290"></a>01290 
<a name="l01291"></a>01291       ntru = (nlon - 1) / 3
<a name="l01292"></a>01292       ntp1 = ntru + 1
<a name="l01293"></a>01293       nzom = ntp1 + ntp1
<a name="l01294"></a>01294       nrsp = (ntru + 1) * (ntru + 2)
<a name="l01295"></a>01295       ncsp = nrsp / 2
<a name="l01296"></a>01296       nspp = (nrsp + npro - 1) / npro
<a name="l01297"></a>01297       nesp = nspp * npro
<a name="l01298"></a>01298 
<a name="l01299"></a>01299       return
<a name="l01300"></a>01300 <span class="keyword">      end</span>
<a name="l01301"></a>01301 
<a name="l01302"></a>01302 
<a name="l01303"></a>01303 <span class="comment">!     =================</span>
<a name="l01304"></a>01304 <span class="comment">!     SUBROUTINE READNL</span>
<a name="l01305"></a>01305 <span class="comment">!     =================</span>
<a name="l01306"></a>01306 
<a name="l01307"></a><a class="code" href="puma_8f90.html#a8a75958ca9ba25aeec49db140b483871">01307</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">readnl</a>
<a name="l01308"></a>01308       use <span class="keywordflow">pumamod</span>
<a name="l01309"></a>01309 
<a name="l01310"></a>01310 <span class="comment">!     This workaround is necessaray, because allocatable arrays are</span>
<a name="l01311"></a>01311 <span class="comment">!     not allowed in namelists for FORTRAN versions &lt; F2003</span>
<a name="l01312"></a>01312 
<a name="l01313"></a>01313       <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXLEV   = 100
<a name="l01314"></a>01314       <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXSELZW =  42
<a name="l01315"></a>01315       <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXSELSP = ((MAXSELZW+1) * (MAXSELZW+2)) / 2
<a name="l01316"></a>01316       <span class="keywordtype">integer</span> :: nselect(0:MAXSELZW) = 1      <span class="comment">! NSELECT can be used up tp T42</span>
<a name="l01317"></a>01317       <span class="keywordtype">integer</span> :: nspecsel(MAXSELSP)  = 1      <span class="comment">! Default setting: all modes active</span>
<a name="l01318"></a>01318       <span class="keywordtype">integer</span> :: ndl(MAXLEV)         = 0      <span class="comment">! Diagnostics off</span>
<a name="l01319"></a>01319       <span class="keywordtype">real</span>    :: restim(MAXLEV)      = 0.0    <span class="comment">! Tau R</span>
<a name="l01320"></a>01320       <span class="keywordtype">real</span>    :: sigmah(MAXLEV)      = 0.0    <span class="comment">! Half level sigma</span>
<a name="l01321"></a>01321       <span class="keywordtype">real</span>    :: t0k(MAXLEV)         = 250.0  <span class="comment">! Reference temperature</span>
<a name="l01322"></a>01322       <span class="keywordtype">real</span>    :: tfrc(MAXLEV)        = 0.0    <span class="comment">! Tau F</span>
<a name="l01323"></a>01323 
<a name="l01324"></a>01324       namelist /inp/ &amp;
<a name="l01325"></a>01325         akap    , alpha   , alr     , alrs    , disp    , dtep    &amp;
<a name="l01326"></a>01326       , dtns    , dtrop   , dttrp   , dtzz    , dvdiff  &amp;
<a name="l01327"></a>01327       , ga      , gascon  &amp;
<a name="l01328"></a>01328       , kick    , mpstep  , nafter  , ncoeff  , nconv   , ncu     &amp;
<a name="l01329"></a>01329       , ndel    , ndheat  , ndiag   , ndiagp  , ndl     , nenergy &amp;
<a name="l01330"></a>01330       , nentropy, nextout , ngui    , nguidbg , nhelsua , nkits   &amp;
<a name="l01331"></a>01331       , nlevt   , nmonths , noutput , nradcv  , nruido  , nrun    &amp;
<a name="l01332"></a>01332       , nselect , nspecsel, nsponge , <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>   , nstop   , nsync   &amp;
<a name="l01333"></a>01333       , ntspd   , nvg     , nwpd    , nwspini , nyears  &amp;
<a name="l01334"></a>01334       , orofac  , pac     , plarad  , pspon   , psurf   , restim  &amp;
<a name="l01335"></a>01335       , rotspd  , seed    , sid_day , sigmah  , sigmax  , sponk   &amp;
<a name="l01336"></a>01336       , syncstr , synctime, t0k     &amp;
<a name="l01337"></a>01337       , tac     , tauta   , tauts   , tdiss   , tfrc    , tgr
<a name="l01338"></a>01338 
<a name="l01339"></a>01339       <span class="keyword">open</span>(13,file=puma_namelist,iostat=ios)
<a name="l01340"></a>01340       <span class="keyword">if</span> (ios == 0) <span class="keyword">then</span>
<a name="l01341"></a>01341          <span class="keyword">read</span> (13,inp)
<a name="l01342"></a>01342          <span class="keyword">close</span>(13)
<a name="l01343"></a>01343       <span class="keyword">endif</span>
<a name="l01344"></a>01344 
<a name="l01345"></a>01345 <span class="comment">!--- modify basic scales according to namelist </span>
<a name="l01346"></a>01346       ww    = TWOPI/sid_day   <span class="comment">! reciprocal of time scale 1/Omega</span>
<a name="l01347"></a>01347       cv    = plarad*ww       <span class="comment">! velocity scale (velocity at the equator)</span>
<a name="l01348"></a>01348       ct    = cv*cv/gascon    <span class="comment">! temperature scale from hydrostatic equation </span>
<a name="l01349"></a>01349       <span class="keyword">if</span> (ntspd  == 0) ntspd  = (24 * nlat) / 32 <span class="comment">! automatic</span>
<a name="l01350"></a>01350       <span class="keyword">if</span> (mpstep &gt; 0) ntspd = 1440 / mpstep
<a name="l01351"></a>01351       mpstep = 1440 / ntspd
<a name="l01352"></a>01352       nafter = ntspd                             <span class="comment">! daily output</span>
<a name="l01353"></a>01353       <span class="keyword">if</span> (nwpd &gt; 0 .and. nwpd &lt;= ntspd) <span class="keyword">then</span>
<a name="l01354"></a>01354          nafter = ntspd / nwpd
<a name="l01355"></a>01355       <span class="keyword">endif</span>
<a name="l01356"></a>01356       <span class="keyword">if</span> (ndiag  &lt; 1) ndiag  = ntspd * 10       <span class="comment">! every 10th. day</span>
<a name="l01357"></a>01357 
<a name="l01358"></a>01358       <span class="keyword">if</span> (synctime &gt; 0.0) syncstr = 1.0 / (TWOPI * synctime)
<a name="l01359"></a>01359 
<a name="l01360"></a>01360       <span class="keyword">write</span>(nud,inp)
<a name="l01361"></a>01361 
<a name="l01362"></a>01362       itru = ntru
<a name="l01363"></a>01363       <span class="keyword">if</span> (itru &gt; MAXSELZW) itru = MAXSELZW
<a name="l01364"></a>01364       icsp = ncsp
<a name="l01365"></a>01365       <span class="keyword">if</span> (icsp &gt; MAXSELSP) icsp = MAXSELSP
<a name="l01366"></a>01366       ilev = nlev
<a name="l01367"></a>01367       <span class="keyword">if</span> (ilev &gt; MAXLEV)   ilev = MAXLEV
<a name="l01368"></a>01368 
<a name="l01369"></a>01369       nselzw(0:itru) = nselect(0:itru)  <span class="comment">! Copy values to allocated array</span>
<a name="l01370"></a>01370       nselsp(1:icsp) = nspecsel(1:icsp) 
<a name="l01371"></a>01371       ndil(1:ilev)   = ndl(1:ilev)
<a name="l01372"></a>01372       taur(1:ilev)   = restim(1:ilev)
<a name="l01373"></a>01373       tauf(1:ilev)   = tfrc(1:ilev)
<a name="l01374"></a>01374       sigmh(1:ilev)  = sigmah(1:ilev)
<a name="l01375"></a>01375       t0(1:ilev)     = t0k(1:ilev)
<a name="l01376"></a>01376 
<a name="l01377"></a>01377       return
<a name="l01378"></a>01378 <span class="keyword">      end</span>
<a name="l01379"></a>01379 
<a name="l01380"></a>01380 
<a name="l01381"></a>01381 <span class="comment">!     ======================</span>
<a name="l01382"></a>01382 <span class="comment">!     SUBROUTINE PPP_DEF_INT</span>
<a name="l01383"></a>01383 <span class="comment">!     ======================</span>
<a name="l01384"></a>01384 
<a name="l01385"></a><a class="code" href="puma_8f90.html#ad3f0e22c057591beabda5d99c3f40c4c">01385</a>       <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(pname,nvar,ndim)
<a name="l01386"></a>01386       use <span class="keywordflow">prepmod</span>
<a name="l01387"></a>01387 
<a name="l01388"></a>01388       <span class="keywordtype">character (*)</span>  :: pname
<a name="l01389"></a>01389       <span class="keywordtype">integer</span>,<span class="keywordtype">target</span> :: nvar
<a name="l01390"></a>01390 
<a name="l01391"></a>01391       num_ppp = num_ppp + 1
<a name="l01392"></a>01392       ppp_tab(num_ppp)%name  =  <span class="stringliteral">&#39;[&#39;</span> // trim(pname) // <span class="stringliteral">&#39;]&#39;</span>
<a name="l01393"></a>01393       ppp_tab(num_ppp)%isint =  .true.
<a name="l01394"></a>01394       ppp_tab(num_ppp)%n     =  ndim
<a name="l01395"></a>01395       ppp_tab(num_ppp)%pint  =&gt; nvar
<a name="l01396"></a>01396       ppp_tab(num_ppp)%preal =&gt; null()
<a name="l01397"></a>01397       return
<a name="l01398"></a>01398 <span class="keyword">      end subroutine ppp_def_int</span>
<a name="l01399"></a>01399 
<a name="l01400"></a>01400 
<a name="l01401"></a>01401 <span class="comment">!     =======================</span>
<a name="l01402"></a>01402 <span class="comment">!     SUBROUTINE PPP_DEF_REAL</span>
<a name="l01403"></a>01403 <span class="comment">!     =======================</span>
<a name="l01404"></a>01404 
<a name="l01405"></a><a class="code" href="puma_8f90.html#a3e4cf6a68be16437f50762bf77e52370">01405</a>       <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__real.html">ppp_def_real</a>(pname,rvar,ndim)
<a name="l01406"></a>01406       use <span class="keywordflow">prepmod</span>
<a name="l01407"></a>01407       <span class="keywordtype">character (*)</span>  :: pname
<a name="l01408"></a>01408       <span class="keywordtype">real</span>   ,<span class="keywordtype">target</span> :: rvar
<a name="l01409"></a>01409 
<a name="l01410"></a>01410       num_ppp = num_ppp + 1
<a name="l01411"></a>01411       ppp_tab(num_ppp)%name  =  <span class="stringliteral">&#39;[&#39;</span> // trim(pname) // <span class="stringliteral">&#39;]&#39;</span>
<a name="l01412"></a>01412       ppp_tab(num_ppp)%isint =  .false.
<a name="l01413"></a>01413       ppp_tab(num_ppp)%n     =  ndim
<a name="l01414"></a>01414       ppp_tab(num_ppp)%pint  =&gt; null()
<a name="l01415"></a>01415       ppp_tab(num_ppp)%preal =&gt; rvar
<a name="l01416"></a>01416       return
<a name="l01417"></a>01417 <span class="keyword">      end subroutine ppp_def_real</span>
<a name="l01418"></a>01418 
<a name="l01419"></a>01419 
<a name="l01420"></a><a class="code" href="puma_8f90.html#a4c83f2cca37be70c03946309fc4e2a52">01420</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a4c83f2cca37be70c03946309fc4e2a52">ppp_read_i</a>(a,ndim,nread)
<a name="l01421"></a>01421       <span class="keywordtype">integer</span> :: a(ndim)
<a name="l01422"></a>01422       <span class="keywordtype">integer</span> :: n
<a name="l01423"></a>01423       
<a name="l01424"></a>01424       nread = 0
<a name="l01425"></a>01425       <span class="keyword">read</span> (15,*) n
<a name="l01426"></a>01426       <span class="keyword">if</span> (n &lt; 1 .or. n &gt; ndim) return
<a name="l01427"></a>01427       <span class="keyword">read</span> (15,*) a(1:n)
<a name="l01428"></a>01428       nread = n
<a name="l01429"></a>01429       return
<a name="l01430"></a>01430 <span class="keyword">      end</span>
<a name="l01431"></a>01431 
<a name="l01432"></a>01432       
<a name="l01433"></a><a class="code" href="puma_8f90.html#a1e7bdf5ee1faa40d34b6cc93ebc3acc3">01433</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a1e7bdf5ee1faa40d34b6cc93ebc3acc3">ppp_read_r</a>(a,ndim,nread)
<a name="l01434"></a>01434       <span class="keywordtype">real</span>    :: a(ndim)
<a name="l01435"></a>01435       <span class="keywordtype">integer</span> :: n
<a name="l01436"></a>01436 
<a name="l01437"></a>01437       nread = 0
<a name="l01438"></a>01438       <span class="keyword">read</span> (15,*) n
<a name="l01439"></a>01439       <span class="keyword">if</span> (n &lt; 1 .or. n &gt; ndim) return
<a name="l01440"></a>01440       <span class="keyword">read</span> (15,*) a(1:n)
<a name="l01441"></a>01441       nread = n
<a name="l01442"></a>01442       return
<a name="l01443"></a>01443 <span class="keyword">      end</span>
<a name="l01444"></a>01444 
<a name="l01445"></a>01445       
<a name="l01446"></a>01446 <span class="comment">!     ========================</span>
<a name="l01447"></a>01447 <span class="comment">!     SUBROUTINE PPP_INTERFACE</span>
<a name="l01448"></a>01448 <span class="comment">!     ========================</span>
<a name="l01449"></a>01449 
<a name="l01450"></a><a class="code" href="puma_8f90.html#a859f80933ca252bcc87f27d3996fea05">01450</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a859f80933ca252bcc87f27d3996fea05">ppp_interface</a>
<a name="l01451"></a>01451       use <span class="keywordflow">pumamod</span>
<a name="l01452"></a>01452       use <span class="keywordflow">prepmod</span>
<a name="l01453"></a>01453       <span class="keywordtype">logical</span> :: lexist
<a name="l01454"></a>01454       <span class="keywordtype">integer</span> :: iostat
<a name="l01455"></a>01455       <span class="keywordtype">integer</span> :: n
<a name="l01456"></a>01456       <span class="keywordtype">integer</span> :: ivar
<a name="l01457"></a>01457       <span class="keywordtype">character (80)</span> :: yname
<a name="l01458"></a>01458 
<a name="l01459"></a>01459       <span class="keyword">inquire</span>(file=ppp_puma_txt,exist=lexist)
<a name="l01460"></a>01460       <span class="keyword">if</span> (.not. lexist) return
<a name="l01461"></a>01461 
<a name="l01462"></a>01462       call <a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(<span class="stringliteral">&#39;NLAT&#39;</span>,nlat_ppp,1)
<a name="l01463"></a>01463       call <a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(<span class="stringliteral">&#39;NLEV&#39;</span>,nlev_ppp,1)
<a name="l01464"></a>01464 
<a name="l01465"></a>01465       call <a class="code" href="interfaceprepmod_1_1ppp__def__real.html">ppp_def_real</a>(<span class="stringliteral">&#39;SIGMH&#39;</span>,sigmh,nlev)
<a name="l01466"></a>01466 
<a name="l01467"></a>01467       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*******************************&quot;</span>
<a name="l01468"></a>01468       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;* Reading file &lt;&quot;</span>,trim(ppp_puma_txt),<span class="stringliteral">&quot;&gt; *&quot;</span>
<a name="l01469"></a>01469       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*******************************&quot;</span>
<a name="l01470"></a>01470       <span class="keyword">open</span> (15,file=ppp_puma_txt)
<a name="l01471"></a>01471       <span class="keyword">read</span> (15,<span class="stringliteral">&#39;(A)&#39;</span>,iostat=iostat) yname
<a name="l01472"></a>01472       <span class="keyword">do</span> <span class="keyword">while</span> (trim(yname) /= <span class="stringliteral">&#39;[END]&#39;</span> .and. iostat == 0)
<a name="l01473"></a>01473          <span class="keyword">do</span> j = 1 , num_ppp
<a name="l01474"></a>01474             <span class="keyword">if</span> (trim(yname) == ppp_tab(j)%name) <span class="keyword">then</span>
<a name="l01475"></a>01475                <span class="keyword">if</span> (ppp_tab(j)%isint) <span class="keyword">then</span>
<a name="l01476"></a>01476                   call <a class="code" href="puma_8f90.html#a4c83f2cca37be70c03946309fc4e2a52">ppp_read_i</a>(ppp_tab(j)%pint,ppp_tab(j)%n,iread)
<a name="l01477"></a>01477                   <span class="keyword">if</span> (iread == 0) <span class="keyword">then</span>
<a name="l01478"></a>01478                      <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR reading &quot;</span>,trim(yname),<span class="stringliteral">&quot; from &quot;</span>,trim(ppp_puma_txt)
<a name="l01479"></a>01479                      stop
<a name="l01480"></a>01480                   <span class="keyword">else</span> <span class="keyword">if</span> (iread == 1) <span class="keyword">then</span>
<a name="l01481"></a>01481                      <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* &quot;,A,&quot; = &quot;,I10,&quot; *&quot;)&#39;</span>) yname(1:15),ppp_tab(j)%pint
<a name="l01482"></a>01482                   <span class="keyword">else</span>
<a name="l01483"></a>01483                      <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* &quot;,A,&quot; :&quot;,I5,&quot; items *&quot;)&#39;</span>) yname(1:15),iread
<a name="l01484"></a>01484                   <span class="keyword">endif</span>
<a name="l01485"></a>01485                <span class="keyword">else</span>
<a name="l01486"></a>01486                   call <a class="code" href="puma_8f90.html#a1e7bdf5ee1faa40d34b6cc93ebc3acc3">ppp_read_r</a>(ppp_tab(j)%preal,ppp_tab(j)%n,iread)
<a name="l01487"></a>01487                   <span class="keyword">if</span> (iread == 0) <span class="keyword">then</span>
<a name="l01488"></a>01488                      <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR reading &quot;</span>,trim(yname),<span class="stringliteral">&quot; from &quot;</span>,trim(ppp_puma_txt)
<a name="l01489"></a>01489                      stop
<a name="l01490"></a>01490                   <span class="keyword">else</span> <span class="keyword">if</span> (iread == 1) <span class="keyword">then</span>
<a name="l01491"></a>01491                      <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* &quot;,A,&quot; = &quot;,G10.4,&quot; *&quot;)&#39;</span>) yname(1:15),ppp_tab(j)%preal
<a name="l01492"></a>01492                   <span class="keyword">else</span>
<a name="l01493"></a>01493                      <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(&quot;* &quot;,A,&quot; :&quot;,I5,&quot; items *&quot;)&#39;</span>) yname(1:15),iread
<a name="l01494"></a>01494                   <span class="keyword">endif</span>
<a name="l01495"></a>01495                <span class="keyword">endif</span>
<a name="l01496"></a>01496                exit
<a name="l01497"></a>01497             <span class="keyword">endif</span>
<a name="l01498"></a>01498          <span class="keyword">enddo</span>
<a name="l01499"></a>01499          <span class="keyword">read</span> (15,<span class="stringliteral">&#39;(A)&#39;</span>,iostat=iostat) yname
<a name="l01500"></a>01500       <span class="keyword">enddo</span>
<a name="l01501"></a>01501       <span class="keyword">if</span> (nlat_ppp /= 0 .and. nlat_ppp /= nlat) <span class="keyword">then</span>
<a name="l01502"></a>01502          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR *** ERROR *** ERROR *** ERROR ***&quot;</span>
<a name="l01503"></a>01503          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;# of latitudes mismatch in preprocessor PPP and PUMA&quot;</span>
<a name="l01504"></a>01504          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;NLAT in PPP  : &quot;</span>,nlat_ppp,<span class="stringliteral">&quot; &lt;&quot;</span>,trim(ppp_puma_txt),<span class="stringliteral">&quot;&gt;&quot;</span>
<a name="l01505"></a>01505          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;NLAT in PUMA : &quot;</span>,nlat
<a name="l01506"></a>01506          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;Aborting ...&quot;</span>
<a name="l01507"></a>01507          stop
<a name="l01508"></a>01508       <span class="keyword">endif</span>
<a name="l01509"></a>01509       <span class="keyword">if</span> (nlev_ppp /= 0 .and. nlev_ppp /= nlev) <span class="keyword">then</span>
<a name="l01510"></a>01510          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*** ERROR *** ERROR *** ERROR *** ERROR ***&quot;</span>
<a name="l01511"></a>01511          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;# of levels mismatch in preprocessor PPP and PUMA&quot;</span>
<a name="l01512"></a>01512          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;NLEV in PPP  : &quot;</span>,nlev_ppp,<span class="stringliteral">&quot; &lt;&quot;</span>,trim(ppp_puma_txt),<span class="stringliteral">&quot;&gt;&quot;</span>
<a name="l01513"></a>01513          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;NLEV in PUMA : &quot;</span>,nlev
<a name="l01514"></a>01514          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;Aborting ...&quot;</span>
<a name="l01515"></a>01515          stop
<a name="l01516"></a>01516       <span class="keyword">endif</span>
<a name="l01517"></a>01517       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;*******************************&quot;</span>
<a name="l01518"></a>01518 
<a name="l01519"></a>01519       return
<a name="l01520"></a>01520 <span class="keyword">      end subroutine ppp_interface</span>
<a name="l01521"></a>01521 
<a name="l01522"></a>01522 
<a name="l01523"></a>01523 <span class="comment">!     =============================</span>
<a name="l01524"></a>01524 <span class="comment">!     SUBROUTINE SELECT_ZONAL_WAVES</span>
<a name="l01525"></a>01525 <span class="comment">!     =============================</span>
<a name="l01526"></a>01526 
<a name="l01527"></a><a class="code" href="puma_8f90.html#af1e6869836cefedb3f5cc8a574944d91">01527</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#af1e6869836cefedb3f5cc8a574944d91">select_zonal_waves</a>
<a name="l01528"></a>01528       use <span class="keywordflow">pumamod</span>
<a name="l01529"></a>01529 
<a name="l01530"></a>01530       <span class="keyword">if</span> (sum(nselzw(:)) /= NTP1) <span class="keyword">then</span> <span class="comment">! some wavenumbers disabled</span>
<a name="l01531"></a>01531          lselect = .true.
<a name="l01532"></a>01532       <span class="keyword">endif</span>
<a name="l01533"></a>01533       return
<a name="l01534"></a>01534 <span class="keyword">      end</span>
<a name="l01535"></a>01535 
<a name="l01536"></a>01536 <span class="comment">!     ================================</span>
<a name="l01537"></a>01537 <span class="comment">!     SUBROUTINE SELECT_SPECTRAL_MODES</span>
<a name="l01538"></a>01538 <span class="comment">!     ================================</span>
<a name="l01539"></a>01539 
<a name="l01540"></a><a class="code" href="puma_8f90.html#a01c0a9ea1eee2f86044600c5e81dbebd">01540</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a01c0a9ea1eee2f86044600c5e81dbebd">select_spectral_modes</a>
<a name="l01541"></a>01541       use <span class="keywordflow">pumamod</span>
<a name="l01542"></a>01542 
<a name="l01543"></a>01543       <span class="keyword">if</span> (sum(nselsp(:)) /= NCSP) <span class="keyword">then</span> <span class="comment">! some modes disabled</span>
<a name="l01544"></a>01544          lspecsel = .true.
<a name="l01545"></a>01545       <span class="keyword">endif</span>
<a name="l01546"></a>01546       return
<a name="l01547"></a>01547 <span class="keyword">      end</span>
<a name="l01548"></a>01548 
<a name="l01549"></a>01549 <span class="comment">!     =====================</span>
<a name="l01550"></a>01550 <span class="comment">!     * SET VERTICAL GRID *</span>
<a name="l01551"></a>01551 <span class="comment">!     =====================</span>
<a name="l01552"></a>01552 
<a name="l01553"></a><a class="code" href="puma_8f90.html#a00e3481744c3185f0f91d35c101f28e4">01553</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">set_vertical_grid</a>
<a name="l01554"></a>01554 
<a name="l01555"></a>01555       use <span class="keywordflow">pumamod</span>
<a name="l01556"></a>01556 
<a name="l01557"></a>01557       <span class="keyword">if</span> (sigmh(NLEV) /= 0.0) return <span class="comment">! Already read in from namelist INP</span>
<a name="l01558"></a>01558 
<a name="l01559"></a>01559       <span class="keyword">if</span> (nvg == 1) <span class="keyword">then</span>              <span class="comment">! Scinocca &amp; Haynes sigma levels</span>
<a name="l01560"></a>01560 
<a name="l01561"></a>01561          <span class="keyword">if</span> (nlevt &gt;= NLEV) <span class="keyword">then</span>      <span class="comment">! Security check for &#39;nlevt&#39;</span>
<a name="l01562"></a>01562             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;*** ERROR *** nlevt &gt;= NLEV&#39;</span>
<a name="l01563"></a>01563             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Number of levels (NLEV): &#39;</span>,NLEV
<a name="l01564"></a>01564             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Number of tropospheric levels (nlevt): &#39;</span>,nlevt
<a name="l01565"></a>01565          <span class="keyword">endif</span>   
<a name="l01566"></a>01566 
<a name="l01567"></a>01567 <span class="comment">!     troposphere: linear spacing in sigma</span>
<a name="l01568"></a>01568 <span class="comment">!     stratosphere: linear spacing in log(sigma)</span>
<a name="l01569"></a>01569 <span class="comment">!     after (see their Appendix):</span>
<a name="l01570"></a>01570 <span class="comment">!     Scinocca, J. F. and P. H. Haynes (1998): Dynamical forcing of</span>
<a name="l01571"></a>01571 <span class="comment">!        stratospheric planetary waves by tropospheric baroclinic eddies.</span>
<a name="l01572"></a>01572 <span class="comment">!        J. Atmos. Sci., 55 (14), 2361-2392</span>
<a name="l01573"></a>01573 
<a name="l01574"></a>01574 <span class="comment">!     Here, zsigtran is set to sigma at dtrop (tropopause height for</span>
<a name="l01575"></a>01575 <span class="comment">!     construction of restoration temperature field). If tgr=288.15K,</span>
<a name="l01576"></a>01576 <span class="comment">!     ALR=0.0065K/km and dtrop=11.km, then zsigtran=0.223 (=0.1 in</span>
<a name="l01577"></a>01577 <span class="comment">!     Scinocca and Haynes (1998)).</span>
<a name="l01578"></a>01578 <span class="comment">!     A smoothing of the transition between linear and logarithmic</span>
<a name="l01579"></a>01579 <span class="comment">!     spacing, as noted in Scinocca and Haynes (1998), is not yet</span>
<a name="l01580"></a>01580 <span class="comment">!     implemented.</span>
<a name="l01581"></a>01581 
<a name="l01582"></a>01582          zsigtran = (1. - alr * dtrop / tgr)**(ga/(gascon*alr))
<a name="l01583"></a>01583          zsigmin = 1. - (1. - zsigtran) / <span class="keywordtype">real</span>(nlevt)
<a name="l01584"></a>01584 
<a name="l01585"></a>01585          <span class="keyword">do</span> jlev=1,NLEV
<a name="l01586"></a>01586             <span class="keyword">if</span> (jlev == 1) <span class="keyword">then</span>
<a name="l01587"></a>01587                sigmh(jlev) = SIGMAX
<a name="l01588"></a>01588             elseif (jlev &gt; 1 .and. jlev &lt; NLEV - nlevt) <span class="keyword">then</span>
<a name="l01589"></a>01589                sigmh(jlev) = exp((log(SIGMAX) - log(zsigtran))         &amp;
<a name="l01590"></a>01590      &amp;             / <span class="keywordtype">real(NLEV - nlevt - 1)</span> * <span class="keywordtype">real(NLEV - nlevt - jlev)</span> 
<a name="l01591"></a>01591                   + log(zsigtran))
<a name="l01592"></a>01592             elseif (jlev &gt;= NLEV - nlevt .and. jlev &lt; NLEV - 1) then
<a name="l01593"></a>01593                sigmh(jlev) = (zsigtran - zsigmin) / <span class="keywordtype">real(nlevt - 1)</span>    
<a name="l01594"></a>01594                              * real(NLEV - 1 - jlev) + zsigmin
<a name="l01595"></a>01595             elseif (jlev == NLEV - 1) then
<a name="l01596"></a>01596                sigmh(jlev) = zsigmin
<a name="l01597"></a>01597             elseif (jlev == NLEV) <span class="keyword">then</span>
<a name="l01598"></a>01598                sigmh(jlev) = 1.
<a name="l01599"></a>01599             <span class="keyword">endif</span>
<a name="l01600"></a>01600          <span class="keyword">enddo</span>
<a name="l01601"></a>01601          return  <span class="comment">! case nvg == 1 finished</span>
<a name="l01602"></a>01602       <span class="keyword">else</span> <span class="keyword">if</span> (nvg == 2) <span class="keyword">then</span>   <span class="comment">! Polvani &amp; Kushner sigma levels</span>
<a name="l01603"></a>01603          inl = int(<span class="keywordtype">real</span>(NLEV)/(1.0 - sigmax**(1.0/5.0)))
<a name="l01604"></a>01604          <span class="keyword">do</span> jlev=1,NLEV
<a name="l01605"></a>01605             sigmh(jlev) = (<span class="keywordtype">real(jlev + inl - NLEV)</span> / <span class="keywordtype">real</span>(inl))**5
<a name="l01606"></a>01606          <span class="keyword">enddo</span>
<a name="l01607"></a>01607          return
<a name="l01608"></a>01608 
<a name="l01609"></a>01609 <span class="comment">!     Default (nvg == 0) : equidistant sigma levels</span>
<a name="l01610"></a>01610 
<a name="l01611"></a>01611       <span class="keyword">else</span>
<a name="l01612"></a>01612          <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l01613"></a>01613             sigmh(jlev) = <span class="keywordtype">real(jlev)</span> / <span class="keywordtype">real</span>(NLEV)
<a name="l01614"></a>01614          <span class="keyword">enddo</span>
<a name="l01615"></a>01615       <span class="keyword">endif</span>
<a name="l01616"></a>01616 
<a name="l01617"></a>01617       return
<a name="l01618"></a>01618 <span class="keyword">      end</span>
<a name="l01619"></a>01619 
<a name="l01620"></a>01620 
<a name="l01621"></a>01621 <span class="comment">!     =================</span>
<a name="l01622"></a>01622 <span class="comment">!     SUBROUTINE INITPM</span>
<a name="l01623"></a>01623 <span class="comment">!     =================</span>
<a name="l01624"></a>01624 
<a name="l01625"></a><a class="code" href="puma_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">01625</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">initpm</a>
<a name="l01626"></a>01626       use <span class="keywordflow">pumamod</span>
<a name="l01627"></a>01627 
<a name="l01628"></a>01628       <span class="keywordtype">real (kind=8)</span> :: radea,zakk,zzakk
<a name="l01629"></a>01629       <span class="keywordtype">real</span> :: zsigb          <span class="comment">! sigma_b for Held &amp; Suarez frictional</span>
<a name="l01630"></a>01630 <span class="comment">!                              and heating timescales</span>
<a name="l01631"></a>01631 
<a name="l01632"></a>01632       radea  = plarad        <span class="comment">! Planet radius in high precision</span>
<a name="l01633"></a>01633       plavor = EZ * rotspd   <span class="comment">! Planetary vorticity</span>
<a name="l01634"></a>01634 
<a name="l01635"></a>01635 <span class="comment">!     *************************************************************</span>
<a name="l01636"></a>01636 <span class="comment">!     * carries out all initialisation of model prior to running. *</span>
<a name="l01637"></a>01637 <span class="comment">!     * major sections identified with comments.                  *</span>
<a name="l01638"></a>01638 <span class="comment">!     * this s/r sets the model parameters and all resolution     *</span>
<a name="l01639"></a>01639 <span class="comment">!     * dependent quantities.                                     *</span>
<a name="l01640"></a>01640 <span class="comment">!     *************************************************************</span>
<a name="l01641"></a>01641 
<a name="l01642"></a>01642       <span class="keyword">if</span> (lrestart) nkits=0
<a name="l01643"></a>01643 
<a name="l01644"></a>01644 <span class="comment">!     ****************************************************</span>
<a name="l01645"></a>01645 <span class="comment">!     * Check for enabling / disabling zonal wavenumbers *</span>
<a name="l01646"></a>01646 <span class="comment">!     ****************************************************</span>
<a name="l01647"></a>01647 
<a name="l01648"></a>01648       call <a class="code" href="puma_8f90.html#af1e6869836cefedb3f5cc8a574944d91">select_zonal_waves</a>
<a name="l01649"></a>01649       <span class="keyword">if</span> (npro == 1) call <a class="code" href="puma_8f90.html#a01c0a9ea1eee2f86044600c5e81dbebd">select_spectral_modes</a>
<a name="l01650"></a>01650 
<a name="l01651"></a>01651 <span class="comment">!     *********************</span>
<a name="l01652"></a>01652 <span class="comment">!     * set vertical grid *</span>
<a name="l01653"></a>01653 <span class="comment">!     *********************</span>
<a name="l01654"></a>01654 
<a name="l01655"></a>01655       call <a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">set_vertical_grid</a>
<a name="l01656"></a>01656 
<a name="l01657"></a>01657       dsigma(1     ) = sigmh(1)
<a name="l01658"></a>01658       dsigma(2:NLEV) = sigmh(2:NLEV) - sigmh(1:NLEM)
<a name="l01659"></a>01659 
<a name="l01660"></a>01660       rdsig(:) = 0.5 / dsigma(:)
<a name="l01661"></a>01661 
<a name="l01662"></a>01662       sigma(1     ) = 0.5 * sigmh(1)
<a name="l01663"></a>01663       sigma(2:NLEV) = 0.5 * (sigmh(1:NLEM) + sigmh(2:NLEV))
<a name="l01664"></a>01664 
<a name="l01665"></a>01665 <span class="comment">!     Initialize profile of tau R if not set in namelist</span>
<a name="l01666"></a>01666 
<a name="l01667"></a>01667       <span class="keyword">if</span> (taur(NLEV) == 0.0) <span class="keyword">then</span>
<a name="l01668"></a>01668          <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l01669"></a>01669             taur(jlev) = 158.0 / PI * atan(1.0 - sigma(jlev))
<a name="l01670"></a>01670             <span class="keyword">if</span> (taur(jlev) &gt; 30.0) taur(jlev) = 30.0
<a name="l01671"></a>01671          <span class="keyword">enddo</span>
<a name="l01672"></a>01672       <span class="keyword">endif</span>
<a name="l01673"></a>01673 
<a name="l01674"></a>01674 <span class="comment">!     Initialize profile of tau F if not set in namelist</span>
<a name="l01675"></a>01675 
<a name="l01676"></a>01676       <span class="keyword">if</span> (tauf(NLEV) == 0.0) <span class="keyword">then</span>
<a name="l01677"></a>01677          <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l01678"></a>01678             <span class="keyword">if</span> (sigma(jlev) &gt; 0.8) <span class="keyword">then</span>
<a name="l01679"></a>01679                tauf(jlev) = exp(10.0 * (1.0 - sigma(jlev))) / 2.718
<a name="l01680"></a>01680             <span class="keyword">endif</span>
<a name="l01681"></a>01681          <span class="keyword">enddo</span>
<a name="l01682"></a>01682       <span class="keyword">endif</span>
<a name="l01683"></a>01683 
<a name="l01684"></a>01684 <span class="comment">!     Compute 1.0 / (2 Pi * tau) for efficient use in calculations</span>
<a name="l01685"></a>01685 <span class="comment">!     A day is 2 Pi in non dimensional units using omega as scaling</span>
<a name="l01686"></a>01686 
<a name="l01687"></a>01687       <span class="keyword">where</span> (taur(:) &gt; 0.0)
<a name="l01688"></a>01688          damp(:) = 1.0 / (TWOPI * taur(:))
<a name="l01689"></a>01689       endwhere
<a name="l01690"></a>01690 
<a name="l01691"></a>01691       <span class="keyword">where</span> (tauf(:) &gt; 0.0)
<a name="l01692"></a>01692           fric(:) = 1.0 / (TWOPI * tauf(:))
<a name="l01693"></a>01693       endwhere
<a name="l01694"></a>01694 
<a name="l01695"></a>01695       <span class="keyword">if</span> (nsponge == 1) call <a class="code" href="puma_8f90.html#a0c040011dabc1b712353c37a4d90cc68">sponge</a>
<a name="l01696"></a>01696 
<a name="l01697"></a>01697 
<a name="l01698"></a>01698 <span class="comment">!     annual cycle period and phase in timesteps</span>
<a name="l01699"></a>01699 
<a name="l01700"></a>01700       <span class="keyword">if</span> (tac &gt; 0.0) tac = TWOPI / (ntspd * tac)
<a name="l01701"></a>01701       pac = pac * ntspd
<a name="l01702"></a>01702 
<a name="l01703"></a>01703 <span class="comment">!     compute internal diffusion parameter</span>
<a name="l01704"></a>01704 
<a name="l01705"></a>01705       jdelh = ndel/2
<a name="l01706"></a>01706       <span class="keyword">if</span> (tdiss &gt; 0.0) <span class="keyword">then</span>
<a name="l01707"></a>01707          zakk = ww*(radea**ndel)/(TWOPI*tdiss*((NTRU*(NTRU+1.))**jdelh))
<a name="l01708"></a>01708       <span class="keyword">else</span>
<a name="l01709"></a>01709          zakk = 0.0
<a name="l01710"></a>01710       <span class="keyword">endif</span>
<a name="l01711"></a>01711       zzakk = zakk / (ww*(radea**ndel))
<a name="l01712"></a>01712 
<a name="l01713"></a>01713 <span class="comment">!     set coefficients which depend on wavenumber</span>
<a name="l01714"></a>01714 
<a name="l01715"></a>01715       zrsq2 = 1.0 / sqrt(2.0)
<a name="l01716"></a>01716 
<a name="l01717"></a>01717       jr =-1
<a name="l01718"></a>01718       jw = 0
<a name="l01719"></a>01719       <span class="keyword">do</span> jm=0,NTRU
<a name="l01720"></a>01720          <span class="keyword">do</span> jn=jm,NTRU
<a name="l01721"></a>01721             jr=jr+2
<a name="l01722"></a>01722             ji=jr+1
<a name="l01723"></a>01723             jw=jw+1
<a name="l01724"></a>01724             nindex(jr)=jn
<a name="l01725"></a>01725             nindex(ji)=jn
<a name="l01726"></a>01726             spnorm(jr)=zrsq2
<a name="l01727"></a>01727             spnorm(ji)=zrsq2
<a name="l01728"></a>01728             zsq = jn * (jn+1)
<a name="l01729"></a>01729             <span class="keyword">if</span> (jn &gt; 0) <span class="keyword">then</span>
<a name="l01730"></a>01730                srcn(jr) = 1.0 / zsq
<a name="l01731"></a>01731                srcn(ji) = srcn(jr)
<a name="l01732"></a>01732             <span class="keyword">endif</span>
<a name="l01733"></a>01733             sak(jr) = -zzakk * zsq**jdelh
<a name="l01734"></a>01734             sak(ji) = sak(jr)
<a name="l01735"></a>01735          <span class="keyword">enddo</span>
<a name="l01736"></a>01736          zrsq2=-zrsq2
<a name="l01737"></a>01737       <span class="keyword">enddo</span>
<a name="l01738"></a>01738 
<a name="l01739"></a>01739 <span class="comment">! finally make temperatures dimensionless</span>
<a name="l01740"></a>01740 
<a name="l01741"></a>01741       dtns  = dtns    / ct
<a name="l01742"></a>01742       dtep  = dtep    / ct
<a name="l01743"></a>01743 <span class="comment">!     dttrp = dttrp   / ct</span>
<a name="l01744"></a>01744       t0(:) = t0(:) / ct
<a name="l01745"></a>01745 
<a name="l01746"></a>01746 <span class="comment">!     print out</span>
<a name="l01747"></a>01747 
<a name="l01748"></a>01748       <span class="keyword">write</span>(nud,8120)
<a name="l01749"></a>01749       <span class="keyword">write</span>(nud,8000)
<a name="l01750"></a>01750       <span class="keyword">write</span>(nud,8010) NLEV
<a name="l01751"></a>01751       <span class="keyword">write</span>(nud,8020) NTRU
<a name="l01752"></a>01752       <span class="keyword">write</span>(nud,8030) NLAT
<a name="l01753"></a>01753       <span class="keyword">write</span>(nud,8040) NLON
<a name="l01754"></a>01754       <span class="keyword">if</span> (zakk == 0.0) <span class="keyword">then</span>
<a name="l01755"></a>01755          <span class="keyword">write</span>(nud,8060)
<a name="l01756"></a>01756       <span class="keyword">else</span>
<a name="l01757"></a>01757          <span class="keyword">write</span>(nud,8070) ndel
<a name="l01758"></a>01758          <span class="keyword">write</span>(nud,8080)
<a name="l01759"></a>01759          <span class="keyword">write</span>(nud,8090) zakk,ndel
<a name="l01760"></a>01760          <span class="keyword">write</span>(nud,8100) tdiss
<a name="l01761"></a>01761       <span class="keyword">endif</span>
<a name="l01762"></a>01762       <span class="keyword">write</span>(nud,8110) PNU
<a name="l01763"></a>01763       <span class="keyword">write</span>(nud,8000)
<a name="l01764"></a>01764       <span class="keyword">write</span>(nud,8120)
<a name="l01765"></a>01765       return
<a name="l01766"></a>01766 
<a name="l01767"></a>01767  8000 format(<span class="stringliteral">&#39;*****************************************************&#39;</span>)
<a name="l01768"></a>01768  8010 format(<span class="stringliteral">&#39;* NLEV = &#39;</span>,i6,<span class="stringliteral">&#39;   Number of levels                  *&#39;</span>)
<a name="l01769"></a>01769  8020 format(<span class="stringliteral">&#39;* NTRU = &#39;</span>,i6,<span class="stringliteral">&#39;   Triangular truncation             *&#39;</span>)
<a name="l01770"></a>01770  8030 format(<span class="stringliteral">&#39;* NLAT = &#39;</span>,i6,<span class="stringliteral">&#39;   Number of latitudes               *&#39;</span>)
<a name="l01771"></a>01771  8040 format(<span class="stringliteral">&#39;* NLON = &#39;</span>,i6,<span class="stringliteral">&#39;   Number of longitues               *&#39;</span>)
<a name="l01772"></a>01772  8060 format(<span class="stringliteral">&#39;*                 No lateral dissipation            *&#39;</span>)
<a name="l01773"></a>01773  8070 format(<span class="stringliteral">&#39;* ndel = &#39;</span>,i6,<span class="stringliteral">&#39;   Lateral dissipation               *&#39;</span>)
<a name="l01774"></a>01774  8080 format(<span class="stringliteral">&#39;* on vorticity, divergence and temperature          *&#39;</span>)
<a name="l01775"></a>01775  8090 format(<span class="stringliteral">&#39;* with diffusion coefficient = &#39;</span>,e13.4,<span class="stringliteral">&#39; m**&#39;</span>,i1,<span class="stringliteral">&#39;/s *&#39;</span>)
<a name="l01776"></a>01776  8100 format(<span class="stringliteral">&#39;* e-folding time for smallest scale is &#39;</span>,f7.3,<span class="stringliteral">&#39; days *&#39;</span>)
<a name="l01777"></a>01777  8110 format(<span class="stringliteral">&#39;* Robert time filter with parameter PNU =&#39;</span>,f8.3,<span class="stringliteral">&#39;   *&#39;</span>)
<a name="l01778"></a>01778  8120 format(/)
<a name="l01779"></a>01779 <span class="keyword">      end</span>
<a name="l01780"></a>01780 
<a name="l01781"></a>01781 
<a name="l01782"></a>01782 <span class="comment">!     =================</span>
<a name="l01783"></a>01783 <span class="comment">!     SUBROUTINE MAKEBM</span>
<a name="l01784"></a>01784 <span class="comment">!     =================</span>
<a name="l01785"></a>01785 
<a name="l01786"></a><a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">01786</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">makebm</a>
<a name="l01787"></a>01787       use <span class="keywordflow">pumamod</span>
<a name="l01788"></a>01788 
<a name="l01789"></a>01789       zdeltsq = delt * delt
<a name="l01790"></a>01790 
<a name="l01791"></a>01791       <span class="keyword">do</span> jlev1 = 1 , NLEV
<a name="l01792"></a>01792          <span class="keyword">do</span> jlev2 = 1 , NLEV
<a name="l01793"></a>01793             zaq = zdeltsq * (t0(jlev1) * dsigma(jlev2)&amp;
<a name="l01794"></a>01794      &amp;          + dot_product(xlphi(:,jlev1),xlt(jlev2,:)))
<a name="l01795"></a>01795             bm1(jlev2,jlev1,1:NTRU) = zaq
<a name="l01796"></a>01796          <span class="keyword">enddo</span>
<a name="l01797"></a>01797       <span class="keyword">enddo</span>
<a name="l01798"></a>01798 
<a name="l01799"></a>01799       <span class="keyword">do</span> jn=1,NTRU
<a name="l01800"></a>01800          <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l01801"></a>01801             bm1(jlev,jlev,jn) = bm1(jlev,jlev,jn) + 1.0 / (jn*(jn+1))
<a name="l01802"></a>01802          <span class="keyword">enddo</span>
<a name="l01803"></a>01803          call <a class="code" href="puma_8f90.html#ac5b1247975fc97ef45931e410766a417">minvers</a>(bm1(1,1,jn),NLEV)
<a name="l01804"></a>01804       <span class="keyword">enddo</span>
<a name="l01805"></a>01805       return
<a name="l01806"></a>01806 <span class="keyword">      end</span>
<a name="l01807"></a>01807 
<a name="l01808"></a>01808 <span class="comment">!     =================</span>
<a name="l01809"></a>01809 <span class="comment">!     SUBROUTINE INITSI</span>
<a name="l01810"></a>01810 <span class="comment">!     =================</span>
<a name="l01811"></a>01811 
<a name="l01812"></a><a class="code" href="puma_8f90.html#a96b9223819624937b18b4e5b29e95a91">01812</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a96b9223819624937b18b4e5b29e95a91">initsi</a>
<a name="l01813"></a>01813       use <span class="keywordflow">pumamod</span>
<a name="l01814"></a>01814 
<a name="l01815"></a>01815 <span class="comment">!     **********************************************</span>
<a name="l01816"></a>01816 <span class="comment">!     * Initialisation of the Semi Implicit scheme *</span>
<a name="l01817"></a>01817 <span class="comment">!     **********************************************</span>
<a name="l01818"></a>01818 
<a name="l01819"></a>01819       dimension zalp(NLEV),zh(NLEV)
<a name="l01820"></a>01820       dimension ztautk(NLEV,NLEV)
<a name="l01821"></a>01821       dimension ztaudt(NLEV,NLEV)
<a name="l01822"></a>01822 
<a name="l01823"></a>01823       tkp(:) = akap * t0(:)
<a name="l01824"></a>01824       t0d(1:NLEM) = t0(2:NLEV) - t0(1:NLEM)
<a name="l01825"></a>01825 
<a name="l01826"></a>01826       zalp(2:NLEV) = log(sigmh(2:NLEV)) - log(sigmh(1:NLEM))
<a name="l01827"></a>01827 
<a name="l01828"></a>01828       xlphi(:,:) = 0.0
<a name="l01829"></a>01829       xlphi(1,1) = 1.0
<a name="l01830"></a>01830       <span class="keyword">do</span> jlev = 2 , NLEV
<a name="l01831"></a>01831          xlphi(jlev,jlev) = 1.0 - zalp(jlev)*sigmh(jlev-1)/dsigma(jlev)
<a name="l01832"></a>01832          xlphi(jlev,1:jlev-1) = zalp(jlev)
<a name="l01833"></a>01833       <span class="keyword">enddo</span>
<a name="l01834"></a>01834 
<a name="l01835"></a>01835       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l01836"></a>01836          c(jlev,:) = xlphi(:,jlev) * (dsigma(jlev) / dsigma(:))
<a name="l01837"></a>01837       <span class="keyword">enddo</span>
<a name="l01838"></a>01838 
<a name="l01839"></a>01839 <span class="comment">!     ***********************   tkp(i) = t0(i) * AKAP</span>
<a name="l01840"></a>01840 <span class="comment">!     * matrix xlt - part 1 *</span>
<a name="l01841"></a>01841 <span class="comment">!     ***********************</span>
<a name="l01842"></a>01842 
<a name="l01843"></a>01843       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l01844"></a>01844          ztautk(:,jlev) = tkp(jlev) * c(:,jlev)
<a name="l01845"></a>01845       <span class="keyword">enddo</span>
<a name="l01846"></a>01846 
<a name="l01847"></a>01847 <span class="comment">!     *********************   dsigma(i) = sigmh(i) - sigmh(i-1)</span>
<a name="l01848"></a>01848 <span class="comment">!     * matrix xlt part 2 *   rdsig (i) = 0.5 / dsigma(i)</span>
<a name="l01849"></a>01849 <span class="comment">!     *********************</span>
<a name="l01850"></a>01850 
<a name="l01851"></a>01851       ztaudt(1,1)      = 0.5 * t0d(1) * (sigmh(1) - 1.0)
<a name="l01852"></a>01852       ztaudt(2:NLEV,1) = 0.5 * t0d(1) *  dsigma(2:NLEV)
<a name="l01853"></a>01853 
<a name="l01854"></a>01854       <span class="keyword">do</span> j= 2 , NLEV
<a name="l01855"></a>01855          <span class="keyword">do</span> i = 1 , j-1
<a name="l01856"></a>01856             ztaudt(i,j) =  dsigma(i) * rdsig(j) &amp;
<a name="l01857"></a>01857             * (t0d(j-1) * (sigmh(j-1)-1.0) + t0d(j) * (sigmh(j)-1.0))
<a name="l01858"></a>01858          <span class="keyword">enddo</span>
<a name="l01859"></a>01859             ztaudt(j,j) =  0.5                  &amp;
<a name="l01860"></a>01860             * (t0d(j-1) *  sigmh(j-1)      + t0d(j) * (sigmh(j)-1.0))
<a name="l01861"></a>01861          <span class="keyword">do</span> i = j+1 , NLEV
<a name="l01862"></a>01862             ztaudt(i,j) =  dsigma(i) * rdsig(j) &amp;
<a name="l01863"></a>01863             * (t0d(j-1) *  sigmh(j-1)      + t0d(j) *  sigmh(j)     )
<a name="l01864"></a>01864          <span class="keyword">enddo</span>
<a name="l01865"></a>01865       <span class="keyword">enddo</span>
<a name="l01866"></a>01866 
<a name="l01867"></a>01867       xlt(:,:) = ztautk(:,:) + ztaudt(:,:)
<a name="l01868"></a>01868 
<a name="l01869"></a>01869 <span class="comment">!     xlt finished</span>
<a name="l01870"></a>01870 
<a name="l01871"></a>01871       zfctr=0.001*cv*cv/ga
<a name="l01872"></a>01872       <span class="keyword">do</span> jlev=1,NLEV
<a name="l01873"></a>01873          zh(jlev) = dot_product(xlphi(:,jlev),t0(:)) * zfctr
<a name="l01874"></a>01874       <span class="keyword">enddo</span>
<a name="l01875"></a>01875 
<a name="l01876"></a>01876 <span class="comment">!     **********************************</span>
<a name="l01877"></a>01877 <span class="comment">!     * write out vertical information *</span>
<a name="l01878"></a>01878 <span class="comment">!     **********************************</span>
<a name="l01879"></a>01879 
<a name="l01880"></a>01880       ilev = min(NLEV,5)
<a name="l01881"></a>01881       <span class="keyword">write</span>(nud,9001)
<a name="l01882"></a>01882       <span class="keyword">write</span>(nud,9002)
<a name="l01883"></a>01883       <span class="keyword">write</span>(nud,9003)
<a name="l01884"></a>01884       <span class="keyword">write</span>(nud,9002)
<a name="l01885"></a>01885       <span class="keyword">do</span> jlev=1,NLEV
<a name="l01886"></a>01886         <span class="keyword">write</span>(nud,9004) jlev,sigma(jlev),t0(jlev)*ct,zh(jlev)
<a name="l01887"></a>01887       <span class="keyword">enddo</span>
<a name="l01888"></a>01888       <span class="keyword">write</span>(nud,9002)
<a name="l01889"></a>01889       <span class="keyword">write</span>(nud,9001)
<a name="l01890"></a>01890 
<a name="l01891"></a>01891 <span class="comment">!     matrix c</span>
<a name="l01892"></a>01892 
<a name="l01893"></a>01893       <span class="keyword">write</span>(nud,9012)
<a name="l01894"></a>01894       <span class="keyword">write</span>(nud,9013) <span class="stringliteral">&#39;c&#39;</span>,(jlev,jlev=1,ilev)
<a name="l01895"></a>01895       <span class="keyword">write</span>(nud,9012)
<a name="l01896"></a>01896       <span class="keyword">do</span> jlev=1,NLEV
<a name="l01897"></a>01897         <span class="keyword">write</span>(nud,9014) jlev,(c(i,jlev),i=1,ilev)
<a name="l01898"></a>01898       <span class="keyword">enddo</span>
<a name="l01899"></a>01899       <span class="keyword">write</span>(nud,9012)
<a name="l01900"></a>01900       <span class="keyword">write</span>(nud,9001)
<a name="l01901"></a>01901 
<a name="l01902"></a>01902 <span class="comment">!     matrix xlphi</span>
<a name="l01903"></a>01903 
<a name="l01904"></a>01904       <span class="keyword">write</span>(nud,9012)
<a name="l01905"></a>01905       <span class="keyword">write</span>(nud,9013) <span class="stringliteral">&#39;xlphi&#39;</span>,(jlev,jlev=1,ilev)
<a name="l01906"></a>01906       <span class="keyword">write</span>(nud,9012)
<a name="l01907"></a>01907       <span class="keyword">do</span> jlev=1,NLEV
<a name="l01908"></a>01908         <span class="keyword">write</span>(nud,9014) jlev,(xlphi(i,jlev),i=1,ilev)
<a name="l01909"></a>01909       <span class="keyword">enddo</span>
<a name="l01910"></a>01910       <span class="keyword">write</span>(nud,9012)
<a name="l01911"></a>01911       <span class="keyword">write</span>(nud,9001)
<a name="l01912"></a>01912       return
<a name="l01913"></a>01913  9001 format(/)
<a name="l01914"></a>01914  9002 format(33(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l01915"></a>01915  9003 format(<span class="stringliteral">&#39;* Lv *    Sigma Basic-T  Height *&#39;</span>)
<a name="l01916"></a>01916  9004 format(<span class="stringliteral">&#39;*&#39;</span>,i3,<span class="stringliteral">&#39; * &#39;</span>,3f8.3,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l01917"></a>01917  9012 format(69(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l01918"></a>01918  9013 format(<span class="stringliteral">&#39;* Lv * &#39;</span>,a5,i7,4i12,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l01919"></a>01919  9014 format(<span class="stringliteral">&#39;*&#39;</span>,i3,<span class="stringliteral">&#39; * &#39;</span>,5f12.8,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l01920"></a>01920 <span class="keyword">      end</span>
<a name="l01921"></a>01921 
<a name="l01922"></a>01922 <span class="comment">!     =====================</span>
<a name="l01923"></a>01923 <span class="comment">!     SUBROUTINE INITRANDOM</span>
<a name="l01924"></a>01924 <span class="comment">!     =====================</span>
<a name="l01925"></a>01925 
<a name="l01926"></a><a class="code" href="puma_8f90.html#acbd8e7fdd2e1f60dbca741a700fb292a">01926</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#acbd8e7fdd2e1f60dbca741a700fb292a">initrandom</a>
<a name="l01927"></a>01927       use <span class="keywordflow">pumamod</span>
<a name="l01928"></a>01928       <span class="keywordtype">integer</span> :: i, clock
<a name="l01929"></a>01929 
<a name="l01930"></a>01930 <span class="comment">!     Set random number generator seed</span>
<a name="l01931"></a>01931 
<a name="l01932"></a>01932       call random_seed(size=nseedlen)
<a name="l01933"></a>01933       <span class="keyword">allocate</span>(meed(nseedlen))
<a name="l01934"></a>01934 
<a name="l01935"></a>01935 <span class="comment">!     Take seed from namelist parameter &#39;SEED&#39; ?</span>
<a name="l01936"></a>01936 
<a name="l01937"></a>01937       <span class="keyword">if</span> (seed(1) /= 0) <span class="keyword">then</span>
<a name="l01938"></a>01938          meed(:) = 0
<a name="l01939"></a>01939          i = nseedlen
<a name="l01940"></a>01940          <span class="keyword">if</span> (i &gt; 8) i = 8
<a name="l01941"></a>01941          meed(1:i) = seed(1:i)
<a name="l01942"></a>01942       <span class="keyword">else</span>
<a name="l01943"></a>01943          call system_clock(<a class="code" href="pumax_8c.html#ad43c3812e6d13e0518d9f8b8f463ffcf">count</a>=clock)
<a name="l01944"></a>01944          meed(:) = clock + 37 * (/(i,i=1,nseedlen)/)
<a name="l01945"></a>01945       <span class="keyword">endif</span>
<a name="l01946"></a>01946       call random_seed(put=meed)
<a name="l01947"></a>01947       return
<a name="l01948"></a>01948 <span class="keyword">      end</span>
<a name="l01949"></a>01949 
<a name="l01950"></a>01950 <span class="comment">!     ====================</span>
<a name="l01951"></a>01951 <span class="comment">!     SUBROUTINE PRINTSEED</span>
<a name="l01952"></a>01952 <span class="comment">!     ====================</span>
<a name="l01953"></a>01953 
<a name="l01954"></a><a class="code" href="puma_8f90.html#a9a888c599145a63cdd108dffa553b509">01954</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9a888c599145a63cdd108dffa553b509">printseed</a>
<a name="l01955"></a>01955       use <span class="keywordflow">pumamod</span>
<a name="l01956"></a>01956       <span class="keywordtype">integer</span> :: i
<a name="l01957"></a>01957 
<a name="l01958"></a>01958       <span class="keyword">write</span> (nud,9020)
<a name="l01959"></a>01959       <span class="keyword">write</span> (nud,9010)
<a name="l01960"></a>01960       <span class="keyword">do</span> i = 1 , nseedlen
<a name="l01961"></a>01961          <span class="keyword">write</span> (nud,9000) i,meed(i)
<a name="l01962"></a>01962       <span class="keyword">enddo</span>
<a name="l01963"></a>01963       <span class="keyword">write</span> (nud,9010)
<a name="l01964"></a>01964       <span class="keyword">write</span> (nud,9020)
<a name="l01965"></a>01965       return
<a name="l01966"></a>01966  9000 format(<span class="stringliteral">&#39;* seed(&#39;</span>,i1,<span class="stringliteral">&#39;) = &#39;</span>,i10,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l01967"></a>01967  9010 format(<span class="stringliteral">&#39;************************&#39;</span>)
<a name="l01968"></a>01968  9020 format(/)
<a name="l01969"></a>01969 <span class="keyword">      end</span>
<a name="l01970"></a>01970 
<a name="l01971"></a>01971 <span class="comment">!     ====================</span>
<a name="l01972"></a>01972 <span class="comment">!     SUBROUTINE INITRUIDO</span>
<a name="l01973"></a>01973 <span class="comment">!     ====================</span>
<a name="l01974"></a>01974 
<a name="l01975"></a><a class="code" href="puma_8f90.html#aea6c13c68157972ea21768a5ea43e154">01975</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aea6c13c68157972ea21768a5ea43e154">initruido</a>
<a name="l01976"></a>01976       use <span class="keywordflow">pumamod</span>
<a name="l01977"></a>01977       <span class="keyword">if</span> (nruido &gt; 0) <span class="keyword">then</span>
<a name="l01978"></a>01978          <span class="keyword">allocate</span>(ruido(nlon,nlat,nlev))
<a name="l01979"></a>01979          <span class="keyword">allocate</span>(ruidop(nhor,nlev))
<a name="l01980"></a>01980          ruido = 77
<a name="l01981"></a>01981          ruidop = 88
<a name="l01982"></a>01982       <span class="keyword">endif</span>
<a name="l01983"></a>01983       return
<a name="l01984"></a>01984 <span class="keyword">      end</span>
<a name="l01985"></a>01985 
<a name="l01986"></a>01986 <span class="comment">!     ====================</span>
<a name="l01987"></a>01987 <span class="comment">!     SUBROUTINE STEPRUIDO</span>
<a name="l01988"></a>01988 <span class="comment">!     ====================</span>
<a name="l01989"></a>01989 
<a name="l01990"></a><a class="code" href="puma_8f90.html#ab257e27330a3ab13c9c90ebd985ef60e">01990</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ab257e27330a3ab13c9c90ebd985ef60e">stepruido</a>
<a name="l01991"></a>01991       use <span class="keywordflow">pumamod</span>
<a name="l01992"></a>01992       <span class="keywordtype">real</span> :: zr
<a name="l01993"></a>01993       <span class="keywordtype">integer</span> :: need(8)
<a name="l01994"></a>01994 
<a name="l01995"></a>01995       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01996"></a>01996          <span class="keyword">if</span> (nruido == 1) <span class="keyword">then</span>
<a name="l01997"></a>01997             zr = disp*<a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>()
<a name="l01998"></a>01998             ruido(:,:,:) = zr
<a name="l01999"></a>01999          elseif (nruido == 2) <span class="keyword">then</span>
<a name="l02000"></a>02000             <span class="keyword">do</span> jlev=1,NLEV
<a name="l02001"></a>02001                <span class="keyword">do</span> jlat=1,NLAT
<a name="l02002"></a>02002                   <span class="keyword">do</span> jlon=1,NLON
<a name="l02003"></a>02003                      ruido(jlon,jlat,jlev) = disp*<a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>()
<a name="l02004"></a>02004                   <span class="keyword">enddo</span>
<a name="l02005"></a>02005                <span class="keyword">enddo</span>
<a name="l02006"></a>02006             <span class="keyword">enddo</span>
<a name="l02007"></a>02007          elseif (nruido == 3) <span class="keyword">then</span>
<a name="l02008"></a>02008             <span class="keyword">do</span> jlev=1,NLEV
<a name="l02009"></a>02009                <span class="keyword">do</span> jlat=1,NLAT,2
<a name="l02010"></a>02010                   <span class="keyword">do</span> jlon=1,NLON
<a name="l02011"></a>02011                      ruido(jlon,jlat  ,jlev) = disp*<a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>()
<a name="l02012"></a>02012                      ruido(jlon,jlat+1,jlev) = ruido(jlon,jlat,jlev)
<a name="l02013"></a>02013                   <span class="keyword">enddo</span>
<a name="l02014"></a>02014                <span class="keyword">enddo</span>
<a name="l02015"></a>02015             <span class="keyword">enddo</span>
<a name="l02016"></a>02016          <span class="keyword">endif</span>
<a name="l02017"></a>02017       <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span>
<a name="l02018"></a>02018 
<a name="l02019"></a>02019       call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(ruido,ruidop,NLEV)
<a name="l02020"></a>02020       call random_seed(get=need)
<a name="l02021"></a>02021       return
<a name="l02022"></a>02022 <span class="keyword">      end</span>
<a name="l02023"></a>02023 
<a name="l02024"></a>02024 <span class="comment">!     ==================</span>
<a name="l02025"></a>02025 <span class="comment">!     SUBROUTINE MINVERS</span>
<a name="l02026"></a>02026 <span class="comment">!     ==================</span>
<a name="l02027"></a>02027 
<a name="l02028"></a><a class="code" href="puma_8f90.html#ac5b1247975fc97ef45931e410766a417">02028</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ac5b1247975fc97ef45931e410766a417">minvers</a>(a,n)
<a name="l02029"></a>02029       dimension a(n,n),b(n,n),indx(n)
<a name="l02030"></a>02030 
<a name="l02031"></a>02031       b = 0.0
<a name="l02032"></a>02032       <span class="keyword">do</span> j = 1 , n
<a name="l02033"></a>02033          b(j,j) = 1.0
<a name="l02034"></a>02034       <span class="keyword">enddo</span>
<a name="l02035"></a>02035       call <a class="code" href="puma_8f90.html#afa767a8d587c360ca92357e066b6bf22">ludcmp</a>(a,n,indx)
<a name="l02036"></a>02036       <span class="keyword">do</span> j = 1 , n
<a name="l02037"></a>02037          call <a class="code" href="puma_8f90.html#a13d49d9c008cbc01f37c0c31d2012ad4">lubksb</a>(a,n,indx,b(1,j))
<a name="l02038"></a>02038       <span class="keyword">enddo</span>
<a name="l02039"></a>02039       a = b
<a name="l02040"></a>02040       return
<a name="l02041"></a>02041 <span class="keyword">      end</span>
<a name="l02042"></a>02042 
<a name="l02043"></a>02043 <span class="comment">!     =================</span>
<a name="l02044"></a>02044 <span class="comment">!     SUBROUTINE LUBKSB</span>
<a name="l02045"></a>02045 <span class="comment">!     =================</span>
<a name="l02046"></a>02046 
<a name="l02047"></a><a class="code" href="puma_8f90.html#a13d49d9c008cbc01f37c0c31d2012ad4">02047</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a13d49d9c008cbc01f37c0c31d2012ad4">lubksb</a>(a,n,indx,b)
<a name="l02048"></a>02048       dimension a(n,n),b(n),indx(n)
<a name="l02049"></a>02049       k = 0
<a name="l02050"></a>02050       <span class="keyword">do</span> i = 1 , n
<a name="l02051"></a>02051          l    = indx(i)
<a name="l02052"></a>02052          sum  = b(l)
<a name="l02053"></a>02053          b(l) = b(i)
<a name="l02054"></a>02054          <span class="keyword">if</span> (k &gt; 0) <span class="keyword">then</span>
<a name="l02055"></a>02055             <span class="keyword">do</span> j = k , i-1
<a name="l02056"></a>02056                sum = sum - a(i,j) * b(j)
<a name="l02057"></a>02057             <span class="keyword">enddo</span>
<a name="l02058"></a>02058          <span class="keyword">else</span> <span class="keyword">if</span> (sum /= 0.0) <span class="keyword">then</span>
<a name="l02059"></a>02059             k = i
<a name="l02060"></a>02060          <span class="keyword">endif</span>
<a name="l02061"></a>02061          b(i) = sum
<a name="l02062"></a>02062       <span class="keyword">enddo</span>
<a name="l02063"></a>02063 
<a name="l02064"></a>02064       <span class="keyword">do</span> i = n , 1 , -1
<a name="l02065"></a>02065          sum = b(i)
<a name="l02066"></a>02066          <span class="keyword">do</span> j = i+1 , n
<a name="l02067"></a>02067             sum = sum - a(i,j) * b(j)
<a name="l02068"></a>02068          <span class="keyword">enddo</span>
<a name="l02069"></a>02069          b(i) = sum / a(i,i)
<a name="l02070"></a>02070       <span class="keyword">enddo</span>
<a name="l02071"></a>02071       return
<a name="l02072"></a>02072 <span class="keyword">      end</span>
<a name="l02073"></a>02073 
<a name="l02074"></a>02074 <span class="comment">!     =================</span>
<a name="l02075"></a>02075 <span class="comment">!     SUBROUTINE LUDCMP</span>
<a name="l02076"></a>02076 <span class="comment">!     =================</span>
<a name="l02077"></a>02077 
<a name="l02078"></a><a class="code" href="puma_8f90.html#afa767a8d587c360ca92357e066b6bf22">02078</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#afa767a8d587c360ca92357e066b6bf22">ludcmp</a>(a,n,indx)
<a name="l02079"></a>02079       dimension a(n,n),indx(n),vv(n)
<a name="l02080"></a>02080 
<a name="l02081"></a>02081       d = 1.0
<a name="l02082"></a>02082       vv = 1.0 / maxval(abs(a),2)
<a name="l02083"></a>02083 
<a name="l02084"></a>02084       <span class="keyword">do</span> 19 j = 1 , n
<a name="l02085"></a>02085          <span class="keyword">do</span> i = 2 , j-1
<a name="l02086"></a>02086             a(i,j) = a(i,j) - dot_product(a(i,1:i-1),a(1:i-1,j))
<a name="l02087"></a>02087          <span class="keyword">enddo</span>
<a name="l02088"></a>02088          aamax = 0.0
<a name="l02089"></a>02089          <span class="keyword">do</span> i = j , n
<a name="l02090"></a>02090             <span class="keyword">if</span> (j &gt; 1) &amp;
<a name="l02091"></a>02091      &amp;      a(i,j) = a(i,j) - dot_product(a(i,1:j-1),a(1:j-1,j))
<a name="l02092"></a>02092             dum = vv(i) * abs(a(i,j))
<a name="l02093"></a>02093             <span class="keyword">if</span> (dum .ge. aamax) <span class="keyword">then</span>
<a name="l02094"></a>02094                imax = i
<a name="l02095"></a>02095                aamax = dum
<a name="l02096"></a>02096             <span class="keyword">endif</span>
<a name="l02097"></a>02097          <span class="keyword">enddo</span>
<a name="l02098"></a>02098          <span class="keyword">if</span> (j .ne. imax) <span class="keyword">then</span>
<a name="l02099"></a>02099             <span class="keyword">do</span> 17 k = 1 , n
<a name="l02100"></a>02100                dum = a(imax,k)
<a name="l02101"></a>02101                a(imax,k) = a(j,k)
<a name="l02102"></a>02102                a(j,k) = dum
<a name="l02103"></a>02103    17       continue
<a name="l02104"></a>02104             d = -d
<a name="l02105"></a>02105             vv(imax) = vv(j)
<a name="l02106"></a>02106          <span class="keyword">endif</span>
<a name="l02107"></a>02107          indx(j) = imax
<a name="l02108"></a>02108          <span class="keyword">if</span> (a(j,j) == 0.0) a(j,j) = tiny(a(j,j))
<a name="l02109"></a>02109          <span class="keyword">if</span> (j &lt; n) a(j+1:n,j) = a(j+1:n,j) / a(j,j)
<a name="l02110"></a>02110    19 continue
<a name="l02111"></a>02111       return
<a name="l02112"></a>02112 <span class="keyword">      end</span>
<a name="l02113"></a>02113 
<a name="l02114"></a>02114 <span class="comment">!     =============================</span>
<a name="l02115"></a>02115 <span class="comment">!     SUBROUTINE FILTER_ZONAL_WAVES</span>
<a name="l02116"></a>02116 <span class="comment">!     =============================</span>
<a name="l02117"></a>02117 
<a name="l02118"></a><a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">02118</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(pfc)
<a name="l02119"></a>02119       use <span class="keywordflow">pumamod</span>
<a name="l02120"></a>02120       dimension pfc(2,NLON/2,NLPP)
<a name="l02121"></a>02121 
<a name="l02122"></a>02122       <span class="keyword">do</span> jlat = 1 , NLPP
<a name="l02123"></a>02123          pfc(1,1:NTP1,jlat) = pfc(1,1:NTP1,jlat) * nselzw(:)
<a name="l02124"></a>02124          pfc(2,1:NTP1,jlat) = pfc(2,1:NTP1,jlat) * nselzw(:)
<a name="l02125"></a>02125       <span class="keyword">enddo</span>
<a name="l02126"></a>02126 
<a name="l02127"></a>02127       return
<a name="l02128"></a>02128 <span class="keyword">      end</span>
<a name="l02129"></a>02129       
<a name="l02130"></a>02130 
<a name="l02131"></a>02131 <span class="comment">!     ================================</span>
<a name="l02132"></a>02132 <span class="comment">!     SUBROUTINE FILTER_SPECTRAL_MODES</span>
<a name="l02133"></a>02133 <span class="comment">!     ================================</span>
<a name="l02134"></a>02134 
<a name="l02135"></a><a class="code" href="puma_8f90.html#a9a1e7493444984ad2c2161609dbb6e69">02135</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9a1e7493444984ad2c2161609dbb6e69">filter_spectral_modes</a>
<a name="l02136"></a>02136       use <span class="keywordflow">pumamod</span>
<a name="l02137"></a>02137 
<a name="l02138"></a>02138       j =  0
<a name="l02139"></a>02139       k = -1
<a name="l02140"></a>02140       <span class="keyword">do</span> m = 0 , NTRU
<a name="l02141"></a>02141          <span class="keyword">do</span> n = m , NTRU
<a name="l02142"></a>02142             k = k + 2
<a name="l02143"></a>02143             j = j + 1
<a name="l02144"></a>02144             <span class="keyword">if</span> (nselsp(j) == 0) <span class="keyword">then</span>
<a name="l02145"></a>02145                spp(k:k+1  ) = 0.0
<a name="l02146"></a>02146                sdp(k:k+1,:) = 0.0
<a name="l02147"></a>02147                stp(k:k+1,:) = 0.0
<a name="l02148"></a>02148                spt(k:k+1  ) = 0.0
<a name="l02149"></a>02149                sdt(k:k+1,:) = 0.0
<a name="l02150"></a>02150                stt(k:k+1,:) = 0.0
<a name="l02151"></a>02151                spm(k:k+1  ) = 0.0
<a name="l02152"></a>02152                sdm(k:k+1,:) = 0.0
<a name="l02153"></a>02153                stm(k:k+1,:) = 0.0
<a name="l02154"></a>02154               srp1(k:k+1,:) = 0.0
<a name="l02155"></a>02155               srp2(k:k+1,:) = 0.0
<a name="l02156"></a>02156                <span class="keyword">if</span> (n &lt; NTRU) <span class="keyword">then</span>
<a name="l02157"></a>02157                   szp(k+2:k+3,:) = 0.0
<a name="l02158"></a>02158                   szt(k+2:k+3,:) = 0.0
<a name="l02159"></a>02159                   szm(k+2:k+3,:) = 0.0
<a name="l02160"></a>02160                <span class="keyword">endif</span>
<a name="l02161"></a>02161             <span class="keyword">endif</span>
<a name="l02162"></a>02162          <span class="keyword">enddo</span>
<a name="l02163"></a>02163       <span class="keyword">enddo</span>
<a name="l02164"></a>02164 
<a name="l02165"></a>02165       return
<a name="l02166"></a>02166 <span class="keyword">      end</span>
<a name="l02167"></a>02167       
<a name="l02168"></a>02168 
<a name="l02169"></a>02169 <span class="comment">!     ================</span>
<a name="l02170"></a>02170 <span class="comment">!     SUBROUTINE NOISE</span>
<a name="l02171"></a>02171 <span class="comment">!     ================</span>
<a name="l02172"></a>02172 
<a name="l02173"></a><a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">02173</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kickval)
<a name="l02174"></a>02174       use <span class="keywordflow">pumamod</span>
<a name="l02175"></a>02175 
<a name="l02176"></a>02176 <span class="comment">!     kickval = -1 : read ln(ps) from puma_sp_init</span>
<a name="l02177"></a>02177 <span class="comment">!     kickval =  0 : model runs zonally symmetric with no eddies</span>
<a name="l02178"></a>02178 <span class="comment">!     kickval =  1 : add white noise to ln(Ps) asymmetric hemispheres</span>
<a name="l02179"></a>02179 <span class="comment">!     kickval =  2 : add white noise to ln(Ps) symmetric to the equator</span>
<a name="l02180"></a>02180 <span class="comment">!     kickval =  3 : force mode(1,2) of ln(Ps) allowing reproducable runs</span>
<a name="l02181"></a>02181 <span class="comment">!     kickval =  4 : add white noise to symmetric zonal wavenumbers 7 of ln(Ps)</span>
<a name="l02182"></a>02182 
<a name="l02183"></a>02183       <span class="keywordtype">integer</span> :: kickval
<a name="l02184"></a>02184       <span class="keywordtype">integer</span> :: jsp, jsp1, jn, jm
<a name="l02185"></a>02185       <span class="keywordtype">integer</span> :: jr, ji, ins
<a name="l02186"></a>02186       <span class="keywordtype">real</span>    :: zr, zi, zscale, zrand
<a name="l02187"></a>02187 
<a name="l02188"></a>02188       zscale = 0.000001         <span class="comment">! amplitude of noise</span>
<a name="l02189"></a>02189       zr     = 0.01             <span class="comment">! kickval=3 value for mode(1,2) real</span>
<a name="l02190"></a>02190       zi     = 0.005            <span class="comment">! kickval=3 value for mode(1,2) imag</span>
<a name="l02191"></a>02191 
<a name="l02192"></a>02192       <span class="keyword">select</span> <span class="keyword">case</span> (kickval)
<a name="l02193"></a>02193       <span class="keyword">case</span> (-1)
<a name="l02194"></a>02194          <span class="keyword">open</span>(71, file=puma_sp_init,form=<span class="stringliteral">&#39;unformatted&#39;</span>,iostat=iostat)
<a name="l02195"></a>02195          <span class="keyword">if</span> (iostat /= 0) <span class="keyword">then</span>
<a name="l02196"></a>02196             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39; *** kick=-1: needs file &lt;&#39;</span>,trim(puma_sp_init),<span class="stringliteral">&#39;&gt; ***&#39;</span>
<a name="l02197"></a>02197             stop
<a name="l02198"></a>02198          <span class="keyword">endif</span>
<a name="l02199"></a>02199          <span class="keyword">read</span>(71,iostat=iostat) sp(:)
<a name="l02200"></a>02200          <span class="keyword">if</span> (iostat /= 0) <span class="keyword">then</span>
<a name="l02201"></a>02201             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39; *** error reading file &lt;&#39;</span>,trim(puma_sp_init),<span class="stringliteral">&#39;&gt; ***&#39;</span>
<a name="l02202"></a>02202             stop
<a name="l02203"></a>02203          <span class="keyword">endif</span>
<a name="l02204"></a>02204          <span class="keyword">close</span>(71)
<a name="l02205"></a>02205          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;initial ln(ps) field read from &lt;&#39;</span>,trim(puma_sp_init),<span class="stringliteral">&#39;&gt;&#39;</span>
<a name="l02206"></a>02206          return
<a name="l02207"></a>02207       <span class="keyword">case</span> (0)                  <span class="comment">! do nothing</span>
<a name="l02208"></a>02208       <span class="keyword">case</span> (1)
<a name="l02209"></a>02209          jsp1=2*NTP1+1
<a name="l02210"></a>02210          <span class="keyword">do</span> jsp=jsp1,NRSP
<a name="l02211"></a>02211             call random_number(zrand)
<a name="l02212"></a>02212             <span class="keyword">if</span> (mrpid &gt; 0) zrand = zrand + mrpid * 0.01
<a name="l02213"></a>02213             sp(jsp)=sp(jsp)+zscale*(zrand-0.5)
<a name="l02214"></a>02214          <span class="keyword">enddo</span>
<a name="l02215"></a>02215          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;white noise added&#39;</span>
<a name="l02216"></a>02216       <span class="keyword">case</span> (2)
<a name="l02217"></a>02217          jr=2*NTP1-1
<a name="l02218"></a>02218          <span class="keyword">do</span> jm=1,NTRU
<a name="l02219"></a>02219             <span class="keyword">do</span> jn=jm,NTRU
<a name="l02220"></a>02220                jr=jr+2
<a name="l02221"></a>02221                ji=jr+1
<a name="l02222"></a>02222                <span class="keyword">if</span> (mod(jn+jm,2) == 0) <span class="keyword">then</span>
<a name="l02223"></a>02223                   call random_number(zrand)
<a name="l02224"></a>02224                   <span class="keyword">if</span> (mrpid &gt; 0) zrand = zrand + mrpid * 0.01
<a name="l02225"></a>02225                   sp(jr)=sp(jr)+zscale*(zrand-0.5)
<a name="l02226"></a>02226                   sp(ji)=sp(ji)+zscale*(zrand-0.5)
<a name="l02227"></a>02227                <span class="keyword">endif</span>
<a name="l02228"></a>02228             <span class="keyword">enddo</span>
<a name="l02229"></a>02229          <span class="keyword">enddo</span>
<a name="l02230"></a>02230          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;symmetric white noise added&#39;</span>
<a name="l02231"></a>02231       <span class="keyword">case</span> (3)
<a name="l02232"></a>02232          sp(2*NTP1+3) = sp(2*NTP1+3) + zr
<a name="l02233"></a>02233          sp(2*NTP1+4) = sp(2*NTP1+4) + zi
<a name="l02234"></a>02234          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;mode(1,2) of ln(Ps) set to (&#39;</span>,sp(2*NTP1+3),<span class="stringliteral">&#39;,&#39;</span>,sp(2*NTP1+4),<span class="stringliteral">&#39;)&#39;</span>
<a name="l02235"></a>02235       <span class="keyword">case</span> (4)
<a name="l02236"></a>02236          jr=2*NTP1-1
<a name="l02237"></a>02237          <span class="keyword">do</span> jm=1,NTRU
<a name="l02238"></a>02238             <span class="keyword">do</span> jn=jm,NTRU
<a name="l02239"></a>02239                jr=jr+2
<a name="l02240"></a>02240                ji=jr+1
<a name="l02241"></a>02241                <span class="keyword">if</span> (mod(jn+jm,2) == 0 .and. jm == 7) <span class="keyword">then</span>
<a name="l02242"></a>02242                   call random_number(zrand)
<a name="l02243"></a>02243                   sp(jr)=sp(jr)+zscale*(zrand-0.5)
<a name="l02244"></a>02244                   sp(ji)=sp(ji)+zscale*(zrand-0.5)
<a name="l02245"></a>02245                <span class="keyword">endif</span>
<a name="l02246"></a>02246             <span class="keyword">enddo</span>
<a name="l02247"></a>02247          <span class="keyword">enddo</span>
<a name="l02248"></a>02248          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;symmetric zonal wavenumbers 7 of ln(Ps) perturbed&#39;</span>,   &amp;
<a name="l02249"></a>02249      &amp;        <span class="stringliteral">&#39;with white noise.&#39;</span>
<a name="l02250"></a>02250       <span class="keyword">case</span> default
<a name="l02251"></a>02251          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Value &#39;</span>,kickval  ,<span class="stringliteral">&#39; for kickval not implemented.&#39;</span>
<a name="l02252"></a>02252          stop
<a name="l02253"></a>02253       <span class="keyword">end select</span>
<a name="l02254"></a>02254 
<a name="l02255"></a>02255       <span class="keyword">if</span> (nwspini == 1) <span class="keyword">then</span>
<a name="l02256"></a>02256          <span class="keyword">open</span>(71, file=puma_sp_init, form=<span class="stringliteral">&#39;unformatted&#39;</span>)
<a name="l02257"></a>02257          <span class="keyword">write</span>(71) sp(:)
<a name="l02258"></a>02258          <span class="keyword">close</span>(71)
<a name="l02259"></a>02259       <span class="keyword">endif</span>
<a name="l02260"></a>02260 
<a name="l02261"></a>02261       return
<a name="l02262"></a>02262 <span class="keyword">      end</span>
<a name="l02263"></a>02263 
<a name="l02264"></a>02264 <span class="comment">!     ================</span>
<a name="l02265"></a>02265 <span class="comment">!     SUBROUTINE SETZT</span>
<a name="l02266"></a>02266 <span class="comment">!     ================</span>
<a name="l02267"></a><a class="code" href="puma_8f90.html#a4a662c6d6619fc6405eb110f62653dc0">02267</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a4a662c6d6619fc6405eb110f62653dc0">setzt</a>
<a name="l02268"></a>02268       use <span class="keywordflow">pumamod</span>
<a name="l02269"></a>02269 
<a name="l02270"></a>02270 <span class="comment">!     *************************************************************</span>
<a name="l02271"></a>02271 <span class="comment">!     * Set up the restoration temperature fields sr1 and sr2     *</span>
<a name="l02272"></a>02272 <span class="comment">!     * for aqua planet conditions.                               *</span>
<a name="l02273"></a>02273 <span class="comment">!     * The temperature at sigma = 1 is &lt;tgr&gt;, entered in kelvin. *</span>
<a name="l02274"></a>02274 <span class="comment">!     * The lapse rate of ALR K/m is assumed under the tropopause *</span>
<a name="l02275"></a>02275 <span class="comment">!     * and zero above. The tropopause is defined by &lt;dtrop&gt;.     *</span>
<a name="l02276"></a>02276 <span class="comment">!     * The smoothing ot the tropopause depends on &lt;dttrp&gt;.       *</span>
<a name="l02277"></a>02277 <span class="comment">!     ************************************************************* </span>
<a name="l02278"></a>02278 
<a name="l02279"></a>02279       dimension ztrs(NLEV)  <span class="comment">! Mean profile</span>
<a name="l02280"></a>02280       dimension zfac(NLEV)
<a name="l02281"></a>02281 
<a name="l02282"></a>02282       sr1(:,:) = 0.0 <span class="comment">! NESP,NLEV</span>
<a name="l02283"></a>02283       sr2(:,:) = 0.0 <span class="comment">! NESP,NLEV</span>
<a name="l02284"></a>02284 
<a name="l02285"></a>02285 <span class="comment">!     Temperatures in [K]</span>
<a name="l02286"></a>02286 
<a name="l02287"></a>02287       zsigprev = 1.0  <span class="comment">! sigma value</span>
<a name="l02288"></a>02288       ztprev   = tgr  <span class="comment">! Temperature [K]</span>
<a name="l02289"></a>02289       zzprev   = 0.0  <span class="comment">! Height      [m]</span>
<a name="l02290"></a>02290 
<a name="l02291"></a>02291       <span class="keyword">do</span> jlev = NLEV , 1 , -1   <span class="comment">! from bottom to top of atmosphere</span>
<a name="l02292"></a>02292         zzp=zzprev+(gascon*ztprev/ga)*log(zsigprev/sigma(jlev))
<a name="l02293"></a>02293         ztp=tgr-dtrop*alr <span class="comment">! temperature at tropopause</span>
<a name="l02294"></a>02294         ztp=ztp+sqrt((.5*alr*(zzp-dtrop))**2+dttrp**2)
<a name="l02295"></a>02295         ztp=ztp-.5*alr*(zzp-dtrop)
<a name="l02296"></a>02296         ztpm=.5*(ztprev+ztp)
<a name="l02297"></a>02297         zzpp=zzprev+(gascon*ztpm/ga)*log(zsigprev/sigma(jlev))
<a name="l02298"></a>02298         ztpp=tgr-dtrop*alr
<a name="l02299"></a>02299         ztpp=ztpp+sqrt((.5*alr*(zzpp-dtrop))**2+dttrp**2)
<a name="l02300"></a>02300         ztpp=ztpp-.5*alr*(zzpp-dtrop)
<a name="l02301"></a>02301         ztrs(jlev)=ztpp
<a name="l02302"></a>02302         zzprev=zzprev+(.5*(ztpp+ztprev)*gascon/ga)*log(zsigprev/sigma(jlev))
<a name="l02303"></a>02303         ztprev=ztpp
<a name="l02304"></a>02304         zsigprev=sigma(jlev)
<a name="l02305"></a>02305       <span class="keyword">enddo</span>
<a name="l02306"></a>02306 
<a name="l02307"></a>02307       <span class="keyword">do</span> jlev=1,NLEV
<a name="l02308"></a>02308          ztrs(jlev)=ztrs(jlev)/ct
<a name="l02309"></a>02309       <span class="keyword">enddo</span>
<a name="l02310"></a>02310 
<a name="l02311"></a>02311 <span class="comment">!******************************************************************</span>
<a name="l02312"></a>02312 <span class="comment">! loop to set array zfac - this controls temperature gradients as a</span>
<a name="l02313"></a>02313 <span class="comment">! function of sigma in tres. it is a sine wave from one at</span>
<a name="l02314"></a>02314 <span class="comment">! sigma = 1 to zero at stps (sigma at the tropopause) .</span>
<a name="l02315"></a>02315 <span class="comment">!******************************************************************</span>
<a name="l02316"></a>02316 <span class="comment">! first find sigma at dtrop</span>
<a name="l02317"></a>02317 <span class="comment">!</span>
<a name="l02318"></a>02318       zttrop=tgr-dtrop*alr
<a name="l02319"></a>02319       ztps=(zttrop/tgr)**(ga/(alr*gascon))
<a name="l02320"></a>02320 <span class="comment">!</span>
<a name="l02321"></a>02321 <span class="comment">! now the latitudinal variation in tres is set up ( this being in terms</span>
<a name="l02322"></a>02322 <span class="comment">! of a deviation from t0 which is usually constant with height)</span>
<a name="l02323"></a>02323 <span class="comment">!</span>
<a name="l02324"></a>02324       zsqrt2  = sqrt(2.0)
<a name="l02325"></a>02325       zsqrt04 = sqrt(0.4)
<a name="l02326"></a>02326       zsqrt6  = sqrt(6.0)
<a name="l02327"></a>02327       <span class="keyword">do</span> 2100 jlev=1,NLEV
<a name="l02328"></a>02328         zfac(jlev)=sin(0.5*PI*(sigma(jlev)-ztps)/(1.-ztps))
<a name="l02329"></a>02329         <span class="keyword">if</span> (zfac(jlev).lt.0.0) zfac(jlev)=0.0
<a name="l02330"></a>02330         sr1(1,jlev)=zsqrt2*(ztrs(jlev)-t0(jlev))
<a name="l02331"></a>02331         sr2(3,jlev)=(1./zsqrt6)*dtns*zfac(jlev)
<a name="l02332"></a>02332         sr1(5,jlev)=-2./3.*zsqrt04*dtep*zfac(jlev)
<a name="l02333"></a>02333  2100 continue
<a name="l02334"></a>02334       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;**************************************************&#39;</span>
<a name="l02335"></a>02335       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;* Restoration Temperature set up for aqua planet *&#39;</span>
<a name="l02336"></a>02336       <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;**************************************************&#39;</span>
<a name="l02337"></a>02337       return
<a name="l02338"></a>02338 <span class="keyword">      end</span>
<a name="l02339"></a>02339 
<a name="l02340"></a>02340 <span class="comment">!     =======================</span>
<a name="l02341"></a>02341 <span class="comment">!     SUBROUTINE PRINTPROFILE</span>
<a name="l02342"></a>02342 <span class="comment">!     =======================</span>
<a name="l02343"></a>02343 
<a name="l02344"></a><a class="code" href="puma_8f90.html#aa92d6879772b364173e13521d835895e">02344</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">printprofile</a>
<a name="l02345"></a>02345       use <span class="keywordflow">pumamod</span>
<a name="l02346"></a>02346 
<a name="l02347"></a>02347 <span class="comment">!     **********************************</span>
<a name="l02348"></a>02348 <span class="comment">!     * write out vertical information *</span>
<a name="l02349"></a>02349 <span class="comment">!     **********************************</span>
<a name="l02350"></a>02350 
<a name="l02351"></a>02351       <span class="keyword">write</span>(nud,9001)
<a name="l02352"></a>02352       <span class="keyword">write</span>(nud,9002)
<a name="l02353"></a>02353       <span class="keyword">write</span>(nud,9003)
<a name="l02354"></a>02354       <span class="keyword">write</span>(nud,9002)
<a name="l02355"></a>02355 
<a name="l02356"></a>02356       <span class="keyword">do</span> jlev=1,NLEV
<a name="l02357"></a>02357          zt = (sr1(1,jlev)/sqrt(2.0) + t0(jlev)) * ct
<a name="l02358"></a>02358          <span class="keyword">if</span> (tauf(jlev) &gt; 0.1) <span class="keyword">then</span>
<a name="l02359"></a>02359             <span class="keyword">write</span>(nud,9004) jlev,sigma(jlev),zt,taur(jlev),tauf(jlev)
<a name="l02360"></a>02360          <span class="keyword">else</span>
<a name="l02361"></a>02361             <span class="keyword">write</span>(nud,9005) jlev,sigma(jlev),zt,taur(jlev)
<a name="l02362"></a>02362          <span class="keyword">endif</span>
<a name="l02363"></a>02363       <span class="keyword">enddo</span>
<a name="l02364"></a>02364 
<a name="l02365"></a>02365       <span class="keyword">write</span>(nud,9002)
<a name="l02366"></a>02366       <span class="keyword">write</span>(nud,9001)
<a name="l02367"></a>02367       return
<a name="l02368"></a>02368  9001 format(/)
<a name="l02369"></a>02369  9002 format(36(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l02370"></a>02370  9003 format(<span class="stringliteral">&#39;* Lv *    Sigma Restor-T tauR tauF *&#39;</span>)
<a name="l02371"></a>02371  9004 format(<span class="stringliteral">&#39;*&#39;</span>,i3,<span class="stringliteral">&#39; * &#39;</span>,f8.3,f9.3,2f5.1,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02372"></a>02372  9005 format(<span class="stringliteral">&#39;*&#39;</span>,i3,<span class="stringliteral">&#39; * &#39;</span>,f8.3,f9.3,f5.1,<span class="stringliteral">&#39;    - *&#39;</span>)
<a name="l02373"></a>02373 <span class="keyword">      end</span>
<a name="l02374"></a>02374 
<a name="l02375"></a>02375 
<a name="l02376"></a>02376 <span class="comment">!     ====================</span>
<a name="l02377"></a>02377 <span class="comment">!     SUBROUTINE READ_SURF</span>
<a name="l02378"></a>02378 <span class="comment">!     ====================</span>
<a name="l02379"></a>02379 
<a name="l02380"></a><a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">02380</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(kcode,psp,klev,kread)
<a name="l02381"></a>02381       use <span class="keywordflow">pumamod</span>
<a name="l02382"></a>02382 
<a name="l02383"></a>02383       <span class="keywordtype">logical</span> :: lexist
<a name="l02384"></a>02384       <span class="keywordtype">integer</span> :: kread
<a name="l02385"></a>02385       <span class="keywordtype">integer</span> :: ihead(8)
<a name="l02386"></a>02386       <span class="keywordtype">character(len=256)</span> :: yfilename
<a name="l02387"></a>02387       <span class="keywordtype">real</span> :: psp(NESP,klev)
<a name="l02388"></a>02388       <span class="keywordtype">real</span> :: zgp(NUGP,klev)
<a name="l02389"></a>02389       <span class="keywordtype">real</span> :: zpp(NHOR,klev)
<a name="l02390"></a>02390 
<a name="l02391"></a>02391       kread = 0
<a name="l02392"></a>02392       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02393"></a>02393          <span class="keyword">if</span> (NLAT &lt; 1000) <span class="keyword">then</span>
<a name="l02394"></a>02394          <span class="keyword">write</span>(yfilename,<span class="stringliteral">&#39;(&quot;N&quot;,I3.3,&quot;_surf_&quot;,I4.4,&quot;.sra&quot;)&#39;</span>) NLAT,kcode
<a name="l02395"></a>02395          <span class="keyword">else</span>
<a name="l02396"></a>02396          <span class="keyword">write</span>(yfilename,<span class="stringliteral">&#39;(&quot;N&quot;,I4.4,&quot;_surf_&quot;,I4.4,&quot;.sra&quot;)&#39;</span>) NLAT,kcode
<a name="l02397"></a>02397          <span class="keyword">endif</span>
<a name="l02398"></a>02398          <span class="keyword">inquire</span>(file=yfilename,exist=lexist)
<a name="l02399"></a>02399       <span class="keyword">endif</span>
<a name="l02400"></a>02400       call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lexist)
<a name="l02401"></a>02401       <span class="keyword">if</span> (.not. lexist) return
<a name="l02402"></a>02402 
<a name="l02403"></a>02403       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02404"></a>02404          <span class="keyword">open</span>(65,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l02405"></a>02405          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Reading file &lt;&#39;</span>,trim(yfilename),<span class="stringliteral">&#39;&gt;&#39;</span>
<a name="l02406"></a>02406          <span class="keyword">do</span> jlev = 1 , klev
<a name="l02407"></a>02407             <span class="keyword">read</span> (65,*) ihead(:)
<a name="l02408"></a>02408             <span class="keyword">read</span> (65,*) zgp(:,jlev)
<a name="l02409"></a>02409          <span class="keyword">enddo</span>
<a name="l02410"></a>02410          <span class="keyword">close</span>(65)
<a name="l02411"></a>02411          <span class="keyword">if</span> (kcode == 134) <span class="keyword">then</span>
<a name="l02412"></a>02412             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&quot;Converting Ps to LnPs&quot;</span>
<a name="l02413"></a>02413             zscale   = log(100.0) - log(psurf) <span class="comment">! Input [hPa] / PSURF [Pa]</span>
<a name="l02414"></a>02414             zgp(:,:) = log(zgp(:,:)) + zscale
<a name="l02415"></a>02415          <span class="keyword">endif</span>
<a name="l02416"></a>02416          call <a class="code" href="legsym_8f90.html#a4a468562c0549b4ca3ec6ea34f87545a">reg2alt</a>(zgp,klev)
<a name="l02417"></a>02417       <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span>
<a name="l02418"></a>02418       call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,zpp,klev)
<a name="l02419"></a>02419       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zpp,NLON,NLPP*klev)
<a name="l02420"></a>02420       <span class="keyword">do</span> jlev = 1 , klev
<a name="l02421"></a>02421          call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zpp(1,jlev),psp(1,jlev))
<a name="l02422"></a>02422       <span class="keyword">enddo</span>
<a name="l02423"></a>02423       call <a class="code" href="mpimod_8f90.html#af894efd9525c935f22415e017dcbc482">mpsum</a>(psp,klev)
<a name="l02424"></a>02424       kread = 1
<a name="l02425"></a>02425       return
<a name="l02426"></a>02426 <span class="keyword">      end subroutine read_surf</span>
<a name="l02427"></a>02427 
<a name="l02428"></a>02428 
<a name="l02429"></a>02429 
<a name="l02430"></a>02430 <span class="comment">!     =====================</span>
<a name="l02431"></a>02431 <span class="comment">!     SUBROUTINE READ_VARGP</span>
<a name="l02432"></a>02432 <span class="comment">!     =====================</span>
<a name="l02433"></a>02433 
<a name="l02434"></a><a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">02434</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(kcode,klev,kread)
<a name="l02435"></a>02435       use <span class="keywordflow">pumamod</span>
<a name="l02436"></a>02436     
<a name="l02437"></a>02437       <span class="keywordtype">logical</span> :: lexist
<a name="l02438"></a>02438       <span class="keywordtype">integer</span> :: ihead(8)
<a name="l02439"></a>02439       <span class="keywordtype">character(len=256)</span> :: yfilename
<a name="l02440"></a>02440       <span class="keywordtype">real</span> :: zgp(NUGP,klev)
<a name="l02441"></a>02441 
<a name="l02442"></a>02442       kread = 0
<a name="l02443"></a>02443       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02444"></a>02444          <span class="keyword">if</span> (NLAT &lt; 1000) <span class="keyword">then</span>
<a name="l02445"></a>02445          <span class="keyword">write</span>(yfilename,<span class="stringliteral">&#39;(&quot;N&quot;,I3.3,&quot;_surf_&quot;,I4.4,&quot;.sra&quot;)&#39;</span>) NLAT,kcode
<a name="l02446"></a>02446          <span class="keyword">else</span>
<a name="l02447"></a>02447          <span class="keyword">write</span>(yfilename,<span class="stringliteral">&#39;(&quot;N&quot;,I4.4,&quot;_surf_&quot;,I4.4,&quot;.sra&quot;)&#39;</span>) NLAT,kcode
<a name="l02448"></a>02448          <span class="keyword">endif</span>
<a name="l02449"></a>02449          <span class="keyword">inquire</span>(file=yfilename,exist=lexist)
<a name="l02450"></a>02450       <span class="keyword">endif</span>
<a name="l02451"></a>02451       call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lexist)
<a name="l02452"></a>02452       <span class="keyword">if</span> (.not. lexist) <span class="keyword">then</span>
<a name="l02453"></a>02453          <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02454"></a>02454             <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;File &lt;&#39;</span>,trim(yfilename),<span class="stringliteral">&#39;&gt; not found&#39;</span>
<a name="l02455"></a>02455          <span class="keyword">endif</span>
<a name="l02456"></a>02456          return
<a name="l02457"></a>02457       <span class="keyword">endif</span>
<a name="l02458"></a>02458 
<a name="l02459"></a>02459       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02460"></a>02460          <span class="keyword">open</span>(65,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l02461"></a>02461          <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Reading file &lt;&#39;</span>,trim(yfilename),<span class="stringliteral">&#39;&gt;&#39;</span>
<a name="l02462"></a>02462          <span class="keyword">do</span> jlev = 1 , klev
<a name="l02463"></a>02463             <span class="keyword">read</span> (65,*) ihead(:)
<a name="l02464"></a>02464             <span class="keyword">read</span> (65,*) zgp(:,jlev)
<a name="l02465"></a>02465          <span class="keyword">enddo</span>
<a name="l02466"></a>02466          <span class="keyword">close</span>(65)
<a name="l02467"></a>02467          call <a class="code" href="legsym_8f90.html#a4a468562c0549b4ca3ec6ea34f87545a">reg2alt</a>(zgp,klev)
<a name="l02468"></a>02468       <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span>
<a name="l02469"></a>02469 
<a name="l02470"></a>02470       <span class="keyword">select</span> <span class="keyword">case</span>(kcode)
<a name="l02471"></a>02471          <span class="keyword">case</span>(121)
<a name="l02472"></a>02472             <span class="comment">!--- non-dimensionalize and shift const radiative rest. temp.</span>
<a name="l02473"></a>02473             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02474"></a>02474                zgp(:,:) = zgp(:,:)/ct
<a name="l02475"></a>02475                <span class="keyword">do</span> jhor = 1,nugp
<a name="l02476"></a>02476                   zgp(jhor,:) = zgp(jhor,:) - t0(:)
<a name="l02477"></a>02477                <span class="keyword">enddo</span>
<a name="l02478"></a>02478             <span class="keyword">endif</span>
<a name="l02479"></a>02479             <span class="keyword">allocate</span>(gr1(nhor,klev))
<a name="l02480"></a>02480             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02481"></a>02481                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Field gr1 allocated&#39;</span>
<a name="l02482"></a>02482             <span class="keyword">endif</span>
<a name="l02483"></a>02483             call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr1,klev)
<a name="l02484"></a>02484          <span class="keyword">case</span>(122)
<a name="l02485"></a>02485             <span class="comment">!--- non-dimensionalize variable. radiative rest. temp.</span>
<a name="l02486"></a>02486             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02487"></a>02487                zgp(:,:) = zgp(:,:)/ct
<a name="l02488"></a>02488             <span class="keyword">endif</span>
<a name="l02489"></a>02489             <span class="keyword">allocate</span>(gr2(nhor,klev))
<a name="l02490"></a>02490             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02491"></a>02491                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Field gr2 allocated&#39;</span>
<a name="l02492"></a>02492             <span class="keyword">endif</span>
<a name="l02493"></a>02493             call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr2,klev)
<a name="l02494"></a>02494          <span class="keyword">case</span>(123)
<a name="l02495"></a>02495             <span class="comment">!--- non-dimensionalize radiative relaxation time scale</span>
<a name="l02496"></a>02496             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02497"></a>02497                zgp(:,:) = zgp(:,:)/ww
<a name="l02498"></a>02498             <span class="keyword">endif</span>
<a name="l02499"></a>02499             <span class="keyword">allocate</span>(gtdamp(nhor,klev))
<a name="l02500"></a>02500             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02501"></a>02501                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Field gtdamp allocated&#39;</span>
<a name="l02502"></a>02502             <span class="keyword">endif</span>
<a name="l02503"></a>02503             call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gtdamp,klev)
<a name="l02504"></a>02504          <span class="keyword">case</span>(124)
<a name="l02505"></a>02505             <span class="comment">!--- non-dimensionalize and shift const. convective rest. temp.</span>
<a name="l02506"></a>02506             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02507"></a>02507                zgp(:,:) = zgp(:,:)/ct
<a name="l02508"></a>02508                <span class="keyword">do</span> jhor = 1,nugp
<a name="l02509"></a>02509                   zgp(jhor,:) = zgp(jhor,:) - t0(:)
<a name="l02510"></a>02510                <span class="keyword">enddo</span>
<a name="l02511"></a>02511             <span class="keyword">endif</span>
<a name="l02512"></a>02512             <span class="keyword">allocate</span>(gr1c(nhor,klev))
<a name="l02513"></a>02513             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02514"></a>02514                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Field gr1c allocated&#39;</span>
<a name="l02515"></a>02515             <span class="keyword">endif</span>
<a name="l02516"></a>02516             call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr1c,klev)
<a name="l02517"></a>02517          <span class="keyword">case</span>(125)
<a name="l02518"></a>02518             <span class="comment">!--- non-dimensionalize variable. convective rest. temp.</span>
<a name="l02519"></a>02519             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02520"></a>02520                zgp(:,:) = zgp(:,:)/ct
<a name="l02521"></a>02521             <span class="keyword">endif</span>
<a name="l02522"></a>02522             <span class="keyword">allocate</span>(gr2c(nhor,klev))
<a name="l02523"></a>02523             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02524"></a>02524                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Field gr2c allocated&#39;</span>
<a name="l02525"></a>02525             <span class="keyword">endif</span>
<a name="l02526"></a>02526             call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr2c,klev)
<a name="l02527"></a>02527          <span class="keyword">case</span>(126)
<a name="l02528"></a>02528             <span class="comment">!--- non-dimensionalize convective relaxation time scale</span>
<a name="l02529"></a>02529             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02530"></a>02530                zgp(:,:) = zgp(:,:)/ww
<a name="l02531"></a>02531             <span class="keyword">endif</span>
<a name="l02532"></a>02532             <span class="keyword">allocate</span>(gtdampc(nhor,klev))
<a name="l02533"></a>02533             <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l02534"></a>02534                <span class="keyword">write</span>(nud,*) <span class="stringliteral">&#39;Field gtdampc allocated&#39;</span>
<a name="l02535"></a>02535             <span class="keyword">endif</span>
<a name="l02536"></a>02536             call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gtdampc,klev)
<a name="l02537"></a>02537       <span class="keyword">end select</span>
<a name="l02538"></a>02538       kread = 1
<a name="l02539"></a>02539       return
<a name="l02540"></a>02540 <span class="keyword">      end subroutine read_vargp</span>
<a name="l02541"></a>02541 
<a name="l02542"></a>02542 <span class="comment">!     ===============</span>
<a name="l02543"></a>02543 <span class="comment">!     SUBROUTINE DIAG</span>
<a name="l02544"></a>02544 <span class="comment">!     ===============</span>
<a name="l02545"></a>02545 
<a name="l02546"></a><a class="code" href="puma_8f90.html#ad0981694b4fc7644f20d9ad785deba27">02546</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ad0981694b4fc7644f20d9ad785deba27">diag</a>
<a name="l02547"></a>02547       use <span class="keywordflow">pumamod</span>
<a name="l02548"></a>02548       <span class="keyword">if</span> (noutput &gt; 0 .and. mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) == 0) <span class="keyword">then</span>
<a name="l02549"></a>02549          <span class="keyword">if</span> (ncoeff &gt; 0) call <a class="code" href="puma_8f90.html#a901150c868c1f2d65744ec49df0c24ed">prisp</a>
<a name="l02550"></a>02550          call <a class="code" href="puma_8f90.html#a8e59ae6d7b5a22b0e46c56187cdd62cf">xsect</a>
<a name="l02551"></a>02551       <span class="keyword">endif</span>
<a name="l02552"></a>02552       call <a class="code" href="puma_8f90.html#a9617b01410b9d0a76ca6ceb1b333bb96">energy</a>
<a name="l02553"></a>02553       return
<a name="l02554"></a>02554 <span class="keyword">      end</span>
<a name="l02555"></a>02555 
<a name="l02556"></a>02556 <span class="comment">!     ================</span>
<a name="l02557"></a>02557 <span class="comment">!     SUBROUTINE PRISP</span>
<a name="l02558"></a>02558 <span class="comment">!     ================</span>
<a name="l02559"></a>02559 
<a name="l02560"></a><a class="code" href="puma_8f90.html#a901150c868c1f2d65744ec49df0c24ed">02560</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a901150c868c1f2d65744ec49df0c24ed">prisp</a>
<a name="l02561"></a>02561       use <span class="keywordflow">pumamod</span>
<a name="l02562"></a>02562 
<a name="l02563"></a>02563       <span class="keywordtype">character(30)</span> :: title
<a name="l02564"></a>02564 
<a name="l02565"></a>02565       scale = 100.0
<a name="l02566"></a>02566       title = <span class="stringliteral">&#39;Vorticity [10-2]&#39;</span>
<a name="l02567"></a>02567       <span class="keyword">do</span> 100 jlev=1,NLEV
<a name="l02568"></a>02568          <span class="keyword">if</span> (ndil(jlev).ne.0) call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(sz(1,jlev),jlev,title,scale)
<a name="l02569"></a>02569   100 continue
<a name="l02570"></a>02570 
<a name="l02571"></a>02571       title = <span class="stringliteral">&#39;Divergence [10-2]&#39;</span>
<a name="l02572"></a>02572       <span class="keyword">do</span> 200 jlev=1,NLEV
<a name="l02573"></a>02573          <span class="keyword">if</span> (ndil(jlev).ne.0) call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(sd(1,jlev),jlev,title,scale)
<a name="l02574"></a>02574   200 continue
<a name="l02575"></a>02575 
<a name="l02576"></a>02576       scale = 1000.0
<a name="l02577"></a>02577       title = <span class="stringliteral">&#39;Temperature [10-3]&#39;</span>
<a name="l02578"></a>02578       <span class="keyword">do</span> 300 jlev=1,NLEV
<a name="l02579"></a>02579          <span class="keyword">if</span> (ndil(jlev).ne.0) call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(st(1,jlev),jlev,title,scale)
<a name="l02580"></a>02580   300 continue
<a name="l02581"></a>02581 
<a name="l02582"></a>02582       title = <span class="stringliteral">&#39;Pressure [10-3]&#39;</span>
<a name="l02583"></a>02583       call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(sp,0,title,scale)
<a name="l02584"></a>02584 
<a name="l02585"></a>02585       return
<a name="l02586"></a>02586 <span class="keyword">      end</span>
<a name="l02587"></a>02587 
<a name="l02588"></a>02588 <span class="comment">!     ====================</span>
<a name="l02589"></a>02589 <span class="comment">!     SUBROUTINE POWERSPEC</span>
<a name="l02590"></a>02590 <span class="comment">!     ====================</span>
<a name="l02591"></a>02591 
<a name="l02592"></a><a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">02592</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(pf,pspec)
<a name="l02593"></a>02593       use <span class="keywordflow">pumamod</span>
<a name="l02594"></a>02594       <span class="keywordtype">real</span> :: pf(2,NCSP)
<a name="l02595"></a>02595       <span class="keywordtype">real</span> :: pspec(NTP1)
<a name="l02596"></a>02596 
<a name="l02597"></a>02597       <span class="keyword">do</span> j = 1 , NTP1
<a name="l02598"></a>02598          pspec(j) = 0.5 * (pf(1,j) * pf(1,j) + pf(2,j) * pf(2,j))
<a name="l02599"></a>02599       <span class="keyword">enddo</span>
<a name="l02600"></a>02600 
<a name="l02601"></a>02601       j = NTP1 + 1
<a name="l02602"></a>02602       <span class="keyword">do</span> m = 2 , NTP1
<a name="l02603"></a>02603          <span class="keyword">do</span> l = m , NTP1
<a name="l02604"></a>02604             pspec(l) = pspec(l) + pf(1,j) * pf(1,j) + pf(2,j) * pf(2,j)
<a name="l02605"></a>02605             j = j + 1
<a name="l02606"></a>02606          <span class="keyword">enddo</span>
<a name="l02607"></a>02607       <span class="keyword">enddo</span>
<a name="l02608"></a>02608       return
<a name="l02609"></a>02609 <span class="keyword">      end</span>
<a name="l02610"></a>02610 
<a name="l02611"></a>02611 <span class="comment">!     =====================</span>
<a name="l02612"></a>02612 <span class="comment">!     SUBROUTINE POWERPRINT</span>
<a name="l02613"></a>02613 <span class="comment">!     =====================</span>
<a name="l02614"></a>02614 
<a name="l02615"></a><a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">02615</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(text,pspec)
<a name="l02616"></a>02616       use <span class="keywordflow">pumamod</span>
<a name="l02617"></a>02617       <span class="keywordtype">character(3)</span> :: text
<a name="l02618"></a>02618       <span class="keywordtype">real</span> :: pspec(NTP1)
<a name="l02619"></a>02619 
<a name="l02620"></a>02620       zmax = maxval(pspec(:))
<a name="l02621"></a>02621       <span class="keyword">if</span> (zmax &lt;= 1.0e-20) return
<a name="l02622"></a>02622       zsca = 10 ** (4 - int(log10(zmax)))
<a name="l02623"></a>02623       <span class="keyword">write</span>(nud,1000) text,(int(pspec(j)*zsca),j=2,13)
<a name="l02624"></a>02624       return
<a name="l02625"></a>02625  1000 format(<span class="stringliteral">&#39;* Power(&#39;</span>,a3,<span class="stringliteral">&#39;) &#39;</span>,i8,11i5,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02626"></a>02626 <span class="keyword">      end</span>
<a name="l02627"></a>02627 
<a name="l02628"></a>02628 
<a name="l02629"></a>02629 
<a name="l02630"></a>02630 
<a name="l02631"></a>02631 <span class="comment">!     ==============</span>
<a name="l02632"></a>02632 <span class="comment">!     FUNCTION RMSSP</span>
<a name="l02633"></a>02633 <span class="comment">!     ==============</span>
<a name="l02634"></a>02634 
<a name="l02635"></a><a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">02635</a>       <span class="keyword">function </span><a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(pf)
<a name="l02636"></a>02636       use <span class="keywordflow">pumamod</span>
<a name="l02637"></a>02637       <span class="keywordtype">real</span> pf(NESP,NLEV)
<a name="l02638"></a>02638 
<a name="l02639"></a>02639       zsum = 0.0
<a name="l02640"></a>02640       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l02641"></a>02641          zsum = zsum + dsigma(jlev)&amp;
<a name="l02642"></a>02642      &amp;        * (dot_product(pf(1:NZOM,jlev),pf(1:NZOM,jlev)) * 0.5&amp;
<a name="l02643"></a>02643      &amp;        +  dot_product(pf(NZOM+1:NRSP,jlev),pf(NZOM+1:NRSP,jlev)))
<a name="l02644"></a>02644       <span class="keyword">enddo</span>
<a name="l02645"></a>02645       <a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a> = zsum
<a name="l02646"></a>02646       return
<a name="l02647"></a>02647 <span class="keyword">      end</span>
<a name="l02648"></a>02648 
<a name="l02649"></a>02649 <span class="comment">!     =================</span>
<a name="l02650"></a>02650 <span class="comment">!     SUBROUTINE ENERGY</span>
<a name="l02651"></a>02651 <span class="comment">!     =================</span>
<a name="l02652"></a>02652 
<a name="l02653"></a><a class="code" href="puma_8f90.html#a9617b01410b9d0a76ca6ceb1b333bb96">02653</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9617b01410b9d0a76ca6ceb1b333bb96">energy</a>
<a name="l02654"></a>02654       use <span class="keywordflow">pumamod</span>
<a name="l02655"></a>02655 
<a name="l02656"></a>02656       parameter (idim=5) <span class="comment">! Number of scalars for GUI timeseries</span>
<a name="l02657"></a>02657 
<a name="l02658"></a>02658 <span class="comment">!     calculates various global diagnostic quantities</span>
<a name="l02659"></a>02659 <span class="comment">!     remove planetary vorticity so sz contains relative vorticity</span>
<a name="l02660"></a>02660 
<a name="l02661"></a>02661       <span class="keywordtype">real</span> :: spec(NTP1)
<a name="l02662"></a>02662       <span class="keywordtype">real (kind=4)</span> ziso(idim)
<a name="l02663"></a>02663 
<a name="l02664"></a>02664       sz(3,:) = sz(3,:) - plavor
<a name="l02665"></a>02665 
<a name="l02666"></a>02666 <span class="comment">!    ***********************************************</span>
<a name="l02667"></a>02667 <span class="comment">!     calculate means - zpsitot rms vorticity</span>
<a name="l02668"></a>02668 <span class="comment">!                       zchitot rms divergence</span>
<a name="l02669"></a>02669 <span class="comment">!                       ztmptot rms temperature</span>
<a name="l02670"></a>02670 <span class="comment">!                       ztotp  ie+pe potential energy</span>
<a name="l02671"></a>02671 <span class="comment">!                       zamsp mean surface pressure</span>
<a name="l02672"></a>02672 <span class="comment">!     ***********************************************</span>
<a name="l02673"></a>02673 
<a name="l02674"></a>02674       zsqrt2 = sqrt(2.0)
<a name="l02675"></a>02675       zamsp  = 1.0 + span(1) / zsqrt2
<a name="l02676"></a>02676       zst    = dot_product(dsigma(:),st(1,:)) / zsqrt2
<a name="l02677"></a>02677       ztout1 = dot_product(dsigma(:),t0(:))
<a name="l02678"></a>02678 
<a name="l02679"></a>02679       ztout2 = 0.0
<a name="l02680"></a>02680       zst2b  = 0.0
<a name="l02681"></a>02681       ztoti  = 0.0
<a name="l02682"></a>02682       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l02683"></a>02683          ztout2 = ztout2 + dsigma(jlev) * t0(jlev) * t0(jlev)
<a name="l02684"></a>02684          zst2b  = zst2b  + dsigma(jlev) * t0(jlev) * st(1,jlev)
<a name="l02685"></a>02685          ztoti  = ztoti + dsigma(jlev)&amp;
<a name="l02686"></a>02686      &amp;          * (dot_product(span(1:NZOM),st(1:NZOM,jlev)) * 0.5&amp;
<a name="l02687"></a>02687      &amp;          +  dot_product(span(NZOM+1:NRSP),st(NZOM+1:NRSP,jlev)))
<a name="l02688"></a>02688       <span class="keyword">enddo</span>
<a name="l02689"></a>02689 
<a name="l02690"></a>02690       ztotp = dot_product(span(1:NZOM),so(1:NZOM)) * 0.5&amp;
<a name="l02691"></a>02691      &amp;      + dot_product(span(NZOM+1:NRSP),so(NZOM+1:NRSP))&amp;
<a name="l02692"></a>02692      &amp;      + so(1)/zsqrt2 + (zamsp*ztout1+ztoti+zst) / akap
<a name="l02693"></a>02693 
<a name="l02694"></a>02694       zpsitot = sqrt(<a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(sz))
<a name="l02695"></a>02695       zchitot = sqrt(<a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(sd))
<a name="l02696"></a>02696       ztmptot = sqrt(<a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(st)+ztout2+zst2b*zsqrt2)
<a name="l02697"></a>02697 
<a name="l02698"></a>02698       ziso(1) = ct * (spnorm(1) * st(1,NLEV) + t0(NLEV)) - 273.16 <span class="comment">! T(NLEV) [C]</span>
<a name="l02699"></a>02699       ziso(2) = ww * zchitot * 1.0e6
<a name="l02700"></a>02700       ziso(3) = ztmptot
<a name="l02701"></a>02701       ziso(4) = ztotp
<a name="l02702"></a>02702       ziso(5) = sz(3,2)
<a name="l02703"></a>02703       call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;SCALAR&quot;</span> // char(0) ,ziso,idim,1,1)
<a name="l02704"></a>02704 
<a name="l02705"></a>02705 <span class="comment">!     restore sz to absolute vorticity</span>
<a name="l02706"></a>02706 
<a name="l02707"></a>02707       sz(3,:) = sz(3,:) + plavor
<a name="l02708"></a>02708 
<a name="l02709"></a>02709       <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) /= 0) return <span class="comment">! was called for GUI only</span>
<a name="l02710"></a>02710       <span class="keyword">write</span>(nud,9001)
<a name="l02711"></a>02711       <span class="keyword">write</span>(nud,9002) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,zpsitot,zchitot,ztmptot,ztotp,zamsp
<a name="l02712"></a>02712       <span class="keyword">write</span>(nud,9002)
<a name="l02713"></a>02713       <span class="keyword">write</span>(nud,9011) (j,j=1,12)
<a name="l02714"></a>02714       <span class="keyword">write</span>(nud,9012)
<a name="l02715"></a>02715       call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(span,spec)
<a name="l02716"></a>02716       call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">&#39;Pre&#39;</span>,spec)
<a name="l02717"></a>02717       call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(sz(1,NLEV),spec)
<a name="l02718"></a>02718       call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">&#39;Vor&#39;</span>,spec)
<a name="l02719"></a>02719       call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(sd(1,NLEV),spec)
<a name="l02720"></a>02720       call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">&#39;Div&#39;</span>,spec)
<a name="l02721"></a>02721       call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(st(1,NLEV),spec)
<a name="l02722"></a>02722       call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">&#39;Tem&#39;</span>,spec)
<a name="l02723"></a>02723       return
<a name="l02724"></a>02724  9001 format(/,
<a name="l02725"></a>02725 <span class="stringliteral">&#39;     nstep     rms z       rms d       rms t       &amp;     &amp; pe+ie       msp&#39;</span>)
<a name="l02726"></a>02726  9002 format(i10,4x,4g12.5,g15.8)
<a name="l02727"></a>02727 <span class="comment">!9009 format(&#39;*&#39;,75(&#39; &#39;),&#39; *&#39;)</span>
<a name="l02728"></a>02728 <span class="comment">!9010 format(&#39;* Power(&#39;,a,&#39;) &#39;,7e9.2,&#39; *&#39;)</span>
<a name="l02729"></a>02729  9011 format(<span class="stringliteral">&#39;* Wavenumber &#39;</span>,i8,11i5,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02730"></a>02730  9012 format(<span class="stringliteral">&#39;&#39;</span>,78(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l02731"></a>02731 <span class="keyword">      end</span>
<a name="l02732"></a>02732 
<a name="l02733"></a>02733 <span class="comment">!     =================</span>
<a name="l02734"></a>02734 <span class="comment">!     SUBROUTINE NTOMIN</span>
<a name="l02735"></a>02735 <span class="comment">!     =================</span>
<a name="l02736"></a>02736 
<a name="l02737"></a><a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">02737</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(kstep,imin,ihou,iday,imon,iyea)
<a name="l02738"></a>02738       use <span class="keywordflow">pumamod</span>
<a name="l02739"></a>02739       istep = kstep                          <span class="comment">! day [0-29] month [0-11]</span>
<a name="l02740"></a>02740       <span class="keyword">if</span> (istep .lt. 0) istep = 0            <span class="comment">! min [0-59] hour  [0-23]</span>
<a name="l02741"></a>02741       imin = mod(istep,ntspd) * 1440 / ntspd <span class="comment">! minutes of current day</span>
<a name="l02742"></a>02742       ihou = imin / 60                       <span class="comment">! hours   of current day</span>
<a name="l02743"></a>02743       imin = imin - ihou * 60                <span class="comment">! minutes of current hour</span>
<a name="l02744"></a>02744       iday = istep / ntspd                   <span class="comment">! days    in this run</span>
<a name="l02745"></a>02745       imon = iday / 30                       <span class="comment">! months  in this run</span>
<a name="l02746"></a>02746       iday = iday - imon * 30                <span class="comment">! days    of current month</span>
<a name="l02747"></a>02747       iyea = imon / 12                       <span class="comment">! years   in this run</span>
<a name="l02748"></a>02748       imon = imon - iyea * 12                <span class="comment">! month   of current year</span>
<a name="l02749"></a>02749       iday = iday + 1
<a name="l02750"></a>02750       imon = imon + 1
<a name="l02751"></a>02751       iyea = iyea + 1
<a name="l02752"></a>02752       return
<a name="l02753"></a>02753 <span class="keyword">      end</span>
<a name="l02754"></a>02754 
<a name="l02755"></a>02755 <span class="comment">!     =================</span>
<a name="l02756"></a>02756 <span class="comment">!     SUBROUTINE NTODAT</span>
<a name="l02757"></a>02757 <span class="comment">!     =================</span>
<a name="l02758"></a>02758 
<a name="l02759"></a><a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">02759</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">ntodat</a>(istep,datch)
<a name="l02760"></a>02760       <span class="keywordtype">character(18)</span> :: datch
<a name="l02761"></a>02761       <span class="keywordtype">character(3)</span> :: mona(12)
<a name="l02762"></a>02762       <span class="keyword">data</span> mona /<span class="stringliteral">&#39;Jan&#39;</span>,<span class="stringliteral">&#39;Feb&#39;</span>,<span class="stringliteral">&#39;Mar&#39;</span>,<span class="stringliteral">&#39;Apr&#39;</span>,<span class="stringliteral">&#39;May&#39;</span>,<span class="stringliteral">&#39;Jun&#39;</span>,&amp;
<a name="l02763"></a>02763      &amp;           <span class="stringliteral">&#39;Jul&#39;</span>,<span class="stringliteral">&#39;Aug&#39;</span>,<span class="stringliteral">&#39;Sep&#39;</span>,<span class="stringliteral">&#39;Oct&#39;</span>,<span class="stringliteral">&#39;Nov&#39;</span>,<span class="stringliteral">&#39;Dec&#39;</span>/
<a name="l02764"></a>02764       call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(istep,imin,ihou,iday,imon,iyea)
<a name="l02765"></a>02765       <span class="keyword">write</span>(datch,20030) iday,mona(imon),iyea,ihou,imin
<a name="l02766"></a>02766 20030 format(i2,<span class="stringliteral">&#39;-&#39;</span>,a3,<span class="stringliteral">&#39;-&#39;</span>,i4.4,2x,i2,<span class="stringliteral">&#39;:&#39;</span>,i2.2)
<a name="l02767"></a>02767 <span class="keyword">      end</span>
<a name="l02768"></a>02768 
<a name="l02769"></a>02769 
<a name="l02770"></a>02770 <span class="comment">!     =================</span>
<a name="l02771"></a>02771 <span class="comment">!     SUBROUTINE WRSPAM</span>
<a name="l02772"></a>02772 <span class="comment">!     =================</span>
<a name="l02773"></a>02773 
<a name="l02774"></a><a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">02774</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(ps,klev,title,scale)
<a name="l02775"></a>02775       use <span class="keywordflow">pumamod</span>
<a name="l02776"></a>02776 <span class="comment">!</span>
<a name="l02777"></a>02777       dimension ps(NRSP)
<a name="l02778"></a>02778       <span class="keywordtype">character(30)</span> :: title
<a name="l02779"></a>02779       <span class="keywordtype">character(18)</span> :: datch
<a name="l02780"></a>02780 
<a name="l02781"></a>02781 <span class="comment">!     cab(i)=real(scale*sqrt(ps(i+i-1)*ps(i+i-1)+ps(i+i)*ps(i+i)))</span>
<a name="l02782"></a>02782 
<a name="l02783"></a>02783       call <a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">ntodat</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,datch)
<a name="l02784"></a>02784       <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(1x)&#39;</span>)
<a name="l02785"></a>02785       <span class="keyword">write</span>(nud,20000)
<a name="l02786"></a>02786       <span class="keyword">write</span>(nud,20030) datch,title,klev
<a name="l02787"></a>02787       <span class="keyword">write</span>(nud,20000)
<a name="l02788"></a>02788       <span class="keyword">write</span>(nud,20020) (i,i=0,9)
<a name="l02789"></a>02789       <span class="keyword">write</span>(nud,20000)
<a name="l02790"></a>02790       <span class="keyword">write</span>(nud,20100) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=1,10)
<a name="l02791"></a>02791       <span class="keyword">write</span>(nud,20200) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=NTRU+2,NTRU+10)
<a name="l02792"></a>02792       <span class="keyword">write</span>(nud,20300) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=2*NTRU+2,2*NTRU+9)
<a name="l02793"></a>02793       <span class="keyword">write</span>(nud,20400) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=3*NTRU+1,3*NTRU+7)
<a name="l02794"></a>02794       <span class="keyword">write</span>(nud,20000)
<a name="l02795"></a>02795       <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(1x)&#39;</span>)
<a name="l02796"></a>02796 
<a name="l02797"></a>02797 20000 format(78(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l02798"></a>02798 20020 format(<span class="stringliteral">&#39;* n * &#39;</span>,10i7,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02799"></a>02799 20030 format(<span class="stringliteral">&#39;*   * &#39;</span>,a18,2x,a30,<span class="stringliteral">&#39;  Level &#39;</span>,i2,11x,<span class="stringliteral">&#39;*&#39;</span>)
<a name="l02800"></a>02800 20100 format(<span class="stringliteral">&#39;* 0 *&#39;</span>,f8.2,9f7.2,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02801"></a>02801 20200 format(<span class="stringliteral">&#39;* 1 *&#39;</span>,8x,9f7.2,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02802"></a>02802 20300 format(<span class="stringliteral">&#39;* 2 *&#39;</span>,15x,8f7.2,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02803"></a>02803 20400 format(<span class="stringliteral">&#39;* 3 *&#39;</span>,22x,7f7.2,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02804"></a>02804       <span class="keyword">contains</span>
<a name="l02805"></a><a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">02805</a>       <span class="keyword">function </span><a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i)
<a name="l02806"></a>02806          <a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a> = scale * sqrt(ps(i+i-1)*ps(i+i-1)+ps(i+i)*ps(i+i))
<a name="l02807"></a>02807 <span class="keyword">      end function cab</span>
<a name="l02808"></a>02808 <span class="keyword">      end</span>
<a name="l02809"></a>02809 
<a name="l02810"></a>02810 <span class="comment">!     ===============</span>
<a name="l02811"></a>02811 <span class="comment">!     SUBROUTINE WRZS</span>
<a name="l02812"></a>02812 <span class="comment">!     ===============</span>
<a name="l02813"></a>02813 
<a name="l02814"></a><a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">02814</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(zs,title,scale)
<a name="l02815"></a>02815       use <span class="keywordflow">pumamod</span>
<a name="l02816"></a>02816 <span class="comment">!</span>
<a name="l02817"></a>02817       dimension zs(NLAT,NLEV)
<a name="l02818"></a>02818       <span class="keywordtype">character(30)</span> :: title
<a name="l02819"></a>02819       <span class="keywordtype">character(18)</span> :: datch
<a name="l02820"></a>02820 
<a name="l02821"></a>02821       ip = NLAT / 16
<a name="l02822"></a>02822       ia = ip/2
<a name="l02823"></a>02823       ib = ia + 7 * ip
<a name="l02824"></a>02824       id = NLAT + 1 - ia
<a name="l02825"></a>02825       ic = id - 7 * ip
<a name="l02826"></a>02826 
<a name="l02827"></a>02827       call <a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">ntodat</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,datch)
<a name="l02828"></a>02828       <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(1x)&#39;</span>)
<a name="l02829"></a>02829       <span class="keyword">write</span>(nud,20000)
<a name="l02830"></a>02830       <span class="keyword">write</span>(nud,20030) datch,title
<a name="l02831"></a>02831       <span class="keyword">write</span>(nud,20000)
<a name="l02832"></a>02832       <span class="keyword">write</span>(nud,20020) (chlat(i),i=ia,ib,ip),(chlat(j),j=ic,id,ip)
<a name="l02833"></a>02833       <span class="keyword">write</span>(nud,20000)
<a name="l02834"></a>02834       <span class="keyword">do</span> 200 jlev = 1 , NLEV
<a name="l02835"></a>02835          <span class="keyword">write</span>(nud,20100) jlev,((int(zs(i,jlev)*scale)),i=ia,ib,ip),&amp;
<a name="l02836"></a>02836      &amp;                       ((int(zs(j,jlev)*scale)),j=ic,id,ip),jlev
<a name="l02837"></a>02837   200 continue
<a name="l02838"></a>02838       <span class="keyword">write</span>(nud,20000)
<a name="l02839"></a>02839       <span class="keyword">write</span>(nud,<span class="stringliteral">&#39;(1x)&#39;</span>)
<a name="l02840"></a>02840 
<a name="l02841"></a>02841 20000 format(78(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l02842"></a>02842 20020 format(<span class="stringliteral">&#39;* Lv * &#39;</span>,16(1x,a3),<span class="stringliteral">&#39; * Lv *&#39;</span>)
<a name="l02843"></a>02843 20030 format(<span class="stringliteral">&#39;*    * &#39;</span>,a18,2x,a30,20x,<span class="stringliteral">&#39;*&#39;</span>)
<a name="l02844"></a>02844 20100 format(<span class="stringliteral">&#39;* &#39;</span>,i2,<span class="stringliteral">&#39; * &#39;</span>,16i4,<span class="stringliteral">&#39; * &#39;</span>,i2,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l02845"></a>02845 <span class="keyword">      end</span>
<a name="l02846"></a>02846 
<a name="l02847"></a>02847 <span class="comment">!     ================</span>
<a name="l02848"></a>02848 <span class="comment">!     SUBROUTINE XSECT</span>
<a name="l02849"></a>02849 <span class="comment">!     ================</span>
<a name="l02850"></a>02850 
<a name="l02851"></a><a class="code" href="puma_8f90.html#a8e59ae6d7b5a22b0e46c56187cdd62cf">02851</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a8e59ae6d7b5a22b0e46c56187cdd62cf">xsect</a>
<a name="l02852"></a>02852       use <span class="keywordflow">pumamod</span>
<a name="l02853"></a>02853       <span class="keywordtype">character(30)</span> :: title
<a name="l02854"></a>02854 
<a name="l02855"></a>02855       scale = 10.0
<a name="l02856"></a>02856       title = <span class="stringliteral">&#39;Zonal Wind [0.1 m/s]&#39;</span>
<a name="l02857"></a>02857       call <a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(csu,title,scale)
<a name="l02858"></a>02858       title = <span class="stringliteral">&#39;Meridional Wind [0.1 m/s]&#39;</span>
<a name="l02859"></a>02859       call <a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(csv,title,scale)
<a name="l02860"></a>02860       scale = 1.0
<a name="l02861"></a>02861       title = <span class="stringliteral">&#39;Temperature [C]&#39;</span>
<a name="l02862"></a>02862       call <a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(cst,title,scale)
<a name="l02863"></a>02863       return
<a name="l02864"></a>02864 <span class="keyword">      end</span>
<a name="l02865"></a>02865 
<a name="l02866"></a>02866 <span class="comment">!     ==================</span>
<a name="l02867"></a>02867 <span class="comment">!     SUBROUTINE WRITESP</span>
<a name="l02868"></a>02868 <span class="comment">!     ==================</span>
<a name="l02869"></a>02869 
<a name="l02870"></a><a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">02870</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(kunit,pf,kcode,klev,pscale,poff)
<a name="l02871"></a>02871       use <span class="keywordflow">pumamod</span>
<a name="l02872"></a>02872       <span class="keywordtype">real</span>    :: pf(NRSP)
<a name="l02873"></a>02873       <span class="keywordtype">real</span>    :: zf(NRSP)
<a name="l02874"></a>02874       <span class="keywordtype">integer</span> :: ihead(8)
<a name="l02875"></a>02875 
<a name="l02876"></a>02876       call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nmin,nhour,nday,nmonth,nyear)
<a name="l02877"></a>02877 
<a name="l02878"></a>02878       ihead(1) = kcode
<a name="l02879"></a>02879       ihead(2) = klev
<a name="l02880"></a>02880       ihead(3) = nday + 100 * nmonth + 10000 * nyear
<a name="l02881"></a>02881       ihead(4) = nmin + 100 * nhour
<a name="l02882"></a>02882       ihead(5) = NRSP
<a name="l02883"></a>02883       ihead(6) = 1
<a name="l02884"></a>02884       ihead(7) = 1
<a name="l02885"></a>02885       ihead(8) = 0
<a name="l02886"></a>02886 
<a name="l02887"></a>02887 <span class="comment">!     normalize ECHAM compatible and scale to physical dimensions</span>
<a name="l02888"></a>02888 
<a name="l02889"></a>02889       zf(:) = pf(:) * spnorm(1:NRSP) * pscale
<a name="l02890"></a>02890       zf(1) = zf(1) + poff <span class="comment">! Add offset if necessary</span>
<a name="l02891"></a>02891       <span class="keyword">write</span>(kunit) ihead
<a name="l02892"></a>02892       <span class="keyword">write</span>(kunit) zf
<a name="l02893"></a>02893 
<a name="l02894"></a>02894       return
<a name="l02895"></a>02895 <span class="keyword">      end</span>
<a name="l02896"></a>02896 
<a name="l02897"></a>02897 <span class="comment">!     ==================</span>
<a name="l02898"></a>02898 <span class="comment">!     SUBROUTINE WRITEGP</span>
<a name="l02899"></a>02899 <span class="comment">!     ==================</span>
<a name="l02900"></a>02900 
<a name="l02901"></a><a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">02901</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">writegp</a>(kunit,pf,kcode,klev)
<a name="l02902"></a>02902       use <span class="keywordflow">pumamod</span>
<a name="l02903"></a>02903       <span class="keywordtype">real</span> :: pf(NHOR)
<a name="l02904"></a>02904       <span class="keywordtype">real</span> :: zf(NUGP)
<a name="l02905"></a>02905       <span class="keywordtype">integer</span> :: ihead(8)
<a name="l02906"></a>02906 
<a name="l02907"></a>02907       call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(zf,pf,1)
<a name="l02908"></a>02908 
<a name="l02909"></a>02909       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> 
<a name="l02910"></a>02910          call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(zf,1)
<a name="l02911"></a>02911          call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nmin,nhour,nday,nmonth,nyear)
<a name="l02912"></a>02912    
<a name="l02913"></a>02913          ihead(1) = kcode
<a name="l02914"></a>02914          ihead(2) = klev 
<a name="l02915"></a>02915          ihead(3) = nday + 100 * nmonth + 10000 * nyear
<a name="l02916"></a>02916          ihead(4) = nmin + 100 * nhour
<a name="l02917"></a>02917          ihead(5) = NLON 
<a name="l02918"></a>02918          ihead(6) = NLAT 
<a name="l02919"></a>02919          ihead(7) = 1
<a name="l02920"></a>02920          ihead(8) = 0
<a name="l02921"></a>02921 
<a name="l02922"></a>02922          <span class="keyword">write</span>(kunit) ihead
<a name="l02923"></a>02923          <span class="keyword">write</span>(kunit) zf
<a name="l02924"></a>02924       <span class="keyword">endif</span>
<a name="l02925"></a>02925 
<a name="l02926"></a>02926       return
<a name="l02927"></a>02927 <span class="keyword">      end  </span>
<a name="l02928"></a>02928 
<a name="l02929"></a>02929 
<a name="l02930"></a>02930 <span class="comment">!     ================</span>
<a name="l02931"></a>02931 <span class="comment">!     SUBROUTINE OUTSP</span>
<a name="l02932"></a>02932 <span class="comment">!     ================</span>
<a name="l02933"></a>02933 
<a name="l02934"></a><a class="code" href="puma_8f90.html#a0352cc6bbeedace31c54d9afba847ad6">02934</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0352cc6bbeedace31c54d9afba847ad6">outsp</a>
<a name="l02935"></a>02935       use <span class="keywordflow">pumamod</span>
<a name="l02936"></a>02936       <span class="keywordtype">real</span> zsr(NESP)
<a name="l02937"></a>02937 
<a name="l02938"></a>02938       <span class="keyword">if</span> (nwrioro == 1) <span class="keyword">then</span>
<a name="l02939"></a>02939          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,so,129,0,cv*cv,0.0)
<a name="l02940"></a>02940          nwrioro = 0
<a name="l02941"></a>02941       <span class="keyword">endif</span>
<a name="l02942"></a>02942 
<a name="l02943"></a>02943       <span class="keyword">if</span> (nextout == 1) <span class="keyword">then</span>
<a name="l02944"></a>02944          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sp2,40,0,1.0,log(psmean))
<a name="l02945"></a>02945          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sp1,41,0,1.0,log(psmean))
<a name="l02946"></a>02946          <span class="keyword">do</span> jlev = 1,NLEV
<a name="l02947"></a>02947             call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,st2(1,jlev),42,jlev,ct,t0(jlev)*ct)
<a name="l02948"></a>02948          <span class="keyword">enddo</span>
<a name="l02949"></a>02949          <span class="keyword">do</span> jlev = 1,NLEV
<a name="l02950"></a>02950             call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,st1(1,jlev),43,jlev,ct,t0(jlev)*ct)
<a name="l02951"></a>02951          <span class="keyword">enddo</span>
<a name="l02952"></a>02952       <span class="keyword">endif</span>
<a name="l02953"></a>02953 
<a name="l02954"></a>02954 <span class="comment">!     ************</span>
<a name="l02955"></a>02955 <span class="comment">!     * pressure *</span>
<a name="l02956"></a>02956 <span class="comment">!     ************</span>
<a name="l02957"></a>02957 
<a name="l02958"></a>02958       call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sp,152,0,1.0,log(psmean))
<a name="l02959"></a>02959 
<a name="l02960"></a>02960 <span class="comment">!     ***************</span>
<a name="l02961"></a>02961 <span class="comment">!     * temperature *</span>
<a name="l02962"></a>02962 <span class="comment">!     ***************</span>
<a name="l02963"></a>02963 
<a name="l02964"></a>02964       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l02965"></a>02965          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,st(1,jlev),130,jlev,ct,t0(jlev)*ct)
<a name="l02966"></a>02966       <span class="keyword">enddo</span>
<a name="l02967"></a>02967 
<a name="l02968"></a>02968 <span class="comment">!     ********************</span>
<a name="l02969"></a>02969 <span class="comment">!     * res. temperature *</span>
<a name="l02970"></a>02970 <span class="comment">!     ********************</span>
<a name="l02971"></a>02971 
<a name="l02972"></a>02972       zampl = cos((<span class="keywordtype">real</span>(nstep)-pac)*tac)
<a name="l02973"></a>02973       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l02974"></a>02974          zsr(:)=sr1(:,jlev)+sr2(:,jlev)*zampl
<a name="l02975"></a>02975          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,zsr,154,jlev,ct,t0(jlev)*ct)
<a name="l02976"></a>02976       <span class="keyword">enddo</span>
<a name="l02977"></a>02977 
<a name="l02978"></a>02978 <span class="comment">!     **************</span>
<a name="l02979"></a>02979 <span class="comment">!     * divergence *</span>
<a name="l02980"></a>02980 <span class="comment">!     **************</span>
<a name="l02981"></a>02981 
<a name="l02982"></a>02982       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l02983"></a>02983          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sd(1,jlev),155,jlev,ww,0.0)
<a name="l02984"></a>02984       <span class="keyword">enddo</span>
<a name="l02985"></a>02985 
<a name="l02986"></a>02986 <span class="comment">!     *************</span>
<a name="l02987"></a>02987 <span class="comment">!     * vorticity *</span>
<a name="l02988"></a>02988 <span class="comment">!     *************</span>
<a name="l02989"></a>02989 
<a name="l02990"></a>02990       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l02991"></a>02991          zsave = sz(3,jlev)
<a name="l02992"></a>02992          sz(3,jlev) = sz(3,jlev) - plavor
<a name="l02993"></a>02993          call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sz(1,jlev),138,jlev,ww,0.0)
<a name="l02994"></a>02994          sz(3,jlev) = zsave
<a name="l02995"></a>02995       <span class="keyword">enddo</span>
<a name="l02996"></a>02996 
<a name="l02997"></a>02997       return
<a name="l02998"></a>02998 <span class="keyword">      end</span>
<a name="l02999"></a>02999 
<a name="l03000"></a>03000 <span class="comment">!     ================</span>
<a name="l03001"></a>03001 <span class="comment">!     SUBROUTINE OUTGP</span>
<a name="l03002"></a>03002 <span class="comment">!     ================</span>
<a name="l03003"></a>03003 
<a name="l03004"></a><a class="code" href="puma_8f90.html#a1f5ebb3d7ab8cc007a6ed2d81b858f03">03004</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a1f5ebb3d7ab8cc007a6ed2d81b858f03">outgp</a>
<a name="l03005"></a>03005       use <span class="keywordflow">pumamod</span>
<a name="l03006"></a>03006       <span class="keywordtype">real</span> zhelp(NHOR)
<a name="l03007"></a>03007 <span class="comment">!     </span>
<a name="l03008"></a>03008 <span class="comment">!     energy diagnostics</span>
<a name="l03009"></a>03009 <span class="comment">!   </span>
<a name="l03010"></a>03010       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03011"></a>03011        <span class="keyword">do</span> je=1,9
<a name="l03012"></a>03012         jcode=300+je
<a name="l03013"></a>03013         zhelp(:)=denergy(:,je)
<a name="l03014"></a>03014         call <a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">writegp</a>(40,zhelp,jcode,0)
<a name="l03015"></a>03015        <span class="keyword">enddo</span>
<a name="l03016"></a>03016       <span class="keyword">endif</span>
<a name="l03017"></a>03017       <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03018"></a>03018        <span class="keyword">do</span> je=1,9
<a name="l03019"></a>03019         jcode=310+je
<a name="l03020"></a>03020         zhelp(:)=dentropy(:,je)
<a name="l03021"></a>03021         call <a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">writegp</a>(40,zhelp,jcode,0)
<a name="l03022"></a>03022        <span class="keyword">enddo</span>
<a name="l03023"></a>03023       <span class="keyword">endif</span>
<a name="l03024"></a>03024 <span class="comment">!</span>
<a name="l03025"></a>03025       return
<a name="l03026"></a>03026 <span class="keyword">      end</span>
<a name="l03027"></a>03027 
<a name="l03028"></a>03028 
<a name="l03029"></a>03029 <span class="comment">!     ====================</span>
<a name="l03030"></a>03030 <span class="comment">!     SUBROUTINE CHECKUNIT</span>
<a name="l03031"></a>03031 <span class="comment">!     ====================</span>
<a name="l03032"></a>03032 
<a name="l03033"></a><a class="code" href="puma_8f90.html#ab608e12bdff55ab600a9d975673c5a53">03033</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ab608e12bdff55ab600a9d975673c5a53">checkunit</a>
<a name="l03034"></a>03034       use <span class="keywordflow">pumamod</span>
<a name="l03035"></a>03035 
<a name="l03036"></a>03036       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sp(  1  )&#39;</span>,sp(1),sp(1)*spnorm(1)+log(psmean)
<a name="l03037"></a>03037       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;st(  1,1)&#39;</span>,st(1,1),st(1,1)*spnorm(1)*ct+t0(1)*ct
<a name="l03038"></a>03038       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sd(  1,1)&#39;</span>,sd(1,1),sd(1,1)*spnorm(1)*ww
<a name="l03039"></a>03039       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sz(  1,1)&#39;</span>,sz(1,1),sz(1,1)*spnorm(1)*ww
<a name="l03040"></a>03040 
<a name="l03041"></a>03041       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;st(  1,NLEV)&#39;</span>,st(1,NLEV),st(1,NLEV)*spnorm(1)*ct+t0(5)*ct
<a name="l03042"></a>03042       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sd(  1,NLEV)&#39;</span>,sd(1,NLEV),sd(1,NLEV)*spnorm(1)*ww
<a name="l03043"></a>03043       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sz(  1,NLEV)&#39;</span>,sz(1,NLEV),sz(1,NLEV)*spnorm(1)*ww
<a name="l03044"></a>03044 
<a name="l03045"></a>03045       <span class="keyword">if</span> (100 &lt; NRSP) <span class="keyword">then</span>
<a name="l03046"></a>03046       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sp(100  )&#39;</span>,sp(100),sp(100)*spnorm(100)
<a name="l03047"></a>03047       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;st(100,NLEV)&#39;</span>,st(100,NLEV),st(100,NLEV)*spnorm(100)*ct
<a name="l03048"></a>03048       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sd(100,NLEV)&#39;</span>,sd(100,NLEV),sd(100,NLEV)*spnorm(100)*ww
<a name="l03049"></a>03049       <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;sz(100,NLEV)&#39;</span>,sz(100,NLEV),sz(100,NLEV)*spnorm(100)*ww
<a name="l03050"></a>03050       <span class="keyword">endif</span>
<a name="l03051"></a>03051 
<a name="l03052"></a>03052       return
<a name="l03053"></a>03053  1000 format(i5,1x,a,1x,2f14.7)
<a name="l03054"></a>03054 <span class="keyword">      end</span>
<a name="l03055"></a>03055 
<a name="l03056"></a>03056 
<a name="l03057"></a>03057 <span class="comment">!     =====================</span>
<a name="l03058"></a>03058 <span class="comment">!     * SUBROUTINE LEGPRI *</span>
<a name="l03059"></a>03059 <span class="comment">!     =====================</span>
<a name="l03060"></a>03060 
<a name="l03061"></a><a class="code" href="puma_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">03061</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">legpri</a>
<a name="l03062"></a>03062       use <span class="keywordflow">pumamod</span>
<a name="l03063"></a>03063 
<a name="l03064"></a>03064       <span class="keyword">write</span>(nud,231)
<a name="l03065"></a>03065       <span class="keyword">write</span>(nud,232)
<a name="l03066"></a>03066       <span class="keyword">write</span>(nud,233)
<a name="l03067"></a>03067       <span class="keyword">write</span>(nud,232)
<a name="l03068"></a>03068       <span class="keyword">do</span> 14 jlat = 1 , NLAT
<a name="l03069"></a>03069          zalat = asin(sid(jlat))*180.0/PI
<a name="l03070"></a>03070          <span class="keyword">write</span>(nud,234) jlat,zalat,csq(jlat),gwd(jlat)
<a name="l03071"></a>03071    14 continue
<a name="l03072"></a>03072       <span class="keyword">write</span>(nud,232)
<a name="l03073"></a>03073       <span class="keyword">write</span>(nud,231)
<a name="l03074"></a>03074       return
<a name="l03075"></a>03075   231 format(/)
<a name="l03076"></a>03076   232 format(37(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l03077"></a>03077   233 format(<span class="stringliteral">&#39;*  No *   Lat *       csq    weight *&#39;</span>)
<a name="l03078"></a>03078   234 format(<span class="stringliteral">&#39;*&#39;</span>,i4,<span class="stringliteral">&#39; *&#39;</span>,f6.1,<span class="stringliteral">&#39; *&#39;</span>,2f10.4,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l03079"></a>03079 <span class="keyword">      end</span>
<a name="l03080"></a>03080 
<a name="l03081"></a>03081 
<a name="l03082"></a>03082 <span class="comment">!     =================</span>
<a name="l03083"></a>03083 <span class="comment">!     SUBROUTINE INILAT</span>
<a name="l03084"></a>03084 <span class="comment">!     =================</span>
<a name="l03085"></a>03085 
<a name="l03086"></a><a class="code" href="puma_8f90.html#a7780f6c3a813605c014f7da964ff83d2">03086</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">inilat</a>
<a name="l03087"></a>03087       use <span class="keywordflow">pumamod</span>
<a name="l03088"></a>03088       <span class="keywordtype">real (kind=8)</span> :: zcsq
<a name="l03089"></a>03089 
<a name="l03090"></a>03090       <span class="keyword">do</span> jlat = 1 , NLAT
<a name="l03091"></a>03091          zcsq       = 1.0 - sid(jlat) * sid(jlat)
<a name="l03092"></a>03092          csq(jlat)  = zcsq
<a name="l03093"></a>03093          rcs(jlat)  = 1.0 / sqrt(zcsq)
<a name="l03094"></a>03094       <span class="keyword">enddo</span>
<a name="l03095"></a>03095       <span class="keyword">do</span> jlat = 1 , NLAT/2
<a name="l03096"></a>03096          ideg = nint(180.0/PI * asin(sid(jlat)))
<a name="l03097"></a>03097          <span class="keyword">write</span>(chlat(jlat),<span class="stringliteral">&#39;(i2,a1)&#39;</span>) ideg,<span class="stringliteral">&#39;N&#39;</span>
<a name="l03098"></a>03098          <span class="keyword">write</span>(chlat(NLAT+1-jlat),<span class="stringliteral">&#39;(i2,a1)&#39;</span>) ideg,<span class="stringliteral">&#39;S&#39;</span>
<a name="l03099"></a>03099       <span class="keyword">enddo</span>
<a name="l03100"></a>03100       return
<a name="l03101"></a>03101 <span class="keyword">      end</span>
<a name="l03102"></a>03102 
<a name="l03103"></a>03103 
<a name="l03104"></a>03104 <span class="comment">!     ====================</span>
<a name="l03105"></a>03105 <span class="comment">!     SUBROUTINE GRIDPOINT</span>
<a name="l03106"></a>03106 <span class="comment">!     ====================</span>
<a name="l03107"></a>03107 
<a name="l03108"></a><a class="code" href="puma_8f90.html#aefdbfd36b330ce29d344d428431119c9">03108</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a>
<a name="l03109"></a>03109       use <span class="keywordflow">pumamod</span>
<a name="l03110"></a>03110 
<a name="l03111"></a>03111       <span class="keywordtype">real</span> gtn(NLON,NLPP,NLEV)
<a name="l03112"></a>03112       <span class="keywordtype">real</span> gvpp(NHOR)
<a name="l03113"></a>03113       <span class="keywordtype">real</span> gpmt(NLON,NLPP)
<a name="l03114"></a>03114       <span class="keywordtype">real</span> sdf(NESP,NLEV)
<a name="l03115"></a>03115       <span class="keywordtype">real</span> stf(NESP,NLEV)
<a name="l03116"></a>03116       <span class="keywordtype">real</span> szf(NESP,NLEV)
<a name="l03117"></a>03117       <span class="keywordtype">real</span> spf(NESP)
<a name="l03118"></a>03118       <span class="keywordtype">real</span> zgp(NLON,NLAT)
<a name="l03119"></a>03119       <span class="keywordtype">real</span> zgpp(NHOR)
<a name="l03120"></a>03120       <span class="keywordtype">real (kind=4)</span> :: zcs(NLAT,NLEV)
<a name="l03121"></a>03121       <span class="keywordtype">real (kind=4)</span> :: zsp(NRSP)
<a name="l03122"></a>03122 
<a name="l03123"></a>03123       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03124"></a>03124          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sd(1,jlev),gd(1,jlev))
<a name="l03125"></a>03125          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(st(1,jlev),gt(1,jlev))
<a name="l03126"></a>03126          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sz(1,jlev),gz(1,jlev))
<a name="l03127"></a>03127       <span class="keyword">enddo</span>
<a name="l03128"></a>03128 
<a name="l03129"></a>03129       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sp,gp)             <span class="comment">! LnPs</span>
<a name="l03130"></a>03130       call <a class="code" href="legsym_8f90.html#ac25a3c42ee19118b299203d2747cb59e">sp2fcdmu</a>(sp,gpj)         <span class="comment">! d(lnps) / d(mu)</span>
<a name="l03131"></a>03131 <span class="comment">!     divergence, vorticity -&gt; u*cos(phi), v*cos(phi)</span>
<a name="l03132"></a>03132       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03133"></a>03133          call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(sd(1,jlev),sz(1,jlev),gu(1,jlev),gv(1,jlev))
<a name="l03134"></a>03134       <span class="keyword">enddo</span>
<a name="l03135"></a>03135       <span class="keyword">if</span> (lselect) <span class="keyword">then</span>
<a name="l03136"></a>03136          call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gp)
<a name="l03137"></a>03137          call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gpj)
<a name="l03138"></a>03138          <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03139"></a>03139             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gu(1,jlev))
<a name="l03140"></a>03140             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gv(1,jlev))
<a name="l03141"></a>03141             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gd(1,jlev))
<a name="l03142"></a>03142             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gt(1,jlev))
<a name="l03143"></a>03143             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gz(1,jlev))
<a name="l03144"></a>03144          <span class="keyword">enddo</span>
<a name="l03145"></a>03145       <span class="keyword">endif</span>
<a name="l03146"></a>03146 
<a name="l03147"></a>03147       <span class="keyword">if</span> (ngui &gt; 0 .or. mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) == 0) <span class="keyword">then</span>
<a name="l03148"></a>03148         <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03149"></a>03149           <span class="keyword">do</span> jlat = 1 , NLPP
<a name="l03150"></a>03150             sec = cv / sqrt(csq(jlat))
<a name="l03151"></a>03151             csu(jlat,jlev) = gu(1+(jlat-1)*NLON,jlev) * sec
<a name="l03152"></a>03152             csv(jlat,jlev) = gv(1+(jlat-1)*NLON,jlev) * sec
<a name="l03153"></a>03153             cst(jlat,jlev) =(gt(1+(jlat-1)*NLON,jlev) + t0(jlev))*ct-273.16
<a name="l03154"></a>03154           <span class="keyword">enddo</span>
<a name="l03155"></a>03155         <span class="keyword">enddo</span>
<a name="l03156"></a>03156       <span class="keyword">endif</span>
<a name="l03157"></a>03157 
<a name="l03158"></a>03158       <span class="keyword">do</span> jlat = 1 , NLPP
<a name="l03159"></a>03159          <span class="keyword">do</span> jlon = 1 , NLON-1 , 2
<a name="l03160"></a>03160            gpmt(jlon  ,jlat) = -gp(jlon+1+(jlat-1)*NLON) * ((jlon-1)/2)
<a name="l03161"></a>03161            gpmt(jlon+1,jlat) =  gp(jlon  +(jlat-1)*NLON) * ((jlon-1)/2)
<a name="l03162"></a>03162          <span class="keyword">end do</span>
<a name="l03163"></a>03163       <span class="keyword">end do</span>
<a name="l03164"></a>03164 
<a name="l03165"></a>03165       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gu ,NLON,NLPP*NLEV)
<a name="l03166"></a>03166       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gv ,NLON,NLPP*NLEV)
<a name="l03167"></a>03167       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gt ,NLON,NLPP*NLEV)
<a name="l03168"></a>03168       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gd ,NLON,NLPP*NLEV)
<a name="l03169"></a>03169       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gz ,NLON,NLPP*NLEV)
<a name="l03170"></a>03170       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gpj,NLON,NLPP)
<a name="l03171"></a>03171       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gpmt,NLON,NLPP)
<a name="l03172"></a>03172 
<a name="l03173"></a>03173       call <a class="code" href="puma_8f90.html#a0e2e6d98e219c0540bd78f5673a2dd57">calcgp</a>(gtn,gpmt,gvpp)
<a name="l03174"></a>03174 
<a name="l03175"></a>03175       gut(:,:) = gu(:,:) * gt(:,:)
<a name="l03176"></a>03176       gvt(:,:) = gv(:,:) * gt(:,:)
<a name="l03177"></a>03177       gke(:,:) = gu(:,:) * gu(:,:) + gv(:,:) * gv(:,:)
<a name="l03178"></a>03178 
<a name="l03179"></a>03179       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gtn ,NLON,NLPP*NLEV)
<a name="l03180"></a>03180       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gut ,NLON,NLPP*NLEV)
<a name="l03181"></a>03181       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gvt ,NLON,NLPP*NLEV)
<a name="l03182"></a>03182       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gfv ,NLON,NLPP*NLEV)
<a name="l03183"></a>03183       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gfu ,NLON,NLPP*NLEV)
<a name="l03184"></a>03184       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gke ,NLON,NLPP*NLEV)
<a name="l03185"></a>03185       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gvpp,NLON,NLPP     )
<a name="l03186"></a>03186 
<a name="l03187"></a>03187       call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(gvpp,spf)
<a name="l03188"></a>03188 
<a name="l03189"></a>03189       <span class="keyword">if</span> (lselect) <span class="keyword">then</span>
<a name="l03190"></a>03190          call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gvpp)
<a name="l03191"></a>03191          <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03192"></a>03192             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gtn(1,1,jlev))
<a name="l03193"></a>03193             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gut(1,jlev))
<a name="l03194"></a>03194             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gvt(1,jlev))
<a name="l03195"></a>03195             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gfv(1,jlev))
<a name="l03196"></a>03196             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gfu(1,jlev))
<a name="l03197"></a>03197             call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gke(1,jlev))
<a name="l03198"></a>03198          <span class="keyword">enddo</span>
<a name="l03199"></a>03199       <span class="keyword">endif</span>
<a name="l03200"></a>03200 
<a name="l03201"></a>03201       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03202"></a>03202          call <a class="code" href="legsym_8f90.html#ab97cf272bad63e9bdd87a01317bb71c9">mktend</a>(sdf(1,jlev),stf(1,jlev),szf(1,jlev),gtn(1,1,jlev),&amp;
<a name="l03203"></a>03203          gfu(1,jlev),gfv(1,jlev),gke(1,jlev),gut(1,jlev),gvt(1,jlev))
<a name="l03204"></a>03204       <span class="keyword">enddo</span>
<a name="l03205"></a>03205 
<a name="l03206"></a>03206       <span class="keyword">if</span> (nruido &gt; 0) call <a class="code" href="puma_8f90.html#ab257e27330a3ab13c9c90ebd985ef60e">stepruido</a>
<a name="l03207"></a>03207       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(spf,spt,1)
<a name="l03208"></a>03208       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(stf,stt,NLEV)
<a name="l03209"></a>03209       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(sdf,sdt,NLEV)
<a name="l03210"></a>03210       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(szf,szt,NLEV)
<a name="l03211"></a>03211 
<a name="l03212"></a>03212       <span class="keyword">if</span> (ngui &gt; 0 .or. mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) == 0) <span class="keyword">then</span>
<a name="l03213"></a>03213          call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gp,NLON,NLPP)
<a name="l03214"></a>03214          zgpp(:) = exp(gp)                <span class="comment">! LnPs -&gt; Ps</span>
<a name="l03215"></a>03215          call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(zgp,zgpp,1)          <span class="comment">! zgp = Ps (full grid)</span>
<a name="l03216"></a>03216          <span class="keyword">if</span> (ngui &gt; 0) <span class="keyword">then</span>
<a name="l03217"></a>03217             call <a class="code" href="guimod_8f90.html#aef8771e5b34f33e37c1370ac60c41aea">guips</a>(zgp,psmean)        
<a name="l03218"></a>03218             call <a class="code" href="guimod_8f90.html#ad4f84b3b48dfc55519b6072ba9a62e97">guigv</a>(<span class="stringliteral">&quot;GU&quot;</span> // char(0),gu)
<a name="l03219"></a>03219             call <a class="code" href="guimod_8f90.html#ad4f84b3b48dfc55519b6072ba9a62e97">guigv</a>(<span class="stringliteral">&quot;GV&quot;</span> // char(0),gv)
<a name="l03220"></a>03220             call <a class="code" href="guimod_8f90.html#a043a85f7d43cabc1814465b055b8da18">guigt</a>(gt)
<a name="l03221"></a>03221          <span class="keyword">endif</span>
<a name="l03222"></a>03222          zgpp(:) =  zgpp(:) - 1.0         <span class="comment">! Mean(LnPs) = 0  &lt;-&gt; Mean(Ps) = 1</span>
<a name="l03223"></a>03223          call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zgpp,NLON,NLPP)
<a name="l03224"></a>03224          call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zgpp,span)
<a name="l03225"></a>03225 
<a name="l03226"></a>03226          call <a class="code" href="mpimod_8f90.html#af894efd9525c935f22415e017dcbc482">mpsum</a>(span,1)               <span class="comment">! span = Ps spectral</span>
<a name="l03227"></a>03227          call <a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(csu)
<a name="l03228"></a>03228          call <a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(csv)
<a name="l03229"></a>03229          call <a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(cst)
<a name="l03230"></a>03230          <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l03231"></a>03231             call <a class="code" href="legsym_8f90.html#a6ba5b0b99819bcbad73f2e2eb49c62bb">altcs</a>(csu)
<a name="l03232"></a>03232             call <a class="code" href="legsym_8f90.html#a6ba5b0b99819bcbad73f2e2eb49c62bb">altcs</a>(csv)
<a name="l03233"></a>03233             call <a class="code" href="legsym_8f90.html#a6ba5b0b99819bcbad73f2e2eb49c62bb">altcs</a>(cst)
<a name="l03234"></a>03234             <span class="keyword">if</span> (ngui &gt; 0) <span class="keyword">then</span>
<a name="l03235"></a>03235                zcs(:,:) = csu(:,:)
<a name="l03236"></a>03236                call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;CSU&quot;</span>  // char(0) ,zcs ,NLAT,NLEV,1)
<a name="l03237"></a>03237                zcs(:,:) = csv(:,:)
<a name="l03238"></a>03238                call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;CSV&quot;</span>  // char(0) ,zcs ,NLAT,NLEV,1)
<a name="l03239"></a>03239                zcs(:,:) = cst(:,:)
<a name="l03240"></a>03240                call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;CST&quot;</span>  // char(0) ,zcs ,NLAT,NLEV,1)
<a name="l03241"></a>03241                zsp(:) = span(1:NRSP)
<a name="l03242"></a>03242                call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;SPAN&quot;</span> // char(0) ,zsp ,NCSP,-NTP1,1)
<a name="l03243"></a>03243             <span class="keyword">endif</span>
<a name="l03244"></a>03244          <span class="keyword">endif</span>
<a name="l03245"></a>03245       <span class="keyword">endif</span>
<a name="l03246"></a>03246       return
<a name="l03247"></a>03247 <span class="keyword">      end</span>
<a name="l03248"></a>03248 
<a name="l03249"></a>03249 <span class="comment">!     =================</span>
<a name="l03250"></a>03250 <span class="comment">!     SUBROUTINE CALCGP</span>
<a name="l03251"></a>03251 <span class="comment">!     =================</span>
<a name="l03252"></a><a class="code" href="puma_8f90.html#a0e2e6d98e219c0540bd78f5673a2dd57">03252</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0e2e6d98e219c0540bd78f5673a2dd57">calcgp</a>(gtn,gpm,gvp)
<a name="l03253"></a>03253 
<a name="l03254"></a>03254       use <span class="keywordflow">pumamod</span>
<a name="l03255"></a>03255 
<a name="l03256"></a>03256 <span class="comment">!     Comments by Torben Kunz and Guido Schroeder</span>
<a name="l03257"></a>03257 
<a name="l03258"></a>03258 <span class="comment">!     Compute nonlinear tendencies in grid point space.</span>
<a name="l03259"></a>03259 <span class="comment">!     Hoskins and Simmons 1975 (Q.J.R.Meteorol.Soc.,101,637-655) (HS75)</span>
<a name="l03260"></a>03260 
<a name="l03261"></a>03261 <span class="comment">!     For terms calculated in this routine, see HS75, eqs. (8)-(10) and</span>
<a name="l03262"></a>03262 <span class="comment">!     appendix I:</span>
<a name="l03263"></a>03263 <span class="comment">!     - script Fu, Fv as contributions to script D: gl. arrays gfu, gfv</span>
<a name="l03264"></a>03264 <span class="comment">!     - script T: returned as gtn</span>
<a name="l03265"></a>03265 <span class="comment">!     - script P: returned as gvp</span>
<a name="l03266"></a>03266 
<a name="l03267"></a>03267 
<a name="l03268"></a>03268 <span class="comment">!     parameters (in)</span>
<a name="l03269"></a>03269 <span class="comment">!     ---------------</span>
<a name="l03270"></a>03270 
<a name="l03271"></a>03271 <span class="comment">!     gpm --              d(ln(ps)) / d(lambda)</span>
<a name="l03272"></a>03272 
<a name="l03273"></a>03273 <span class="comment">!     parameters (out)</span>
<a name="l03274"></a>03274 <span class="comment">!     ---------------</span>
<a name="l03275"></a>03275 
<a name="l03276"></a>03276 <span class="comment">!     gtn -- temperature tendency</span>
<a name="l03277"></a>03277 <span class="comment">!     gvp -- vertical integral of (u,v) * grad(ln(ps))</span>
<a name="l03278"></a>03278 
<a name="l03279"></a>03279 <span class="comment">!     global arrays variable in time</span>
<a name="l03280"></a>03280 <span class="comment">!     ------------------------------</span>
<a name="l03281"></a>03281 
<a name="l03282"></a>03282 <span class="comment">!     gfu, gfv -- terms Fu, Fv in primitive equations,</span>
<a name="l03283"></a>03283 <span class="comment">!                 see HS75 (eqs. (1), (2))</span>
<a name="l03284"></a>03284 <span class="comment">!     gu, gv   -- components u, v of horizontal velocity vector</span>
<a name="l03285"></a>03285 <span class="comment">!     gd       -- divergence D</span>
<a name="l03286"></a>03286 <span class="comment">!     gz       -- absolute vorticity</span>
<a name="l03287"></a>03287 <span class="comment">!     gt       -- temperature deviation T&#39;</span>
<a name="l03288"></a>03288 
<a name="l03289"></a>03289 <span class="comment">!     global arrays constant in time</span>
<a name="l03290"></a>03290 <span class="comment">!     ------------------------------</span>
<a name="l03291"></a>03291 
<a name="l03292"></a>03292 <span class="comment">!     t0d   -- reference temperature difference between two adjacent</span>
<a name="l03293"></a>03293 <span class="comment">!              full levels</span>
<a name="l03294"></a>03294 <span class="comment">!     tkp   -- reference temperature times kappa (global parameter AKAP)</span>
<a name="l03295"></a>03295 <span class="comment">!     rdsig -- 1 / (2 * dsigma)</span>
<a name="l03296"></a>03296 <span class="comment">!     rcsq  -- 1 / (1 - mu^2) </span>
<a name="l03297"></a>03297 
<a name="l03298"></a>03298 <span class="comment">!     notations used in subsequent comments</span>
<a name="l03299"></a>03299 <span class="comment">!     -------------------------------------</span>
<a name="l03300"></a>03300 
<a name="l03301"></a>03301 <span class="comment">!     aINTb(A)dsigma :&lt;=&gt; the integral of A over the interval [a,b]</span>
<a name="l03302"></a>03302 <span class="comment">!                         with respect to sigma</span>
<a name="l03303"></a>03303 
<a name="l03304"></a>03304       <span class="keywordtype">real</span> gtn(NHOR,NLEV)
<a name="l03305"></a>03305       <span class="keywordtype">real</span> gpm(NHOR)     , gvp(NHOR)
<a name="l03306"></a>03306       <span class="keywordtype">real</span> zsdotp(NHOR,NLEM),zsumd(NHOR),zsumvp(NHOR),zsumvpm(NHOR)
<a name="l03307"></a>03307       <span class="keywordtype">real</span> ztpta(NHOR),ztptb(NHOR)
<a name="l03308"></a>03308       <span class="keywordtype">real</span> zvgpg(NHOR,NLEV)
<a name="l03309"></a>03309       <span class="keywordtype">real</span> gtd(NHOR,NLEM)
<a name="l03310"></a>03310       <span class="keywordtype">real</span> gud(NHOR,NLEM)
<a name="l03311"></a>03311       <span class="keywordtype">real</span> gvd(NHOR,NLEM)
<a name="l03312"></a>03312 
<a name="l03313"></a>03313 <span class="comment">!     1.</span>
<a name="l03314"></a>03314 <span class="comment">!     1.1 zvgpg: (u,v) * grad(ln(ps))</span>
<a name="l03315"></a>03315 
<a name="l03316"></a>03316       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03317"></a>03317          zvgpg(:,jlev) = rcsq  * (gu(:,jlev)*gpm(:)+gv(:,jlev)*gpj(:))
<a name="l03318"></a>03318       <span class="keyword">enddo</span>
<a name="l03319"></a>03319 
<a name="l03320"></a>03320 <span class="comment">!     1.2 Calculate vertical integral of A = D + (u,v) * grad(ln(ps)),</span>
<a name="l03321"></a>03321 <span class="comment">!         separated into divergence and ln(ps) advection.</span>
<a name="l03322"></a>03322 <span class="comment">!         zsumd  : 0INT1(D)dsigma</span>
<a name="l03323"></a>03323 <span class="comment">!         gvp    : 0INT1[(u,v) * grad ln(ps)]dsigma</span>
<a name="l03324"></a>03324 <span class="comment">!         zsdotp : 0INTsigma(A)dsigma</span>
<a name="l03325"></a>03325 
<a name="l03326"></a>03326       zsumd = dsigma(1) * gd(:,1)
<a name="l03327"></a>03327       gvp   = dsigma(1) * zvgpg(:,1)
<a name="l03328"></a>03328       zsdotp(:,1) = zsumd + gvp
<a name="l03329"></a>03329 
<a name="l03330"></a>03330       <span class="keyword">do</span> jlev = 2 , NLEM
<a name="l03331"></a>03331          zsumd = zsumd + dsigma(jlev) * gd(:,jlev)
<a name="l03332"></a>03332          gvp   = gvp   + dsigma(jlev) * zvgpg(:,jlev)
<a name="l03333"></a>03333          zsdotp(:,jlev) = zsumd + gvp
<a name="l03334"></a>03334       <span class="keyword">enddo</span>
<a name="l03335"></a>03335 
<a name="l03336"></a>03336       zsumd = zsumd + dsigma(NLEV) * gd(:,NLEV)
<a name="l03337"></a>03337       gvp   = gvp   + dsigma(NLEV) * zvgpg(:,NLEV)
<a name="l03338"></a>03338 
<a name="l03339"></a>03339 <span class="comment">!     2. Calculate vertical velocity and vertical advection terms</span>
<a name="l03340"></a>03340 <span class="comment">!        on half levels.</span>
<a name="l03341"></a>03341 
<a name="l03342"></a>03342       <span class="keyword">do</span> jlev = 1 , NLEM
<a name="l03343"></a>03343          zsdotp(:,jlev) = (sigmh(jlev) * (zsumd+gvp) - zsdotp(:,jlev))
<a name="l03344"></a>03344       <span class="keyword">enddo</span>
<a name="l03345"></a>03345 
<a name="l03346"></a>03346       gtd(:,:) = zsdotp(:,:) * (gt(:,2:NLEV) - gt(:,1:NLEM))
<a name="l03347"></a>03347       gud(:,:) = zsdotp(:,:) * (gu(:,2:NLEV) - gu(:,1:NLEM))
<a name="l03348"></a>03348       gvd(:,:) = zsdotp(:,:) * (gv(:,2:NLEV) - gv(:,1:NLEM))
<a name="l03349"></a>03349 
<a name="l03350"></a>03350 <span class="comment">!     3. Calculate nonlinear contributions to temperature tendency and</span>
<a name="l03351"></a>03351 <span class="comment">!        nonlinear terms Fu, Fv as used in vorticity and</span>
<a name="l03352"></a>03352 <span class="comment">!        divergence equation.</span>
<a name="l03353"></a>03353 
<a name="l03354"></a>03354 <span class="comment">!     3.1 top level:</span>
<a name="l03355"></a>03355 
<a name="l03356"></a>03356 <span class="comment">!     3.1.1 zsumvp: 0INTsigma[(u,v) * grad(ln(ps))]dsigma</span>
<a name="l03357"></a>03357 
<a name="l03358"></a>03358       zsumvp = zvgpg(:,1) * dsigma(1)
<a name="l03359"></a>03359 
<a name="l03360"></a>03360 <span class="comment">!     3.1.2 Calculation of gtn, gfv and gfu as for inner levels (3.2),</span>
<a name="l03361"></a>03361 <span class="comment">!           but somewhat simplified:</span>
<a name="l03362"></a>03362 <span class="comment">!           a) For the top level the following equation holds in the</span>
<a name="l03363"></a>03363 <span class="comment">!              discretized form: (1/sigma)*0INTsigma(A)dsigma == A</span>
<a name="l03364"></a>03364 <span class="comment">!              (HS75, second equation following eq. (7)). Therefore,</span>
<a name="l03365"></a>03365 <span class="comment">!              (3.2.3) simplifies to -kappa*T&#39; * D and (3.2.4) vanishes.</span>
<a name="l03366"></a>03366 <span class="comment">!           b) Vertical advection terms (gtd, gud, gvd (see section 2)</span>
<a name="l03367"></a>03367 <span class="comment">!              and vertical T0 advection (3.2.6)) vanish at upper</span>
<a name="l03368"></a>03368 <span class="comment">!              boundary (sigma == 0).</span>
<a name="l03369"></a>03369 
<a name="l03370"></a>03370       gtn(:,1) = (1.0-akap) * gt(:,1) * gd(:,1) - rdsig(1) * (gtd(:,1) &amp;
<a name="l03371"></a>03371                + t0d(1) * (sigmh(1)*gvp-zsumvp))
<a name="l03372"></a>03372 
<a name="l03373"></a>03373       gfv(:,1) = - gu(:,1)*gz(:,1) - gpj(:)*gt(:,1) - rdsig(1)*gvd(:,1)
<a name="l03374"></a>03374       gfu(:,1) =   gv(:,1)*gz(:,1) - gpm(:)*gt(:,1) - rdsig(1)*gud(:,1)
<a name="l03375"></a>03375 
<a name="l03376"></a>03376 <span class="comment">!     3.2 inner levels:</span>
<a name="l03377"></a>03377 
<a name="l03378"></a>03378       <span class="keyword">do</span> jlev = 2 , NLEM
<a name="l03379"></a>03379 
<a name="l03380"></a>03380 <span class="comment">!        3.2.1 ztpta: (1/sigma)*0INTsigma(A-D)dsigma</span>
<a name="l03381"></a>03381 <span class="comment">!              ztptb: (1/sigma)*0INTsigma(A)dsigma</span>
<a name="l03382"></a>03382 <span class="comment">!              Matrix c contains factors for discretized integration, see</span>
<a name="l03383"></a>03383 <span class="comment">!              HS75 (second equation following eq. (7)).</span>
<a name="l03384"></a>03384 
<a name="l03385"></a>03385          ztpta = c(1,jlev) *  zvgpg(:,1)
<a name="l03386"></a>03386          ztptb = c(1,jlev) * (zvgpg(:,1) + gd(:,1))
<a name="l03387"></a>03387 
<a name="l03388"></a>03388          <span class="keyword">do</span> jlej = 2 , jlev
<a name="l03389"></a>03389             ztpta = ztpta + c(jlej,jlev) *  zvgpg(:,jlej)
<a name="l03390"></a>03390             ztptb = ztptb + c(jlej,jlev) * (zvgpg(:,jlej) + gd(:,jlej))
<a name="l03391"></a>03391          <span class="keyword">enddo</span>
<a name="l03392"></a>03392 
<a name="l03393"></a>03393          zsumvpm = zsumvp
<a name="l03394"></a>03394          zsumvp  = zsumvp + zvgpg(:,jlev) * dsigma(jlev)
<a name="l03395"></a>03395 
<a name="l03396"></a>03396 <span class="comment">!        3.2.2 D * T&#39; </span>
<a name="l03397"></a>03397 
<a name="l03398"></a>03398          gtn(:,jlev) = gt(:,jlev) * gd(:,jlev)
<a name="l03399"></a>03399 
<a name="l03400"></a>03400 <span class="comment">!        3.2.3 kappa*T&#39; *</span>
<a name="l03401"></a>03401 <span class="comment">!                    [(u,v)*grad(ln(ps)) - (1/sigma)*0INTsigma(A)dsigma]</span>
<a name="l03402"></a>03402 
<a name="l03403"></a>03403          gtn(:,jlev) = gtn(:,jlev)                                      &amp;
<a name="l03404"></a>03404      &amp;       + akap * gt(:,jlev) * (zvgpg(:,jlev) - ztptb)
<a name="l03405"></a>03405 
<a name="l03406"></a>03406 <span class="comment">!        3.2.4 kappa*T0 *</span>
<a name="l03407"></a>03407 <span class="comment">!                  [(u,v)*grad(ln(ps)) - (1/sigma)*0INTsigma(A-D)dsigma]</span>
<a name="l03408"></a>03408 
<a name="l03409"></a>03409          gtn(:,jlev) = gtn(:,jlev)                                      &amp;
<a name="l03410"></a>03410      &amp;       + tkp(jlev) * (zvgpg(:,jlev) - ztpta)
<a name="l03411"></a>03411 
<a name="l03412"></a>03412 <span class="comment">!        3.2.5 Calculate vertical T&#39; advection on full levels by</span>
<a name="l03413"></a>03413 <span class="comment">!              averaging two half level advection terms (gtd, calculated</span>
<a name="l03414"></a>03414 <span class="comment">!              in section 2).</span>
<a name="l03415"></a>03415 
<a name="l03416"></a>03416 <span class="comment">!        and</span>
<a name="l03417"></a>03417 
<a name="l03418"></a>03418 <span class="comment">!        3.2.6 Calculate vertical T0 advection on full levels by</span>
<a name="l03419"></a>03419 <span class="comment">!              averaging two half level advection terms.</span>
<a name="l03420"></a>03420 
<a name="l03421"></a>03421          gtn(:,jlev) = gtn(:,jlev)                                      &amp;
<a name="l03422"></a>03422      &amp;       - rdsig(jlev) * (gtd(:,jlev) + gtd(:,jlev-1)               &amp;
<a name="l03423"></a>03423      &amp;         +(sigmh(jlev)   * gvp - zsumvp)  * t0d(jlev)            &amp;
<a name="l03424"></a>03424      &amp;         +(sigmh(jlev-1) * gvp - zsumvpm) * t0d(jlev-1))
<a name="l03425"></a>03425 
<a name="l03426"></a>03426 <span class="comment">!        3.2.7 terms Fv, Fu, see HS75 (equations following eq. (5));</span>
<a name="l03427"></a>03427 <span class="comment">!              vertical advection terms interpolated to full levels by</span>
<a name="l03428"></a>03428 <span class="comment">!              averaging two half level advection terms.</span>
<a name="l03429"></a>03429 
<a name="l03430"></a>03430          gfv(:,jlev) = - gu(:,jlev)*gz(:,jlev) - gpj(:)*gt(:,jlev)      &amp;
<a name="l03431"></a>03431      &amp;                 - rdsig(jlev)*(gvd(:,jlev) + gvd(:,jlev-1))
<a name="l03432"></a>03432 
<a name="l03433"></a>03433          gfu(:,jlev) =   gv(:,jlev)*gz(:,jlev) - gpm(:)*gt(:,jlev)      &amp;
<a name="l03434"></a>03434      &amp;                 - rdsig(jlev)*(gud(:,jlev) + gud(:,jlev-1))
<a name="l03435"></a>03435       <span class="keyword">enddo</span>
<a name="l03436"></a>03436 
<a name="l03437"></a>03437 <span class="comment">!     3.3 bottom level</span>
<a name="l03438"></a>03438 
<a name="l03439"></a>03439 <span class="comment">!     3.3.1 ztpta, ztptb: see 3.2.1</span>
<a name="l03440"></a>03440 
<a name="l03441"></a>03441       ztpta = c(1,NLEV) *  zvgpg(:,1)
<a name="l03442"></a>03442       ztptb = c(1,NLEV) * (zvgpg(:,1) + gd(:,1))
<a name="l03443"></a>03443 
<a name="l03444"></a>03444       <span class="keyword">do</span> jlej = 2 , NLEV
<a name="l03445"></a>03445          ztpta = ztpta + c(jlej,NLEV) *  zvgpg(:,jlej)
<a name="l03446"></a>03446          ztptb = ztptb + c(jlej,NLEV) * (zvgpg(:,jlej) + gd(:,jlej))
<a name="l03447"></a>03447       <span class="keyword">enddo</span>
<a name="l03448"></a>03448 
<a name="l03449"></a>03449 <span class="comment">!     3.3.2 Calculation of gtn, gfv and gfu as for inner levels (3.2),</span>
<a name="l03450"></a>03450 <span class="comment">!           but somewhat simplified:</span>
<a name="l03451"></a>03451 <span class="comment">!           Vertical advection terms (gtd, gud, gvd (see section 2) and </span>
<a name="l03452"></a>03452 <span class="comment">!           vertical T0 advection (3.2.6)) vanish at</span>
<a name="l03453"></a>03453 <span class="comment">!           lower boundary (sigma == 1).</span>
<a name="l03454"></a>03454 
<a name="l03455"></a>03455       gtn(:,NLEV) = gt(:,NLEV) * gd(:,NLEV)                            &amp;
<a name="l03456"></a>03456      &amp;            + akap*gt(:,NLEV)*(zvgpg(:,NLEV)-ztptb)              &amp;
<a name="l03457"></a>03457      &amp;            + tkp(NLEV)*(zvgpg(:,NLEV)-ztpta)                    &amp;
<a name="l03458"></a>03458      &amp;            - rdsig(NLEV) * (gtd(:,NLEM)                         &amp;
<a name="l03459"></a>03459      &amp;            + t0d(NLEM)*(sigmh(NLEM)*gvp-zsumvp))
<a name="l03460"></a>03460 
<a name="l03461"></a>03461       gfv(:,NLEV) = -gu(:,NLEV) * gz(:,NLEV) - gpj(:) * gt(:,NLEV)      &amp;
<a name="l03462"></a>03462      &amp;              - rdsig(NLEV) * gvd(:,NLEM)
<a name="l03463"></a>03463       gfu(:,NLEV) =  gv(:,NLEV) * gz(:,NLEV) - gpm(:) * gt(:,NLEV)      &amp;
<a name="l03464"></a>03464      &amp;              - rdsig(NLEV) * gud(:,NLEM)
<a name="l03465"></a>03465 
<a name="l03466"></a>03466 <span class="comment">!     3.3.3 Add gaussian noise to T (controlled by nruido)</span>
<a name="l03467"></a>03467 
<a name="l03468"></a>03468       <span class="keyword">if</span> (nruido &gt; 0) gtn(:,:) = gtn(:,:) + ruidop(:,:)
<a name="l03469"></a>03469 
<a name="l03470"></a>03470       return
<a name="l03471"></a>03471 <span class="keyword">      end</span>
<a name="l03472"></a>03472 
<a name="l03473"></a>03473 <span class="comment">!     ===================</span>
<a name="l03474"></a>03474 <span class="comment">!     SUBROUTINE SPECTRAL</span>
<a name="l03475"></a>03475 <span class="comment">!     ===================</span>
<a name="l03476"></a>03476 
<a name="l03477"></a><a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">03477</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">spectral</a>
<a name="l03478"></a>03478       use <span class="keywordflow">pumamod</span>
<a name="l03479"></a>03479 
<a name="l03480"></a>03480 <span class="comment">!*    Add adiabatic and diabatic tendencies - perform leapfrog</span>
<a name="l03481"></a>03481 
<a name="l03482"></a>03482 <span class="comment">!     The adiabatic tendencies are added using the semi implicit scheme</span>
<a name="l03483"></a>03483 <span class="comment">!     Hoskins and Simmons 1975 (Q.J.R.Meteorol.Soc.,101,637-655) (HS75)</span>
<a name="l03484"></a>03484 <span class="comment">!     To compare the code directly with HS75 the following notes might</span>
<a name="l03485"></a>03485 <span class="comment">!     be helpful (in addition to the comments below):</span>
<a name="l03486"></a>03486 
<a name="l03487"></a>03487 <span class="comment">!     Name rule for global arrays &lt;abc&gt;:</span>
<a name="l03488"></a>03488 <span class="comment">!     a : representation (s=spectral, g=grid, z=local)</span>
<a name="l03489"></a>03489 <span class="comment">!     b : variable (p=ln(ps), d=divergence, z=vorticity, t=temperature)</span>
<a name="l03490"></a>03490 <span class="comment">!     c : modifier (m=previous timestep, p=present timestep, t=tendency)</span>
<a name="l03491"></a>03491 
<a name="l03492"></a>03492 <span class="comment">!     global arrays variable in time</span>
<a name="l03493"></a>03493 <span class="comment">!     ------------------------------</span>
<a name="l03494"></a>03494 
<a name="l03495"></a>03495 <span class="comment">!     spt - pressure    tendency HS75 (10)</span>
<a name="l03496"></a>03496 <span class="comment">!     sdt - divergence  tendency HS75 ( 8)</span>
<a name="l03497"></a>03497 <span class="comment">!     szt - vorticity   tendency</span>
<a name="l03498"></a>03498 <span class="comment">!     stt - temperature tendency HS75 ( 9)</span>
<a name="l03499"></a>03499 
<a name="l03500"></a>03500 <span class="comment">!     spm - pressure    at previous timestep</span>
<a name="l03501"></a>03501 <span class="comment">!     sdm - divergence  at previous timestep</span>
<a name="l03502"></a>03502 <span class="comment">!     szm - vorticity   at previous timestep</span>
<a name="l03503"></a>03503 <span class="comment">!     stm - temperature at previous timestep</span>
<a name="l03504"></a>03504 
<a name="l03505"></a>03505 <span class="comment">!     spp - pressure    at present timestep</span>
<a name="l03506"></a>03506 <span class="comment">!     sdp - divergence  at present timestep</span>
<a name="l03507"></a>03507 <span class="comment">!     szp - vorticity   at present timestep</span>
<a name="l03508"></a>03508 <span class="comment">!     stp - temperature at present timestep</span>
<a name="l03509"></a>03509 
<a name="l03510"></a>03510 <span class="comment">!     global arrays constant in time</span>
<a name="l03511"></a>03511 <span class="comment">!     ------------------------------</span>
<a name="l03512"></a>03512 
<a name="l03513"></a>03513 <span class="comment">!     sak(NSPP)      -     = hyper diffusion</span>
<a name="l03514"></a>03514 <span class="comment">!     sop(NSPP)      - g*  = orography as geopotential</span>
<a name="l03515"></a>03515 <span class="comment">!     srp1(NSPP,NLEV) - Tr = radiative equilibrium temperature (annual mean)</span>
<a name="l03516"></a>03516 <span class="comment">!     srp2(NSPP,NLEV) - Tr = radiative equilibrium temperature (annual cycle)</span>
<a name="l03517"></a>03517 <span class="comment">!     nindex(NSPP)   - n   = total wavenumber n for spectral modes</span>
<a name="l03518"></a>03518 <span class="comment">!     srcn(NSPP)   - 1/Cn  = 1.0 / (n * (n+1))</span>
<a name="l03519"></a>03519 <span class="comment">!     damp(NLEV)  1/tau R  = time constant for newtonian cooling</span>
<a name="l03520"></a>03520 <span class="comment">!     fric(NLEV)  1/tau F  = time constant for Rayleigh friction</span>
<a name="l03521"></a>03521 
<a name="l03522"></a>03522       <span class="keywordtype">real</span> zpm(NSPP)      <span class="comment">! new spm</span>
<a name="l03523"></a>03523       <span class="keywordtype">real</span> zdm(NSPP,NLEV) <span class="comment">! new sdm</span>
<a name="l03524"></a>03524       <span class="keywordtype">real</span> zzm(NSPP,NLEV) <span class="comment">! new szm</span>
<a name="l03525"></a>03525       <span class="keywordtype">real</span> ztm(NSPP,NLEV) <span class="comment">! new stm</span>
<a name="l03526"></a>03526       <span class="keywordtype">real</span> zwp(NSPP)      <span class="comment">! timefilter delta pm</span>
<a name="l03527"></a>03527       <span class="keywordtype">real</span> zwd(NSPP,NLEV) <span class="comment">! timefilter delta sd</span>
<a name="l03528"></a>03528       <span class="keywordtype">real</span> zwz(NSPP,NLEV) <span class="comment">! timefilter delta sz</span>
<a name="l03529"></a>03529       <span class="keywordtype">real</span> zwt(NSPP,NLEV) <span class="comment">! timefilter delta st</span>
<a name="l03530"></a>03530       <span class="keywordtype">real</span> zsrp(NSPP)     <span class="comment">! restoring temperature (mean + annual cycle)</span>
<a name="l03531"></a>03531 
<a name="l03532"></a>03532       <span class="keywordtype">real</span> zgt(NSPP,NLEV) <span class="comment">! work array</span>
<a name="l03533"></a>03533 
<a name="l03534"></a>03534       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zstte(:,:,:) <span class="comment">! temp. tendencies for energy diag.</span>
<a name="l03535"></a>03535       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zszte(:,:,:) <span class="comment">! vort. tendencies for energy recycling</span>
<a name="l03536"></a>03536       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zsdte(:,:,:) <span class="comment">! div. tendencies for energy recycling</span>
<a name="l03537"></a>03537       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zdps(:)      <span class="comment">! surf pressure for energy diag</span>
<a name="l03538"></a>03538       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zsp(:)       <span class="comment">! surf pressure spectral</span>
<a name="l03539"></a>03539       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zspf(:)      <span class="comment">! surf pressure spectral</span>
<a name="l03540"></a>03540       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zspt(:)      <span class="comment">! surf pressure tendency </span>
<a name="l03541"></a>03541 
<a name="l03542"></a>03542       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zst(:,:)     <span class="comment">! temperature for entropy diagnostics</span>
<a name="l03543"></a>03543       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zstt(:,:)    <span class="comment">! tem. tendencies for entropy diag.</span>
<a name="l03544"></a>03544       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: ztgp(:,:)    <span class="comment">! </span>
<a name="l03545"></a>03545       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zdtgp(:,:)   <span class="comment">! </span>
<a name="l03546"></a>03546       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zsum1(:)
<a name="l03547"></a>03547       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zgw(:)
<a name="l03548"></a>03548 
<a name="l03549"></a>03549 <span class="comment">!     0. Special code for experiments with mode filtering</span>
<a name="l03550"></a>03550 
<a name="l03551"></a>03551       <span class="keyword">if</span> (lspecsel) call <a class="code" href="puma_8f90.html#a9a1e7493444984ad2c2161609dbb6e69">filter_spectral_modes</a>
<a name="l03552"></a>03552 
<a name="l03553"></a>03553 <span class="comment">!     1. Initialize local arrays</span>
<a name="l03554"></a>03554 
<a name="l03555"></a>03555       zpm(:)   = spp(:)
<a name="l03556"></a>03556       zdm(:,:) = sdp(:,:)
<a name="l03557"></a>03557       zzm(:,:) = szp(:,:)
<a name="l03558"></a>03558       ztm(:,:) = stp(:,:)
<a name="l03559"></a>03559 <span class="comment">!</span>
<a name="l03560"></a>03560 <span class="comment">!     allocate diagnostic arrays if needed</span>
<a name="l03561"></a>03561 <span class="comment">!</span>
<a name="l03562"></a>03562       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03563"></a>03563        <span class="keyword">allocate</span>(zstte(NSPP,NLEV,3))
<a name="l03564"></a>03564       <span class="keyword">endif</span>
<a name="l03565"></a>03565       <span class="keyword">if</span>(ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03566"></a>03566        <span class="keyword">allocate</span>(zszte(NSPP,NLEV,2))
<a name="l03567"></a>03567        <span class="keyword">allocate</span>(zsdte(NSPP,NLEV,2))
<a name="l03568"></a>03568       <span class="keyword">endif</span>
<a name="l03569"></a>03569 <span class="comment">!</span>
<a name="l03570"></a>03570 <span class="comment">!     allocate and compute surface pressure if needed</span>
<a name="l03571"></a>03571 <span class="comment">!</span>
<a name="l03572"></a>03572       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0 .or. ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03573"></a>03573        <span class="keyword">allocate</span>(zspt(NSPP))
<a name="l03574"></a>03574        <span class="keyword">allocate</span>(zsp(NSPP))
<a name="l03575"></a>03575       <span class="keyword">endif</span>
<a name="l03576"></a>03576 
<a name="l03577"></a>03577 <span class="comment">!     2. Calculate divergence on timelevel t (sdt) HS75 (17)</span>
<a name="l03578"></a>03578 <span class="comment">!        which will replace the divergence tendency sdt</span>
<a name="l03579"></a>03579 <span class="comment">!        (semi implicit scheme)</span>
<a name="l03580"></a>03580 
<a name="l03581"></a>03581 <span class="comment">!        The vertical scheme has being changed to the ECMWF scheme</span>
<a name="l03582"></a>03582 <span class="comment">!        (see e.g. Simmons and Burridge 1981, Mon.Wea.Rev.,109,758-766).</span>
<a name="l03583"></a>03583 <span class="comment">!        in this scheme, matrix xlphi (g) differs from that in HS75.</span>
<a name="l03584"></a>03584 
<a name="l03585"></a>03585 <span class="comment">!         z0 : reference temperature To</span>
<a name="l03586"></a>03586 <span class="comment">!         zq : 1.0 / Cn</span>
<a name="l03587"></a>03587 <span class="comment">!         zt : xlphi * script T - To * script P</span>
<a name="l03588"></a>03588 <span class="comment">!         zm : xlphi * T        + To * ln(Ps)(t-dt)</span>
<a name="l03589"></a>03589 
<a name="l03590"></a>03590 <span class="comment">!         (note that phi is needed in HS75 (17) and, therefore,</span>
<a name="l03591"></a>03591 <span class="comment">!         the surface geopotential phi* [sop] is added</span>
<a name="l03592"></a>03592 
<a name="l03593"></a>03593       <span class="keyword">do</span> jlev=1,NLEV
<a name="l03594"></a>03594          z0 = t0(jlev)
<a name="l03595"></a>03595          <span class="keyword">do</span> jsp=1,NSPP
<a name="l03596"></a>03596             zq = srcn(jsp)                   <span class="comment">! 1.0 / (n * (n + 1))</span>
<a name="l03597"></a>03597             zt = dot_product(xlphi(:,jlev),stt(jsp,:)) - z0 * spt(jsp)
<a name="l03598"></a>03598             zm = dot_product(xlphi(:,jlev),stm(jsp,:)) + z0 * spm(jsp)
<a name="l03599"></a>03599             za = sdt(jsp,jlev) * zq
<a name="l03600"></a>03600             zb = sdm(jsp,jlev) * zq
<a name="l03601"></a>03601             zgt(jsp,jlev) = zb + delt * (za + zm + sop(jsp) + zt * delt)
<a name="l03602"></a>03602          <span class="keyword">enddo</span>
<a name="l03603"></a>03603       <span class="keyword">enddo</span>
<a name="l03604"></a>03604 
<a name="l03605"></a>03605 <span class="comment">!     bm1 is the invers of matrix (1/cn I+B dt**2) (lhs HS75 (17))</span>
<a name="l03606"></a>03606 
<a name="l03607"></a>03607       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03608"></a>03608          <span class="keyword">do</span> jsp = 1 , NSPP
<a name="l03609"></a>03609             jn = nindex(jsp)            <span class="comment">! total wavenumber n</span>
<a name="l03610"></a>03610             sdt(jsp,jlev) = dot_product(zgt(jsp,:),bm1(:,jlev,jn))
<a name="l03611"></a>03611          <span class="keyword">enddo</span>
<a name="l03612"></a>03612       <span class="keyword">enddo</span>
<a name="l03613"></a>03613 
<a name="l03614"></a>03614 <span class="comment">!     3. Calculate surface pressure tendency -ln(ps) HS75 (15)</span>
<a name="l03615"></a>03615 
<a name="l03616"></a>03616       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03617"></a>03617          spt(:) = spt(:) + dsigma(jlev) * sdt(:,jlev)
<a name="l03618"></a>03618       <span class="keyword">enddo</span>
<a name="l03619"></a>03619 
<a name="l03620"></a>03620 <span class="comment">!     4. Calculate temperature tendency   HS75 (14)</span>
<a name="l03621"></a>03621 
<a name="l03622"></a>03622       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03623"></a>03623        <span class="keyword">do</span> jsp = 1 , NSPP
<a name="l03624"></a>03624         stt(jsp,jlev)=stt(jsp,jlev)-dot_product(xlt(:,jlev),sdt(jsp,:))
<a name="l03625"></a>03625        <span class="keyword">enddo</span>
<a name="l03626"></a>03626       <span class="keyword">enddo</span>
<a name="l03627"></a>03627 
<a name="l03628"></a>03628 <span class="comment">!     5. Add tendencies</span>
<a name="l03629"></a>03629 
<a name="l03630"></a>03630       spp(:)   = spm(:) - delt2 * spt(:)     <span class="comment">! spt = -ln(ps) tendency</span>
<a name="l03631"></a>03631       sdp(:,:) =   2.0 * sdt(:,:) - sdm(:,:) <span class="comment">! sdt = sdm + delt * tend.</span>
<a name="l03632"></a>03632       szp(:,:) = delt2 * szt(:,:) + szm(:,:) <span class="comment">! vorticity</span>
<a name="l03633"></a>03633       stp(:,:) = delt2 * stt(:,:) + stm(:,:) <span class="comment">! temperature</span>
<a name="l03634"></a>03634 
<a name="l03635"></a>03635       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03636"></a>03636        zspt(:)=-spt(:)
<a name="l03637"></a>03637        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stm,stt,spm,zspt,denergy(:,1))
<a name="l03638"></a>03638       <span class="keyword">endif</span>
<a name="l03639"></a>03639       <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03640"></a>03640        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stm,stt,spm,dentropy(:,1))
<a name="l03641"></a>03641       <span class="keyword">endif</span>
<a name="l03642"></a>03642 
<a name="l03643"></a>03643 <span class="comment">!     6. Calculate newtonian cooling, friction and biharmonic diffusion</span>
<a name="l03644"></a>03644 <span class="comment">!        (srp - stp) * damp = (Tr&#39; -T&#39;) / tau R = newtonian cooling</span>
<a name="l03645"></a>03645 <span class="comment">!        srp1 = annual mean  component</span>
<a name="l03646"></a>03646 <span class="comment">!        srp2 = annual cycle component</span>
<a name="l03647"></a>03647 <span class="comment">!        sak  = diffusion</span>
<a name="l03648"></a>03648 <span class="comment">!        fric = friction</span>
<a name="l03649"></a>03649 <span class="comment">!        zampl = annual cycle</span>
<a name="l03650"></a>03650 
<a name="l03651"></a>03651       zampl = cos((<span class="keywordtype">real</span>(nstep)-pac)*tac)
<a name="l03652"></a>03652 
<a name="l03653"></a>03653       <span class="keyword">if</span> (nhelsua == 0 .or. nhelsua == 1) <span class="keyword">then</span>
<a name="l03654"></a>03654          <span class="keyword">do</span> jlev=1,NLEV
<a name="l03655"></a>03655             zsrp(:)=srp1(:,jlev)+srp2(:,jlev)*zampl
<a name="l03656"></a>03656             sdt(:,jlev) =  sdp(:,jlev) * (sak(1:NSPP) - fric(jlev))
<a name="l03657"></a>03657             szt(:,jlev) =  szp(:,jlev) * (sak(1:NSPP) - fric(jlev))
<a name="l03658"></a>03658             stt(:,jlev) = (zsrp(:) - stp(:,jlev)) * damp(jlev)          &amp;
<a name="l03659"></a>03659      &amp;                                     + stp(:,jlev)  * sak(1:NSPP)
<a name="l03660"></a>03660             <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03661"></a>03661              zstte(:,jlev,2)=(zsrp(:)-stp(:,jlev))*damp(jlev)
<a name="l03662"></a>03662              zstte(:,jlev,3)=stp(:,jlev)*sak(1:NSPP)
<a name="l03663"></a>03663             <span class="keyword">endif</span>
<a name="l03664"></a>03664             <span class="keyword">if</span>(ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03665"></a>03665              zsdte(:,jlev,1) =  -sdp(:,jlev) * fric(jlev)
<a name="l03666"></a>03666              zszte(:,jlev,1) =  -szp(:,jlev) * fric(jlev)
<a name="l03667"></a>03667              zsdte(:,jlev,2) =  sdp(:,jlev) * sak(1:NSPP)
<a name="l03668"></a>03668              zszte(:,jlev,2) =  szp(:,jlev) * sak(1:NSPP)
<a name="l03669"></a>03669             <span class="keyword">endif</span>
<a name="l03670"></a>03670          <span class="keyword">enddo</span>
<a name="l03671"></a>03671       elseif (nhelsua == 2 .or. nhelsua == 3 .or. ndiagp &gt; 0) <span class="keyword">then</span>
<a name="l03672"></a>03672          <span class="keyword">if</span> (ndiagp == 0) <span class="keyword">then</span>
<a name="l03673"></a>03673             call <a class="code" href="puma_8f90.html#a6cbd3f404dc5fbac334929a64cf2757f">heatgp</a>(zampl)  <span class="comment">! stt(:,:) = Newtonian cooling</span>
<a name="l03674"></a>03674          <span class="keyword">else</span>
<a name="l03675"></a>03675             call <a class="code" href="puma_8f90.html#a28029d854398252d4d3b4eb9f161fed7">diagp</a>(zampl)  <span class="comment">! stt(:,:) = Newtonian cooling</span>
<a name="l03676"></a>03676          <span class="keyword">endif</span>
<a name="l03677"></a>03677          <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03678"></a>03678           zstte(:,:,2)=stt(:,:)
<a name="l03679"></a>03679          <span class="keyword">endif</span>
<a name="l03680"></a>03680          <span class="keyword">do</span> jlev=1,NLEV
<a name="l03681"></a>03681             sdt(:,jlev) = sdp(:,jlev) * (sak(1:NSPP) - fric(jlev))
<a name="l03682"></a>03682             szt(:,jlev) = szp(:,jlev) * (sak(1:NSPP) - fric(jlev))
<a name="l03683"></a>03683             stt(:,jlev) = stt(:,jlev) + stp(:,jlev) * sak(1:NSPP)
<a name="l03684"></a>03684             <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03685"></a>03685              zstte(:,jlev,3)=stp(:,jlev)*sak(1:NSPP)
<a name="l03686"></a>03686             <span class="keyword">endif</span>
<a name="l03687"></a>03687             <span class="keyword">if</span>(ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03688"></a>03688              zsdte(:,jlev,1) =  -sdp(:,jlev) * fric(jlev)
<a name="l03689"></a>03689              zszte(:,jlev,1) =  -szp(:,jlev) * fric(jlev)
<a name="l03690"></a>03690              zsdte(:,jlev,2) =  sdp(:,jlev) * sak(1:NSPP)
<a name="l03691"></a>03691              zszte(:,jlev,2) =  szp(:,jlev) * sak(1:NSPP)
<a name="l03692"></a>03692             <span class="keyword">endif</span>
<a name="l03693"></a>03693          <span class="keyword">enddo</span>
<a name="l03694"></a>03694       <span class="keyword">endif</span>
<a name="l03695"></a>03695 
<a name="l03696"></a>03696 <span class="comment">!        Conserve ln(ps) by forcing mode(0,0) to zero</span>
<a name="l03697"></a>03697 <span class="comment">!        Correct vorticity by canceling the friction and diffusion</span>
<a name="l03698"></a>03698 <span class="comment">!        applied to planetary vorticity</span>
<a name="l03699"></a>03699 <span class="comment">!        Only root node processes the first NSPP modes</span>
<a name="l03700"></a>03700 
<a name="l03701"></a>03701       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03702"></a>03702        zspt(:)=0.
<a name="l03703"></a>03703        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,2),spp,zspt,denergy(:,2))
<a name="l03704"></a>03704        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,3),spp,zspt,denergy(:,3))
<a name="l03705"></a>03705       <span class="keyword">endif</span>
<a name="l03706"></a>03706       <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03707"></a>03707        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,2),spp,dentropy(:,2))
<a name="l03708"></a>03708        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,3),spp,dentropy(:,3))
<a name="l03709"></a>03709       <span class="keyword">endif</span>
<a name="l03710"></a>03710       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0 .or. ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03711"></a>03711        zsp(:)=spp(:)
<a name="l03712"></a>03712        zstte(:,:,1)=stt(:,:)
<a name="l03713"></a>03713       <span class="keyword">endif</span>
<a name="l03714"></a>03714 
<a name="l03715"></a>03715       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l03716"></a>03716          spp(1) = 0.0
<a name="l03717"></a>03717          spp(2) = 0.0
<a name="l03718"></a>03718          szt(3,:) = szt(3,:) + plavor * (fric(:) - sak(3))
<a name="l03719"></a>03719          <span class="keyword">if</span>(ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03720"></a>03720           zszte(3,:,1) = zszte(3,:,1) + plavor * fric(:)
<a name="l03721"></a>03721           zszte(3,:,2) = zszte(3,:,2) - plavor * sak(3)
<a name="l03722"></a>03722          <span class="keyword">endif</span>
<a name="l03723"></a>03723       <span class="keyword">endif</span>
<a name="l03724"></a>03724 <span class="comment">!</span>
<a name="l03725"></a>03725 <span class="comment">!     6b) call for vertical diffusion</span>
<a name="l03726"></a>03726 <span class="comment">!</span>
<a name="l03727"></a>03727 
<a name="l03728"></a>03728       <span class="keyword">if</span>(dvdiff &gt; 0.) call <a class="code" href="puma_8f90.html#ad1bea0bb9fdda56c5251fa64e712b7b1">vdiff</a>(stp,szp,sdp,stt,szt,sdt)
<a name="l03729"></a>03729 
<a name="l03730"></a>03730 <span class="comment">!</span>
<a name="l03731"></a>03731 <span class="comment">!     recycle kin energy dissipation</span>
<a name="l03732"></a>03732 <span class="comment">! </span>
<a name="l03733"></a>03733 
<a name="l03734"></a>03734       <span class="keyword">if</span>(ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03735"></a>03735        call <a class="code" href="puma_8f90.html#a079a9ea6caa3eb9d5ef5e0c82f76a2b9">mkdheat</a>(zszte(:,:,1),zszte(:,:,2)                           &amp;
<a name="l03736"></a>03736      &amp;             ,zsdte(:,:,1),zsdte(:,:,2),zsp)
<a name="l03737"></a>03737       <span class="keyword">endif</span>
<a name="l03738"></a>03738 
<a name="l03739"></a>03739 
<a name="l03740"></a>03740       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03741"></a>03741        zstte(:,:,1)=stt(:,:)-zstte(:,:,1)
<a name="l03742"></a>03742       <span class="keyword">endif</span>
<a name="l03743"></a>03743       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03744"></a>03744        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,1),zsp,zspt,denergy(:,4))
<a name="l03745"></a>03745       <span class="keyword">endif</span>
<a name="l03746"></a>03746       <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03747"></a>03747        zstte(:,:,1)=stt(:,:)-zstte(:,:,1)
<a name="l03748"></a>03748        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,1),zsp,dentropy(:,4))
<a name="l03749"></a>03749       <span class="keyword">endif</span>
<a name="l03750"></a>03750       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03751"></a>03751        zstte(:,:,1)=0.
<a name="l03752"></a>03752        zspt(:)=(spp(:)-zsp(:))/delt2
<a name="l03753"></a>03753       <span class="keyword">endif</span>
<a name="l03754"></a>03754       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03755"></a>03755        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,1),zsp,zspt,denergy(:,8))
<a name="l03756"></a>03756       <span class="keyword">endif</span>
<a name="l03757"></a>03757       <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03758"></a>03758        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,1),zsp,dentropy(:,8))
<a name="l03759"></a>03759       <span class="keyword">endif</span>
<a name="l03760"></a>03760 
<a name="l03761"></a>03761 <span class="comment">!</span>
<a name="l03762"></a>03762 <span class="comment">!     diagnostics of efficiency</span>
<a name="l03763"></a>03763 <span class="comment">!</span>
<a name="l03764"></a>03764 
<a name="l03765"></a>03765       <span class="keyword">if</span>(ndheat &gt; 1) <span class="keyword">then</span>
<a name="l03766"></a>03766        zcp=gascon/akap
<a name="l03767"></a>03767        <span class="keyword">allocate</span>(zst(NESP,NLEV))
<a name="l03768"></a>03768        <span class="keyword">allocate</span>(zstt(NESP,NLEV))
<a name="l03769"></a>03769        <span class="keyword">allocate</span>(zspf(NESP))
<a name="l03770"></a>03770        <span class="keyword">allocate</span>(ztgp(NHOR,NLEV))
<a name="l03771"></a>03771        <span class="keyword">allocate</span>(zdtgp(NHOR,NLEV))
<a name="l03772"></a>03772        <span class="keyword">allocate</span>(zdps(NHOR))
<a name="l03773"></a>03773        <span class="keyword">allocate</span>(zsum1(4))
<a name="l03774"></a>03774        <span class="keyword">allocate</span>(zgw(NHOR))
<a name="l03775"></a>03775        jhor=0
<a name="l03776"></a>03776        <span class="keyword">do</span> jlat=1,NHPP
<a name="l03777"></a>03777         <span class="keyword">do</span> jlon=1,NLON*2
<a name="l03778"></a>03778          jhor=jhor+1
<a name="l03779"></a>03779          zgw(jhor)=gwd(jlat)
<a name="l03780"></a>03780         <span class="keyword">enddo</span>
<a name="l03781"></a>03781        <span class="keyword">enddo</span>
<a name="l03782"></a>03782        call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zst,stp,NLEV)
<a name="l03783"></a>03783        call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zstt,stt,NLEV)
<a name="l03784"></a>03784        call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,zsp,1)
<a name="l03785"></a>03785        <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l03786"></a>03786           call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zst(1,jlev),ztgp(1,jlev))
<a name="l03787"></a>03787           call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zstt(1,jlev),zdtgp(1,jlev))
<a name="l03788"></a>03788        <span class="keyword">enddo</span>
<a name="l03789"></a>03789        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zdps)
<a name="l03790"></a>03790        call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(ztgp,NLON,NLPP*NLEV)
<a name="l03791"></a>03791        call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zdtgp,NLON,NLPP*NLEV)
<a name="l03792"></a>03792        call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zdps,NLON,NLPP)
<a name="l03793"></a>03793        zdps(:)=psurf*exp(zdps(:))
<a name="l03794"></a>03794        zsum1(:)=0.
<a name="l03795"></a>03795        <span class="keyword">do</span> jlev=1,NLEV
<a name="l03796"></a>03796         ztgp(:,jlev)=ct*(ztgp(:,jlev)+t0(jlev))
<a name="l03797"></a>03797         zdtgp(:,jlev)=ct*ww*zdtgp(:,jlev)
<a name="l03798"></a>03798         zsum1(1)=zsum1(1)+SUM(zdtgp(:,jlev)*zgw(:)                      &amp;
<a name="l03799"></a>03799      &amp;                       *zcp*zdps(:)/ga*dsigma(jlev)               &amp;
<a name="l03800"></a>03800      &amp;                       ,mask=(zdtgp(:,jlev) &gt;= 0.))
<a name="l03801"></a>03801         zsum1(2)=zsum1(2)+SUM(zdtgp(:,jlev)*zgw(:)                      &amp;
<a name="l03802"></a>03802      &amp;                       *zcp*zdps(:)/ga*dsigma(jlev)               &amp;
<a name="l03803"></a>03803      &amp;                       ,mask=(zdtgp(:,jlev) &lt; 0.))
<a name="l03804"></a>03804         zsum1(3)=zsum1(3)+SUM(zdtgp(:,jlev)/ztgp(:,jlev)*zgw(:)         &amp;
<a name="l03805"></a>03805      &amp;                       *zcp*zdps(:)/ga*dsigma(jlev)               &amp;
<a name="l03806"></a>03806      &amp;                       ,mask=(zdtgp(:,jlev) &gt;= 0.))
<a name="l03807"></a>03807         zsum1(4)=zsum1(4)+SUM(zdtgp(:,jlev)/ztgp(:,jlev)*zgw(:)         &amp;
<a name="l03808"></a>03808      &amp;                       *zcp*zdps(:)/ga*dsigma(jlev)               &amp;
<a name="l03809"></a>03809      &amp;                       ,mask=(zdtgp(:,jlev) &lt; 0.))
<a name="l03810"></a>03810        <span class="keyword">enddo</span>
<a name="l03811"></a>03811        zsum3=SUM(zgw(:))
<a name="l03812"></a>03812        call <a class="code" href="mpimod_8f90.html#ad703e6ecd123e9b8280322e402d57d20">mpsumbcr</a>(zsum1,4)
<a name="l03813"></a>03813        call <a class="code" href="mpimod_8f90.html#ad703e6ecd123e9b8280322e402d57d20">mpsumbcr</a>(zsum3,1)
<a name="l03814"></a>03814        zsum1(:)=zsum1(:)/zsum3
<a name="l03815"></a>03815        <span class="keyword">if</span>(mypid == NROOT) <span class="keyword">then</span>
<a name="l03816"></a>03816         ztp=zsum1(1)/zsum1(3)
<a name="l03817"></a>03817         zztm=zsum1(2)/zsum1(4)
<a name="l03818"></a>03818         <span class="keyword">write</span>(9,*) zsum1(:),zsum1(1)/zsum1(3),zsum1(2)/zsum1(4)         &amp;
<a name="l03819"></a>03819      &amp;            ,(ztp-zztm)/ztp
<a name="l03820"></a>03820        <span class="keyword">endif</span>
<a name="l03821"></a>03821        <span class="keyword">deallocate</span>(zst)
<a name="l03822"></a>03822        <span class="keyword">deallocate</span>(zstt)
<a name="l03823"></a>03823        <span class="keyword">deallocate</span>(zspf)
<a name="l03824"></a>03824        <span class="keyword">deallocate</span>(ztgp)
<a name="l03825"></a>03825        <span class="keyword">deallocate</span>(zdps)
<a name="l03826"></a>03826        <span class="keyword">deallocate</span>(zdtgp)
<a name="l03827"></a>03827        <span class="keyword">deallocate</span>(zsum1)
<a name="l03828"></a>03828        <span class="keyword">deallocate</span>(zgw)
<a name="l03829"></a>03829       <span class="keyword">endif</span>
<a name="l03830"></a>03830 
<a name="l03831"></a>03831 <span class="comment">!     7. Add newtonian cooling, friction and diffusion tendencies</span>
<a name="l03832"></a>03832 
<a name="l03833"></a>03833       sdp(:,:) = sdp(:,:) + delt2 * sdt(:,:)
<a name="l03834"></a>03834       szp(:,:) = szp(:,:) + delt2 * szt(:,:)
<a name="l03835"></a>03835       stp(:,:) = stp(:,:) + delt2 * stt(:,:)
<a name="l03836"></a>03836 
<a name="l03837"></a>03837 <span class="comment">!     11. Coupling for synchronization runs</span>
<a name="l03838"></a>03838 
<a name="l03839"></a>03839       <span class="keyword">if</span> (mrnum == 2 .and. nsync &gt; 0) <span class="keyword">then</span>
<a name="l03840"></a>03840          call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(stp,std,NESP,NLEV)
<a name="l03841"></a>03841          call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(sdp,sdd,NESP,NLEV)
<a name="l03842"></a>03842          call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(szp,szd,NESP,NLEV)
<a name="l03843"></a>03843          call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(spp,spd,NESP,   1)
<a name="l03844"></a>03844          stp(:,:) = stp(:,:) + syncstr * std(:,:)
<a name="l03845"></a>03845          sdp(:,:) = sdp(:,:) + syncstr * sdd(:,:)
<a name="l03846"></a>03846          szp(:,:) = szp(:,:) + syncstr * szd(:,:)
<a name="l03847"></a>03847          spp(:  ) = spp(:  ) + syncstr * spd(:  )
<a name="l03848"></a>03848 
<a name="l03849"></a>03849       <span class="keyword">endif</span>
<a name="l03850"></a>03850 
<a name="l03851"></a>03851 <span class="comment">!     8. Apply Robert Asselin time filter (not for short initial timesteps)</span>
<a name="l03852"></a>03852 <span class="comment">!        d(t) = pnu * f(t-1) + pnu * f(t+1) - 2 * pnu * f(t)</span>
<a name="l03853"></a>03853 
<a name="l03854"></a>03854       <span class="keyword">if</span> (nkits == 0) <span class="keyword">then</span> 
<a name="l03855"></a>03855          zwp(:)   = pnu * (spm(:)   + spp(:)   - 2.0 * zpm(:)  )
<a name="l03856"></a>03856          zwd(:,:) = pnu * (sdm(:,:) + sdp(:,:) - 2.0 * zdm(:,:))
<a name="l03857"></a>03857          zwz(:,:) = pnu * (szm(:,:) + szp(:,:) - 2.0 * zzm(:,:))
<a name="l03858"></a>03858          zwt(:,:) = pnu * (stm(:,:) + stp(:,:) - 2.0 * ztm(:,:))
<a name="l03859"></a>03859 
<a name="l03860"></a>03860 <span class="comment">!        Add Robert-Asselin-Williams filter value to f(t)</span>
<a name="l03861"></a>03861 
<a name="l03862"></a>03862          spm(:)   = zpm(:)   + alpha * zwp(:)
<a name="l03863"></a>03863          sdm(:,:) = zdm(:,:) + alpha * zwd(:,:)
<a name="l03864"></a>03864          szm(:,:) = zzm(:,:) + alpha * zwz(:,:)
<a name="l03865"></a>03865          stm(:,:) = ztm(:,:) + alpha * zwt(:,:)
<a name="l03866"></a>03866 
<a name="l03867"></a>03867 <span class="comment">!        Add filter value to f(t+1)</span>
<a name="l03868"></a>03868          
<a name="l03869"></a>03869          spp(:)   = spp(:)   - (1.0 - alpha) * zwp(:)
<a name="l03870"></a>03870          sdp(:,:) = sdp(:,:) - (1.0 - alpha) * zwd(:,:)
<a name="l03871"></a>03871          szp(:,:) = szp(:,:) - (1.0 - alpha) * zwz(:,:)
<a name="l03872"></a>03872          stp(:,:) = stp(:,:) - (1.0 - alpha) * zwt(:,:)
<a name="l03873"></a>03873       <span class="keyword">endif</span>
<a name="l03874"></a>03874 
<a name="l03875"></a>03875       <span class="keyword">if</span> (nenergy &gt; 0 .or. nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03876"></a>03876        zstte(:,:,1)=(stm(:,:)-ztm(:,:))/delt2
<a name="l03877"></a>03877        zspt(:)=(spm(:)-zpm(:))/delt2
<a name="l03878"></a>03878       <span class="keyword">endif</span>
<a name="l03879"></a>03879       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l03880"></a>03880        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(ztm,zstte(:,:,1),zpm,zspt,denergy(:,9))
<a name="l03881"></a>03881       <span class="keyword">endif</span>
<a name="l03882"></a>03882       <span class="keyword">if</span> (nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03883"></a>03883        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(ztm,zstte(:,:,1),zpm,dentropy(:,9))
<a name="l03884"></a>03884       <span class="keyword">endif</span>
<a name="l03885"></a>03885 
<a name="l03886"></a>03886 <span class="comment">!     9. Save spectral arrays for extended output</span>
<a name="l03887"></a>03887 
<a name="l03888"></a>03888       <span class="keyword">if</span> (nextout == 1 .and. mypid == NROOT) <span class="keyword">then</span>
<a name="l03889"></a>03889          <span class="keyword">if</span> (mod(nstep,nafter) == nafter - 2) <span class="keyword">then</span>
<a name="l03890"></a>03890             <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(st2)) <span class="keyword">allocate</span>(st2(nesp,nlev))
<a name="l03891"></a>03891             st2(:,:) = st(:,:)
<a name="l03892"></a>03892             <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(sp2)) <span class="keyword">allocate</span>(sp2(nesp))
<a name="l03893"></a>03893             sp2(:) = sp(:)
<a name="l03894"></a>03894          <span class="keyword">endif</span>
<a name="l03895"></a>03895          <span class="keyword">if</span> (mod(nstep,nafter) == nafter - 1) <span class="keyword">then</span>
<a name="l03896"></a>03896             <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(st1)) <span class="keyword">allocate</span>(st1(nesp,nlev))
<a name="l03897"></a>03897             st1(:,:) = st(:,:)
<a name="l03898"></a>03898             <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(sp1)) <span class="keyword">allocate</span>(sp1(nesp))
<a name="l03899"></a>03899             sp1(:) = sp(:)
<a name="l03900"></a>03900          <span class="keyword">endif</span>
<a name="l03901"></a>03901       <span class="keyword">endif</span>
<a name="l03902"></a>03902 
<a name="l03903"></a>03903 <span class="comment">!     10. Gather spectral modes from all processes</span>
<a name="l03904"></a>03904 
<a name="l03905"></a>03905       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sp,spp,   1)
<a name="l03906"></a>03906       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sd,sdp,NLEV)
<a name="l03907"></a>03907       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sz,szp,NLEV)
<a name="l03908"></a>03908       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(st,stp,NLEV)
<a name="l03909"></a>03909 
<a name="l03910"></a>03910       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0) <span class="keyword">then</span>
<a name="l03911"></a>03911        <span class="keyword">deallocate</span>(zstte)
<a name="l03912"></a>03912       <span class="keyword">endif</span>
<a name="l03913"></a>03913       <span class="keyword">if</span>(ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03914"></a>03914        <span class="keyword">deallocate</span>(zszte)
<a name="l03915"></a>03915        <span class="keyword">deallocate</span>(zsdte)
<a name="l03916"></a>03916       <span class="keyword">endif</span>
<a name="l03917"></a>03917       <span class="keyword">if</span>(nenergy &gt; 0 .or. nentropy &gt; 0 .or. ndheat &gt; 0) <span class="keyword">then</span>
<a name="l03918"></a>03918        <span class="keyword">deallocate</span>(zsp)
<a name="l03919"></a>03919        <span class="keyword">deallocate</span>(zspt)
<a name="l03920"></a>03920       <span class="keyword">endif</span>
<a name="l03921"></a>03921 
<a name="l03922"></a>03922       return
<a name="l03923"></a>03923 <span class="keyword">      end</span>
<a name="l03924"></a>03924 
<a name="l03925"></a><a class="code" href="puma_8f90.html#a1ad2c0878e366bb7f12ca880fd36c654">03925</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a1ad2c0878e366bb7f12ca880fd36c654">mrcheck</a>(f)
<a name="l03926"></a>03926       use <span class="keywordflow">pumamod</span>
<a name="l03927"></a>03927       <span class="keywordtype">real</span> :: f(*)
<a name="l03928"></a>03928       <span class="keyword">write</span> (nud,<span class="stringliteral">&#39;(/,i3,8f8.4)&#39;</span>)  0,f(1:16:2)
<a name="l03929"></a>03929       <span class="keyword">write</span> (nud,<span class="stringliteral">&#39;(  i3,8f8.4)&#39;</span>)  8,f(17:32:2)
<a name="l03930"></a>03930       <span class="keyword">write</span> (nud,<span class="stringliteral">&#39;(  i3,8f8.4)&#39;</span>) 16,f(33:48:2)
<a name="l03931"></a>03931       <span class="keyword">write</span> (nud,<span class="stringliteral">&#39;(  i3,8f8.4)&#39;</span>) 24,f(49:64:2)
<a name="l03932"></a>03932       <span class="keyword">write</span> (nud,<span class="stringliteral">&#39;(  i3,8f8.4)&#39;</span>) 32,f(65:80:2)
<a name="l03933"></a>03933       return
<a name="l03934"></a>03934 <span class="keyword">      end    </span>
<a name="l03935"></a>03935 
<a name="l03936"></a>03936 
<a name="l03937"></a>03937 <span class="comment">!     ================</span>
<a name="l03938"></a>03938 <span class="comment">!     SUBROUTINE DIAGP</span>
<a name="l03939"></a>03939 <span class="comment">!     ================</span>
<a name="l03940"></a>03940 
<a name="l03941"></a><a class="code" href="puma_8f90.html#a28029d854398252d4d3b4eb9f161fed7">03941</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a28029d854398252d4d3b4eb9f161fed7">diagp</a>(zampl)
<a name="l03942"></a>03942       use <span class="keywordflow">pumamod</span>
<a name="l03943"></a>03943 
<a name="l03944"></a>03944       <span class="keywordtype">real</span> :: zstf(NESP,NLEV)
<a name="l03945"></a>03945       <span class="keywordtype">real</span> :: zgr12(NHOR,NLEV)
<a name="l03946"></a>03946       <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV)
<a name="l03947"></a>03947       <span class="keywordtype">real</span> :: gr12(NHOR,NLEV)
<a name="l03948"></a>03948       <span class="keywordtype">real</span> :: gr12c(NHOR,NLEV)
<a name="l03949"></a>03949      
<a name="l03950"></a>03950 
<a name="l03951"></a>03951       <span class="keywordtype">real</span> :: gdtmp(NHOR)
<a name="l03952"></a>03952 
<a name="l03953"></a>03953       <span class="keywordtype">real</span> :: zampl
<a name="l03954"></a>03954 
<a name="l03955"></a>03955       <span class="comment">!--- transform temperature and divergence to grid point space</span>
<a name="l03956"></a>03956       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(st,stp,NLEV)
<a name="l03957"></a>03957       <span class="keyword">if</span> (nconv &gt; 0) <span class="keyword">then</span>
<a name="l03958"></a>03958          call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sd,sdp,NLEV)
<a name="l03959"></a>03959       <span class="keyword">endif</span>
<a name="l03960"></a>03960       <span class="keyword">do</span> jlev=1,NLEV
<a name="l03961"></a>03961          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(st(1,jlev)   ,gt(1,jlev)   )
<a name="l03962"></a>03962          <span class="keyword">if</span> (nconv &gt; 0) <span class="keyword">then</span>
<a name="l03963"></a>03963             call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sd(1,jlev)   ,gd(1,jlev)   )
<a name="l03964"></a>03964          <span class="keyword">endif</span>
<a name="l03965"></a>03965       <span class="keyword">enddo</span>
<a name="l03966"></a>03966       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gt   ,NLON,NLPP*NLEV)
<a name="l03967"></a>03967       <span class="keyword">if</span> (nconv &gt; 0) <span class="keyword">then</span>
<a name="l03968"></a>03968          call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gd   ,NLON,NLPP*NLEV)
<a name="l03969"></a>03969       <span class="keyword">endif</span>
<a name="l03970"></a>03970 
<a name="l03971"></a>03971 
<a name="l03972"></a>03972       <span class="comment">!--- radiative temperature tendencies </span>
<a name="l03973"></a>03973       gr12(:,:) = gr1(:,:) + gr2(:,:)*zampl
<a name="l03974"></a>03974       zgtt(:,:) = (gr12(:,:) - gt(:,:))*gtdamp(:,:)
<a name="l03975"></a>03975 
<a name="l03976"></a>03976       <span class="comment">!--- add convective temperature tendencies</span>
<a name="l03977"></a>03977       <span class="keyword">if</span> (nconv &gt; 0) <span class="keyword">then</span>
<a name="l03978"></a>03978          gdtmp(:) = gd(:,nlev)
<a name="l03979"></a>03979          <span class="keyword">do</span> jlev = 1,nlev
<a name="l03980"></a>03980             <span class="keyword">where</span> (gdtmp &lt; 0.0)
<a name="l03981"></a>03981                gr12c(:,jlev) = gr1c(:,jlev) + gr2c(:,jlev)*zampl
<a name="l03982"></a>03982                zgtt(:,jlev)  = zgtt(:,jlev) + (gr12c(:,jlev) - gt(:,jlev))*gtdampc(:,jlev)
<a name="l03983"></a>03983             endwhere
<a name="l03984"></a>03984          <span class="keyword">enddo</span>
<a name="l03985"></a>03985       <span class="keyword">endif</span>
<a name="l03986"></a>03986 
<a name="l03987"></a>03987       <span class="comment">!--- transform temperature tendencies to spectral space</span>
<a name="l03988"></a>03988       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zgtt ,NLON,NLPP*NLEV)
<a name="l03989"></a>03989       <span class="keyword">do</span> jlev=1,NLEV
<a name="l03990"></a>03990          call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zgtt(1,jlev),zstf(1,jlev))
<a name="l03991"></a>03991       <span class="keyword">enddo</span>
<a name="l03992"></a>03992       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf,stt,NLEV)
<a name="l03993"></a>03993 
<a name="l03994"></a>03994       return
<a name="l03995"></a>03995 <span class="keyword">      end subroutine diagp</span>
<a name="l03996"></a>03996 
<a name="l03997"></a>03997 <span class="comment">!     =================</span>
<a name="l03998"></a>03998 <span class="comment">!     SUBROUTINE HEATGP</span>
<a name="l03999"></a>03999 <span class="comment">!     =================</span>
<a name="l04000"></a>04000 
<a name="l04001"></a><a class="code" href="puma_8f90.html#a6cbd3f404dc5fbac334929a64cf2757f">04001</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a6cbd3f404dc5fbac334929a64cf2757f">heatgp</a>(zampl)
<a name="l04002"></a>04002       use <span class="keywordflow">pumamod</span>
<a name="l04003"></a>04003 
<a name="l04004"></a>04004       <span class="keywordtype">real</span> :: zsr12(NESP,NLEV)
<a name="l04005"></a>04005       <span class="keywordtype">real</span> :: zsrp12(NSPP,NLEV)
<a name="l04006"></a>04006       <span class="keywordtype">real</span> :: zstf(NESP,NLEV)
<a name="l04007"></a>04007       <span class="keywordtype">real</span> :: zgr12(NHOR,NLEV)
<a name="l04008"></a>04008       <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV)
<a name="l04009"></a>04009 
<a name="l04010"></a>04010       <span class="keywordtype">real</span> :: zampl
<a name="l04011"></a>04011 
<a name="l04012"></a>04012       zsrp12(:,:)=srp1(:,:)+srp2(:,:)*zampl
<a name="l04013"></a>04013       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsr12,zsrp12,NLEV)
<a name="l04014"></a>04014       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(st,stp,NLEV)
<a name="l04015"></a>04015       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04016"></a>04016          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsr12(1,jlev),zgr12(1,jlev))
<a name="l04017"></a>04017          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(st(1,jlev)   ,gt(1,jlev)   )
<a name="l04018"></a>04018       <span class="keyword">enddo</span>
<a name="l04019"></a>04019       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgr12,NLON,NLPP*NLEV)
<a name="l04020"></a>04020       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gt   ,NLON,NLPP*NLEV)
<a name="l04021"></a>04021 
<a name="l04022"></a>04022 <span class="comment">!     Newtonian cooling</span>
<a name="l04023"></a>04023 
<a name="l04024"></a>04024       zgtt(:,:) = (zgr12(:,:) - gt(:,:)) * gtdamp(:,:)
<a name="l04025"></a>04025 
<a name="l04026"></a>04026       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zgtt ,NLON,NLPP*NLEV)
<a name="l04027"></a>04027       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04028"></a>04028          call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zgtt(1,jlev),zstf(1,jlev))
<a name="l04029"></a>04029       <span class="keyword">enddo</span>
<a name="l04030"></a>04030       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf,stt,NLEV)
<a name="l04031"></a>04031 
<a name="l04032"></a>04032       return
<a name="l04033"></a>04033 <span class="keyword">      end</span>
<a name="l04034"></a>04034 
<a name="l04035"></a>04035 <span class="comment">!     ================</span>
<a name="l04036"></a>04036 <span class="comment">!     SUBROUTINE VDIFF</span>
<a name="l04037"></a>04037 <span class="comment">!     ================</span>
<a name="l04038"></a>04038 
<a name="l04039"></a><a class="code" href="puma_8f90.html#ad1bea0bb9fdda56c5251fa64e712b7b1">04039</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ad1bea0bb9fdda56c5251fa64e712b7b1">vdiff</a>(pt,pz,pd,ptt,pzt,pdt)
<a name="l04040"></a>04040       use <span class="keywordflow">pumamod</span>
<a name="l04041"></a>04041 <span class="comment">!</span>
<a name="l04042"></a>04042       parameter(ztref=250.)
<a name="l04043"></a>04043       <span class="keywordtype">real</span> pt(NSPP,NLEV),pz(NSPP,NLEV),pd(NSPP,NLEV)
<a name="l04044"></a>04044       <span class="keywordtype">real</span> ptt(NSPP,NLEV),pzt(NSPP,NLEV),pdt(NSPP,NLEV)
<a name="l04045"></a>04045       <span class="keywordtype">real</span> ztn(NSPP,NLEV),zzn(NSPP,NLEV),zdn(NSPP,NLEV)
<a name="l04046"></a>04046       <span class="keywordtype">real</span> zebs(NLEM)
<a name="l04047"></a>04047       <span class="keywordtype">real</span> zskap(NLEV),zskaph(NLEV)
<a name="l04048"></a>04048       <span class="keywordtype">real</span> zkdiff(NLEM)
<a name="l04049"></a>04049 <span class="comment">!</span>
<a name="l04050"></a>04050       zdelt=delt2/ww
<a name="l04051"></a>04051       zkonst1=ga*zdelt/gascon
<a name="l04052"></a>04052       zkonst2=zkonst1*ga/gascon
<a name="l04053"></a>04053 <span class="comment">!</span>
<a name="l04054"></a>04054       zskap(:)=sigma(:)**akap
<a name="l04055"></a>04055       zskaph(:)=sigmh(:)**akap
<a name="l04056"></a>04056 <span class="comment">!</span>
<a name="l04057"></a>04057 <span class="comment">!     1) modified diffusion coefficents</span>
<a name="l04058"></a>04058 <span class="comment">!</span>
<a name="l04059"></a>04059       <span class="keyword">do</span> jlev=1,NLEM
<a name="l04060"></a>04060        jlp=jlev+1
<a name="l04061"></a>04061        zkdiff(jlev)=zkonst2*sigmh(jlev)*sigmh(jlev)/(ztref*ztref)     &amp;
<a name="l04062"></a>04062      &amp;             *dvdiff/(sigma(jlp)-sigma(jlev))
<a name="l04063"></a>04063       <span class="keyword">enddo</span>
<a name="l04064"></a>04064 <span class="comment">!</span>
<a name="l04065"></a>04065 <span class="comment">!     2. semi implicit scheme</span>
<a name="l04066"></a>04066 <span class="comment">!</span>
<a name="l04067"></a>04067 <span class="comment">!     2a momentum</span>
<a name="l04068"></a>04068 <span class="comment">!</span>
<a name="l04069"></a>04069 <span class="comment">!     top layer elimination</span>
<a name="l04070"></a>04070 <span class="comment">!</span>
<a name="l04071"></a>04071       zebs(1)=zkdiff(1)/(dsigma(1)+zkdiff(1))
<a name="l04072"></a>04072       zdn(:,1)=dsigma(1)*pd(:,1)/(dsigma(1)+zkdiff(1))
<a name="l04073"></a>04073       zzn(:,1)=dsigma(1)*pz(:,1)/(dsigma(1)+zkdiff(1))
<a name="l04074"></a>04074 <span class="comment">!</span>
<a name="l04075"></a>04075 <span class="comment">!     middle layer elimination</span>
<a name="l04076"></a>04076 <span class="comment">!</span>
<a name="l04077"></a>04077       <span class="keyword">do</span> jlev=2,NLEM
<a name="l04078"></a>04078        jlem=jlev-1
<a name="l04079"></a>04079        zebs(jlev)=zkdiff(jlev)/(dsigma(jlev)+zkdiff(jlev)               &amp;
<a name="l04080"></a>04080      &amp;           +zkdiff(jlem)*(1.-zebs(jlem)))
<a name="l04081"></a>04081        zdn(:,jlev)=(pd(:,jlev)*dsigma(jlev)+zkdiff(jlem)*zdn(:,jlem))   &amp;
<a name="l04082"></a>04082      &amp;            /(dsigma(jlev)+zkdiff(jlev)                           &amp;
<a name="l04083"></a>04083      &amp;            +zkdiff(jlem)*(1.-zebs(jlem)))
<a name="l04084"></a>04084        zzn(:,jlev)=(pz(:,jlev)*dsigma(jlev)+zkdiff(jlem)*zzn(:,jlem))   &amp;
<a name="l04085"></a>04085      &amp;            /(dsigma(jlev)+zkdiff(jlev)                           &amp;
<a name="l04086"></a>04086      &amp;            +zkdiff(jlem)*(1.-zebs(jlem)))
<a name="l04087"></a>04087       <span class="keyword">enddo</span>
<a name="l04088"></a>04088 <span class="comment">!</span>
<a name="l04089"></a>04089 <span class="comment">!     bottom layer elimination</span>
<a name="l04090"></a>04090 <span class="comment">!</span>
<a name="l04091"></a>04091       zdn(:,NLEV)=(pd(:,NLEV)*dsigma(NLEV)+zkdiff(NLEM)*zdn(:,NLEM))    &amp;
<a name="l04092"></a>04092      &amp;           /(dsigma(NLEV)+zkdiff(NLEM)*(1.-zebs(NLEM)))
<a name="l04093"></a>04093       zzn(:,NLEV)=(pz(:,NLEV)*dsigma(NLEV)+zkdiff(NLEM)*zzn(:,NLEM))    &amp;
<a name="l04094"></a>04094      &amp;           /(dsigma(NLEV)+zkdiff(NLEM)*(1.-zebs(NLEM)))
<a name="l04095"></a>04095 <span class="comment">!</span>
<a name="l04096"></a>04096 <span class="comment">!     back-substitution</span>
<a name="l04097"></a>04097 <span class="comment">!</span>
<a name="l04098"></a>04098       <span class="keyword">do</span> jlev=NLEM,1,-1
<a name="l04099"></a>04099        jlep=jlev+1
<a name="l04100"></a>04100        zdn(:,jlev)=zdn(:,jlev)+zebs(jlev)*zdn(:,jlep)
<a name="l04101"></a>04101        zzn(:,jlev)=zzn(:,jlev)+zebs(jlev)*zzn(:,jlep)
<a name="l04102"></a>04102       <span class="keyword">enddo</span>
<a name="l04103"></a>04103 <span class="comment">!</span>
<a name="l04104"></a>04104 <span class="comment">!     tendencies</span>
<a name="l04105"></a>04105 <span class="comment">!</span>
<a name="l04106"></a>04106       pdt(:,1:NLEV)=pdt(:,1:NLEV)+(zdn(:,1:NLEV)-pd(:,1:NLEV))/delt2
<a name="l04107"></a>04107       pzt(:,1:NLEV)=pzt(:,1:NLEV)+(zzn(:,1:NLEV)-pz(:,1:NLEV))/delt2
<a name="l04108"></a>04108 <span class="comment">!</span>
<a name="l04109"></a>04109 <span class="comment">!     2c potential temperature</span>
<a name="l04110"></a>04110 <span class="comment">!</span>
<a name="l04111"></a>04111       <span class="keyword">do</span> jlev=1,NLEM
<a name="l04112"></a>04112        zkdiff(jlev)=zkdiff(jlev)*zskaph(jlev)
<a name="l04113"></a>04113       <span class="keyword">enddo</span>
<a name="l04114"></a>04114 <span class="comment">!</span>
<a name="l04115"></a>04115 <span class="comment">!     semi implicit scheme</span>
<a name="l04116"></a>04116 <span class="comment">!</span>
<a name="l04117"></a>04117 <span class="comment">!     top layer elimination</span>
<a name="l04118"></a>04118 <span class="comment">!</span>
<a name="l04119"></a>04119       zebs(1)=zkdiff(1)/(dsigma(1)+zkdiff(1)/zskap(1))
<a name="l04120"></a>04120       ztn(:,1)=dsigma(1)*pt(:,1)/(dsigma(1)+zkdiff(1)/zskap(1))
<a name="l04121"></a>04121 <span class="comment">!</span>
<a name="l04122"></a>04122 <span class="comment">!     middle layer elimination</span>
<a name="l04123"></a>04123 <span class="comment">!</span>
<a name="l04124"></a>04124       <span class="keyword">do</span> jlev=2,NLEM
<a name="l04125"></a>04125        jlem=jlev-1
<a name="l04126"></a>04126        zebs(jlev)=zkdiff(jlev)/(dsigma(jlev)+(zkdiff(jlev)              &amp;
<a name="l04127"></a>04127      &amp;           +zkdiff(jlem)*(1.-zebs(jlem)/zskap(jlem)))/zskap(jlev))
<a name="l04128"></a>04128        ztn(:,jlev)=(pt(:,jlev)*dsigma(jlev)                             &amp;
<a name="l04129"></a>04129      &amp;             +zkdiff(jlem)/zskap(jlem)*ztn(:,jlem))               &amp;
<a name="l04130"></a>04130      &amp;            /(dsigma(jlev)+(zkdiff(jlev)                          &amp;
<a name="l04131"></a>04131      &amp;             +zkdiff(jlem)*(1.-zebs(jlem)/zskap(jlem)))           &amp;
<a name="l04132"></a>04132      &amp;             /zskap(jlev))
<a name="l04133"></a>04133       <span class="keyword">enddo</span>
<a name="l04134"></a>04134 <span class="comment">!</span>
<a name="l04135"></a>04135 <span class="comment">!     bottom layer elimination</span>
<a name="l04136"></a>04136 <span class="comment">!</span>
<a name="l04137"></a>04137       ztn(:,NLEV)=(pt(:,NLEV)*dsigma(NLEV)                              &amp;
<a name="l04138"></a>04138      &amp;            +zkdiff(NLEM)*ztn(:,NLEM)/zskap(NLEM))                &amp;
<a name="l04139"></a>04139      &amp;           /(dsigma(NLEV)+zkdiff(NLEM)/zskap(NLEV)                &amp;
<a name="l04140"></a>04140      &amp;                         *(1.-zebs(NLEM)/zskap(NLEM)))
<a name="l04141"></a>04141 <span class="comment">!</span>
<a name="l04142"></a>04142 <span class="comment">!     back-substitution</span>
<a name="l04143"></a>04143 <span class="comment">!</span>
<a name="l04144"></a>04144       <span class="keyword">do</span> jlev=NLEM,1,-1
<a name="l04145"></a>04145        jlep=jlev+1
<a name="l04146"></a>04146        ztn(:,jlev)=ztn(:,jlev)+zebs(jlev)*ztn(:,jlep)/zskap(jlep)
<a name="l04147"></a>04147       <span class="keyword">enddo</span>
<a name="l04148"></a>04148 <span class="comment">!</span>
<a name="l04149"></a>04149 <span class="comment">!     tendencies</span>
<a name="l04150"></a>04150 <span class="comment">!</span>
<a name="l04151"></a>04151       ptt(:,1:NLEV)=ptt(:,1:NLEV)+(ztn(:,1:NLEV)-pt(:,1:NLEV))/delt2
<a name="l04152"></a>04152 <span class="comment">!</span>
<a name="l04153"></a>04153       return
<a name="l04154"></a>04154 <span class="keyword">      end subroutine vdiff</span>
<a name="l04155"></a>04155 
<a name="l04156"></a>04156 <span class="comment">!     =================</span>
<a name="l04157"></a>04157 <span class="comment">!     SUBROUTINE GASDEV</span>
<a name="l04158"></a>04158 <span class="comment">!     =================</span>
<a name="l04159"></a>04159 
<a name="l04160"></a>04160 <span class="comment">!     Gaussian noise generator with zero mean and unit variance.</span>
<a name="l04161"></a>04161 
<a name="l04162"></a><a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">04162</a>       <span class="keyword">real </span><span class="keyword">function </span><a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>() 
<a name="l04163"></a>04163       use <span class="keywordflow">pumamod</span>
<a name="l04164"></a>04164       <span class="keyword">implicit none</span>
<a name="l04165"></a>04165       <span class="keywordtype">real</span> :: fr, vx, vy, ra
<a name="l04166"></a>04166 
<a name="l04167"></a>04167       <span class="keyword">if</span> (ganext == 0.0) <span class="keyword">then</span>
<a name="l04168"></a>04168          ra = 2.0
<a name="l04169"></a>04169          <span class="keyword">do</span> <span class="keyword">while</span> (ra &gt;= 1.0 .or. ra &lt; 1.0e-20)
<a name="l04170"></a>04170             call random_number(vx)
<a name="l04171"></a>04171             call random_number(vy)
<a name="l04172"></a>04172             vx = 2.0 * vx - 1.0
<a name="l04173"></a>04173             vy = 2.0 * vy - 1.0
<a name="l04174"></a>04174             ra = vx * vx + vy * vy
<a name="l04175"></a>04175          <span class="keyword">enddo</span>
<a name="l04176"></a>04176          fr = sqrt(-2.0 * log(ra) / ra)
<a name="l04177"></a>04177          <a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a> = vx * fr
<a name="l04178"></a>04178          ganext = vy * fr
<a name="l04179"></a>04179       <span class="keyword">else</span>
<a name="l04180"></a>04180          <a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a> = ganext
<a name="l04181"></a>04181          ganext = 0.0
<a name="l04182"></a>04182       <span class="keyword">endif</span>
<a name="l04183"></a>04183 
<a name="l04184"></a>04184       return
<a name="l04185"></a>04185 <span class="keyword">      end</span>
<a name="l04186"></a>04186 
<a name="l04187"></a>04187 <span class="comment">!     =================</span>
<a name="l04188"></a>04188 <span class="comment">!     SUBROUTINE SPONGE</span>
<a name="l04189"></a>04189 <span class="comment">!     =================</span>
<a name="l04190"></a>04190 
<a name="l04191"></a><a class="code" href="puma_8f90.html#a0c040011dabc1b712353c37a4d90cc68">04191</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0c040011dabc1b712353c37a4d90cc68">sponge</a>
<a name="l04192"></a>04192       use <span class="keywordflow">pumamod</span>
<a name="l04193"></a>04193 
<a name="l04194"></a>04194       <span class="keywordtype">real</span> :: zp
<a name="l04195"></a>04195 
<a name="l04196"></a>04196 <span class="comment">!     This introduces a simple sponge layer to the highest model levels</span>
<a name="l04197"></a>04197 <span class="comment">!     by applying Rayleigh friction there, according to</span>
<a name="l04198"></a>04198 <span class="comment">!     Polvani &amp; Kushner (2002, GRL), see their appendix.</span>
<a name="l04199"></a>04199 
<a name="l04200"></a>04200       <span class="keyword">write</span>(nud,*)
<a name="l04201"></a>04201       <span class="keyword">write</span>(nud,9991)
<a name="l04202"></a>04202       <span class="keyword">write</span>(nud,9997)
<a name="l04203"></a>04203       <span class="keyword">write</span>(nud,9991)
<a name="l04204"></a>04204       <span class="keyword">write</span>(nud,9996)
<a name="l04205"></a>04205       <span class="keyword">write</span>(nud,9991)
<a name="l04206"></a>04206       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04207"></a>04207          zp = sigma(jlev)*psurf
<a name="l04208"></a>04208          <span class="keyword">if</span> (zp &lt; pspon) <span class="keyword">then</span>
<a name="l04209"></a>04209             fric(jlev) = (sponk * ((pspon - zp) / pspon)**2) / TWOPI
<a name="l04210"></a>04210          <span class="keyword">endif</span>
<a name="l04211"></a>04211 
<a name="l04212"></a>04212 <span class="comment">!        some output</span>
<a name="l04213"></a>04213          <span class="keyword">if</span> (zp &gt; pspon) <span class="keyword">then</span>
<a name="l04214"></a>04214             <span class="keyword">if</span> (fric(jlev) == 0) <span class="keyword">then</span>
<a name="l04215"></a>04215                <span class="keyword">write</span>(nud,9992) jlev
<a name="l04216"></a>04216             <span class="keyword">else</span>
<a name="l04217"></a>04217                <span class="keyword">write</span>(nud,9993) jlev, fric(jlev)*TWOPI
<a name="l04218"></a>04218             <span class="keyword">endif</span>
<a name="l04219"></a>04219          <span class="keyword">else</span>
<a name="l04220"></a>04220             <span class="keyword">if</span> (fric(jlev) == 0) <span class="keyword">then</span>
<a name="l04221"></a>04221                <span class="keyword">write</span>(nud,9994) jlev
<a name="l04222"></a>04222             <span class="keyword">else</span>
<a name="l04223"></a>04223                <span class="keyword">write</span>(nud,9995) jlev, fric(jlev)*TWOPI
<a name="l04224"></a>04224             <span class="keyword">endif</span>
<a name="l04225"></a>04225          <span class="keyword">endif</span>
<a name="l04226"></a>04226       <span class="keyword">enddo</span>
<a name="l04227"></a>04227       <span class="keyword">write</span>(nud,9991)
<a name="l04228"></a>04228       <span class="keyword">write</span>(nud,*)
<a name="l04229"></a>04229       return
<a name="l04230"></a>04230  9991 format(33(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l04231"></a>04231  9992 format(<span class="stringliteral">&#39;*&#39;</span>,i4,<span class="stringliteral">&#39; * &#39;</span>,7(<span class="stringliteral">&#39;-&#39;</span>),<span class="stringliteral">&#39; *               *&#39;</span>)
<a name="l04232"></a>04232  9993 format(<span class="stringliteral">&#39;*&#39;</span>,i4,<span class="stringliteral">&#39; * &#39;</span>,f7.4,<span class="stringliteral">&#39; *               *&#39;</span>)
<a name="l04233"></a>04233  9994 format(<span class="stringliteral">&#39;*&#39;</span>,i4,<span class="stringliteral">&#39; * &#39;</span>,7(<span class="stringliteral">&#39;-&#39;</span>),<span class="stringliteral">&#39; *&#39;</span>,<span class="stringliteral">&#39; SPONGE        *&#39;</span>)
<a name="l04234"></a>04234  9995 format(<span class="stringliteral">&#39;*&#39;</span>,i4,<span class="stringliteral">&#39; * &#39;</span>,f7.4,<span class="stringliteral">&#39; *&#39;</span>,<span class="stringliteral">&#39; SPONGE        *&#39;</span>)
<a name="l04235"></a>04235  9996 format(<span class="stringliteral">&#39;*  Lv * [1/day] *               *&#39;</span>)
<a name="l04236"></a>04236  9997 format(<span class="stringliteral">&#39;* Rayleigh damping coefficients *&#39;</span>)
<a name="l04237"></a>04237 <span class="keyword">      end</span>
<a name="l04238"></a>04238 
<a name="l04239"></a>04239 
<a name="l04240"></a>04240 <span class="comment">!     =====================</span>
<a name="l04241"></a>04241 <span class="comment">!     SUBROUTINE MKENERDIAG</span>
<a name="l04242"></a>04242 <span class="comment">!     =====================</span>
<a name="l04243"></a>04243 
<a name="l04244"></a><a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">04244</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(pst,pstt,psp,pspt,penergy)
<a name="l04245"></a>04245       use <span class="keywordflow">pumamod</span>
<a name="l04246"></a>04246 <span class="comment">!</span>
<a name="l04247"></a>04247       <span class="keywordtype">real</span> :: pst(NSPP,NLEV),pstt(NSPP,NLEV)
<a name="l04248"></a>04248       <span class="keywordtype">real</span> :: psp(NSPP),pspt(NSPP)
<a name="l04249"></a>04249       <span class="keywordtype">real</span> :: penergy(NHOR)
<a name="l04250"></a>04250 <span class="comment">!</span>
<a name="l04251"></a>04251       <span class="keywordtype">real</span> :: zsttf(NESP,NLEV),zstf(NESP,NLEV)
<a name="l04252"></a>04252       <span class="keywordtype">real</span> :: zsptf(NESP),zspf(NESP)
<a name="l04253"></a>04253       <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV),zgt(NHOR,NLEV)
<a name="l04254"></a>04254       <span class="keywordtype">real</span> :: zgps(NHOR),zgpst(NHOR)
<a name="l04255"></a>04255       <span class="keywordtype">real</span> :: ztm(NHOR)
<a name="l04256"></a>04256 <span class="comment">!</span>
<a name="l04257"></a>04257       zcp=gascon/akap
<a name="l04258"></a>04258       zdelt=delt2/ww
<a name="l04259"></a>04259 <span class="comment">!</span>
<a name="l04260"></a>04260       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsttf,pstt,NLEV)
<a name="l04261"></a>04261       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zstf,pst,NLEV)
<a name="l04262"></a>04262       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsptf,pspt,1)
<a name="l04263"></a>04263       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,psp,1)
<a name="l04264"></a>04264 
<a name="l04265"></a>04265       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04266"></a>04266        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsttf(:,jlev),zgtt(:,jlev))
<a name="l04267"></a>04267        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zstf(:,jlev),zgt(:,jlev))
<a name="l04268"></a>04268       <span class="keyword">enddo</span>
<a name="l04269"></a>04269       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsptf,zgpst)
<a name="l04270"></a>04270       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zgps)
<a name="l04271"></a>04271       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgtt,NLON,NLPP*NLEV)
<a name="l04272"></a>04272       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgt,NLON,NLPP*NLEV)
<a name="l04273"></a>04273       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgps,NLON,NLPP)
<a name="l04274"></a>04274       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgpst,NLON,NLPP)
<a name="l04275"></a>04275       zgpst(:)=psurf*(exp(zgps(:)+delt2*zgpst(:))-exp(zgps(:)))/zdelt
<a name="l04276"></a>04276       zgps(:)=psurf*exp(zgps(:))+zdelt*zgpst(:)
<a name="l04277"></a>04277       zgtt(:,:)=ct*ww*zgtt(:,:)
<a name="l04278"></a>04278       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04279"></a>04279        zgt(:,jlev)=ct*(zgt(:,jlev)+t0(jlev))
<a name="l04280"></a>04280       <span class="keyword">enddo</span>
<a name="l04281"></a>04281 <span class="comment">!</span>
<a name="l04282"></a>04282       ztm(:)=0.
<a name="l04283"></a>04283       penergy(:)=0.
<a name="l04284"></a>04284       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04285"></a>04285        ztm(:)=ztm(:)+zgt(:,jlev)*dsigma(jlev)
<a name="l04286"></a>04286        penergy(:)=penergy(:)+zgtt(:,jlev)*dsigma(jlev)
<a name="l04287"></a>04287       <span class="keyword">enddo</span>
<a name="l04288"></a>04288       penergy(:)=ztm(:)*zcp*zgpst(:)/ga                                 &amp;
<a name="l04289"></a>04289      &amp;          +penergy(:)*zcp*zgps(:)/ga
<a name="l04290"></a>04290 <span class="comment">!</span>
<a name="l04291"></a>04291       return
<a name="l04292"></a>04292 <span class="keyword">      end</span>
<a name="l04293"></a>04293 
<a name="l04294"></a>04294 <span class="comment">!     ======================</span>
<a name="l04295"></a>04295 <span class="comment">!     SUBROUTINE MKENTRODIAG</span>
<a name="l04296"></a>04296 <span class="comment">!     ======================</span>
<a name="l04297"></a>04297 
<a name="l04298"></a><a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">04298</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(pst,pstt,psp,pentropy)
<a name="l04299"></a>04299       use <span class="keywordflow">pumamod</span>
<a name="l04300"></a>04300 <span class="comment">!</span>
<a name="l04301"></a>04301       <span class="keywordtype">real</span> :: pst(NSPP,NLEV),pstt(NSPP,NLEV)
<a name="l04302"></a>04302       <span class="keywordtype">real</span> :: psp(NSPP)
<a name="l04303"></a>04303       <span class="keywordtype">real</span> :: pentropy(NHOR)
<a name="l04304"></a>04304 <span class="comment">!</span>
<a name="l04305"></a>04305       <span class="keywordtype">real</span> :: zsttf(NESP,NLEV),zstf(NESP,NLEV)
<a name="l04306"></a>04306       <span class="keywordtype">real</span> :: zspf(NESP)
<a name="l04307"></a>04307       <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV),zgt(NHOR,NLEV)
<a name="l04308"></a>04308       <span class="keywordtype">real</span> :: zgps(NHOR)
<a name="l04309"></a>04309 <span class="comment">!</span>
<a name="l04310"></a>04310       zcp=gascon/akap
<a name="l04311"></a>04311 <span class="comment">!</span>
<a name="l04312"></a>04312       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsttf,pstt,NLEV)
<a name="l04313"></a>04313       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zstf,pst,NLEV)
<a name="l04314"></a>04314       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,psp,1)
<a name="l04315"></a>04315 
<a name="l04316"></a>04316       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04317"></a>04317        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsttf(:,jlev),zgtt(:,jlev))
<a name="l04318"></a>04318        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zstf(:,jlev),zgt(:,jlev))
<a name="l04319"></a>04319       <span class="keyword">enddo</span>
<a name="l04320"></a>04320       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zgps)
<a name="l04321"></a>04321       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgtt,NLON,NLPP*NLEV)
<a name="l04322"></a>04322       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgt,NLON,NLPP*NLEV)
<a name="l04323"></a>04323       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgps,NLON,NLPP)
<a name="l04324"></a>04324       zgps(:)=psurf*exp(zgps(:))
<a name="l04325"></a>04325       zgtt(:,:)=ct*ww*zgtt(:,:)
<a name="l04326"></a>04326       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04327"></a>04327        zgt(:,jlev)=ct*(zgt(:,jlev)+t0(jlev))
<a name="l04328"></a>04328       <span class="keyword">enddo</span>
<a name="l04329"></a>04329 <span class="comment">!</span>
<a name="l04330"></a>04330       pentropy(:)=0.
<a name="l04331"></a>04331       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04332"></a>04332        pentropy(:)=pentropy(:)+zgtt(:,jlev)*dsigma(jlev)/zgt(:,jlev)
<a name="l04333"></a>04333       <span class="keyword">enddo</span>
<a name="l04334"></a>04334       pentropy(:)=pentropy(:)*zcp*zgps(:)/ga                               
<a name="l04335"></a>04335 <span class="comment">!</span>
<a name="l04336"></a>04336       return
<a name="l04337"></a>04337 <span class="keyword">      end</span>
<a name="l04338"></a>04338 
<a name="l04339"></a>04339 <span class="comment">!     ==================</span>
<a name="l04340"></a>04340 <span class="comment">!     SUBROUTINE MKDHEAT</span>
<a name="l04341"></a>04341 <span class="comment">!     ==================</span>
<a name="l04342"></a>04342 
<a name="l04343"></a><a class="code" href="puma_8f90.html#a079a9ea6caa3eb9d5ef5e0c82f76a2b9">04343</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a079a9ea6caa3eb9d5ef5e0c82f76a2b9">mkdheat</a>(zszt1,zszt2,zsdt1,zsdt2,zsp)
<a name="l04344"></a>04344       use <span class="keywordflow">pumamod</span>
<a name="l04345"></a>04345 <span class="comment">!</span>
<a name="l04346"></a>04346 <span class="comment">!     &#39;recycle&#39; kin. energy loss by heating the environment</span>
<a name="l04347"></a>04347 <span class="comment">!</span>
<a name="l04348"></a>04348 <span class="comment">!     zszt1/zsdt1 : vorticity/divergence tendency due to friction</span>
<a name="l04349"></a>04349 <span class="comment">!     zszt2/zsdt2 : vorticity/divergence tendency fue to diffusion  </span>
<a name="l04350"></a>04350 <span class="comment">!     zp          : surface pressure</span>
<a name="l04351"></a>04351 <span class="comment">!</span>
<a name="l04352"></a>04352       <span class="keywordtype">real</span> zszt1(NSPP,NLEV),zszt2(NSPP,NLEV)
<a name="l04353"></a>04353       <span class="keywordtype">real</span> zsdt1(NSPP,NLEV),zsdt2(NSPP,NLEV)
<a name="l04354"></a>04354       <span class="keywordtype">real</span> zsp(NSPP)
<a name="l04355"></a>04355       <span class="keywordtype">real</span> zp(NHOR)
<a name="l04356"></a>04356 <span class="comment">!</span>
<a name="l04357"></a>04357       <span class="keywordtype">real</span> zsd(NESP,NLEV),zsz(NESP,NLEV)
<a name="l04358"></a>04358       <span class="keywordtype">real</span> zspf(NESP),zspt(NSPP)
<a name="l04359"></a>04359       <span class="keywordtype">real</span> zsdp(NSPP,NLEV),zszp(NSPP,NLEV)
<a name="l04360"></a>04360       <span class="keywordtype">real</span> zu(NHOR,NLEV),zun(NHOR,NLEV),zdu1(NHOR,NLEV),zdu2(NHOR,NLEV)
<a name="l04361"></a>04361       <span class="keywordtype">real</span> zv(NHOR,NLEV),zvn(NHOR,NLEV),zdv1(NHOR,NLEV),zdv2(NHOR,NLEV)
<a name="l04362"></a>04362       <span class="keywordtype">real</span> zdtdt1(NHOR,NLEV),zdtdt2(NHOR,NLEV),zdtdt3(NHOR,NLEV)
<a name="l04363"></a>04363 <span class="comment">!</span>
<a name="l04364"></a>04364       <span class="keywordtype">real</span> zdtdt(NHOR,NLEV),zdekin(NHOR,NLEV)
<a name="l04365"></a>04365 <span class="comment">!</span>
<a name="l04366"></a>04366       <span class="keywordtype">real</span> zsde(NSPP,NLEV),zsdef(NESP,NLEV)
<a name="l04367"></a>04367       <span class="keywordtype">real</span> zstt(NSPP,NLEV),zstf(NESP,NLEV)
<a name="l04368"></a>04368       <span class="keywordtype">real</span> zstt1(NSPP,NLEV),zstf1(NESP,NLEV),zstt3(NSPP,NLEV)
<a name="l04369"></a>04369       <span class="keywordtype">real</span> zstt2(NSPP,NLEV),zstf2(NESP,NLEV),zstf3(NESP,NLEV)
<a name="l04370"></a>04370 <span class="comment">!</span>
<a name="l04371"></a>04371 <span class="comment">!     some constants</span>
<a name="l04372"></a>04372 <span class="comment">!</span>
<a name="l04373"></a>04373       zdelt=delt2/ww     <span class="comment">! timestep in s</span>
<a name="l04374"></a>04374       zcp=gascon/akap    <span class="comment">! heat capacity</span>
<a name="l04375"></a>04375 <span class="comment">!</span>
<a name="l04376"></a>04376 <span class="comment">!     &#39;recycle&#39; friction</span>
<a name="l04377"></a>04377 <span class="comment">!</span>
<a name="l04378"></a>04378 <span class="comment">!     a) gather the &#39;partial&#39; field of z and d, and make u and v </span>
<a name="l04379"></a>04379 <span class="comment">!        at old time level</span>
<a name="l04380"></a>04380 <span class="comment">!</span>
<a name="l04381"></a>04381       zsdp(:,:)=sdp(:,:)
<a name="l04382"></a>04382       zszp(:,:)=szp(:,:)
<a name="l04383"></a>04383       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV)
<a name="l04384"></a>04384       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV)
<a name="l04385"></a>04385       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04386"></a>04386          call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zu(1,jlev),zv(1,jlev))
<a name="l04387"></a>04387       <span class="keyword">enddo</span>
<a name="l04388"></a>04388       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zu,NLON,NLPP*NLEV)
<a name="l04389"></a>04389       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zv,NLON,NLPP*NLEV)
<a name="l04390"></a>04390 <span class="comment">!</span>
<a name="l04391"></a>04391 <span class="comment">!     b) add fricton tendencies and create new u and v</span>
<a name="l04392"></a>04392 <span class="comment">!</span>
<a name="l04393"></a>04393       zsdp(:,:)=sdp(:,:)+zsdt1(:,:)*delt2
<a name="l04394"></a>04394       zszp(:,:)=szp(:,:)+zszt1(:,:)*delt2
<a name="l04395"></a>04395       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV)
<a name="l04396"></a>04396       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV)
<a name="l04397"></a>04397       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04398"></a>04398          call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zun(1,jlev),zvn(1,jlev))
<a name="l04399"></a>04399       <span class="keyword">enddo</span>
<a name="l04400"></a>04400       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zun,NLON,NLPP*NLEV)
<a name="l04401"></a>04401       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zvn,NLON,NLPP*NLEV)
<a name="l04402"></a>04402 <span class="comment">!</span>
<a name="l04403"></a>04403 <span class="comment">!     c) compute temperature tendency</span>
<a name="l04404"></a>04404 <span class="comment">!</span>
<a name="l04405"></a>04405       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04406"></a>04406        zu(:,jlev)=cv*zu(:,jlev)*SQRT(rcsq(:))
<a name="l04407"></a>04407        zv(:,jlev)=cv*zv(:,jlev)*SQRT(rcsq(:))
<a name="l04408"></a>04408        zun(:,jlev)=cv*zun(:,jlev)*SQRT(rcsq(:))
<a name="l04409"></a>04409        zvn(:,jlev)=cv*zvn(:,jlev)*SQRT(rcsq(:))
<a name="l04410"></a>04410        zdu1(:,jlev)=zun(:,jlev)-zu(:,jlev)
<a name="l04411"></a>04411        zdv1(:,jlev)=zvn(:,jlev)-zv(:,jlev)
<a name="l04412"></a>04412        zdtdt1(:,jlev)=-(zun(:,jlev)*zun(:,jlev)                         &amp;
<a name="l04413"></a>04413      &amp;                 -zu(:,jlev)*zu(:,jlev)                           &amp;
<a name="l04414"></a>04414      &amp;                 +zvn(:,jlev)*zvn(:,jlev)                         &amp;
<a name="l04415"></a>04415      &amp;                 -zv(:,jlev)*zv(:,jlev))*0.5/zdelt/zcp     
<a name="l04416"></a>04416       <span class="keyword">enddo</span>
<a name="l04417"></a>04417 
<a name="l04418"></a>04418 <span class="comment">!</span>
<a name="l04419"></a>04419 <span class="comment">!     &#39;recycle&#39; momentum diffusion  </span>
<a name="l04420"></a>04420 <span class="comment">!    </span>
<a name="l04421"></a>04421 <span class="comment">!     a) add tendencies and create new u and v and get surface pressure</span>
<a name="l04422"></a>04422 <span class="comment">!</span>
<a name="l04423"></a>04423 <span class="comment">!</span>
<a name="l04424"></a>04424       zsdp(:,:)=sdp(:,:)+zsdt2(:,:)*delt2
<a name="l04425"></a>04425       zszp(:,:)=szp(:,:)+zszt2(:,:)*delt2
<a name="l04426"></a>04426       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV)
<a name="l04427"></a>04427       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV)
<a name="l04428"></a>04428       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,zsp,1)
<a name="l04429"></a>04429       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04430"></a>04430          call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zun(1,jlev),zvn(1,jlev))
<a name="l04431"></a>04431       <span class="keyword">enddo</span>
<a name="l04432"></a>04432       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zun,NLON,NLPP*NLEV)
<a name="l04433"></a>04433       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zvn,NLON,NLPP*NLEV)
<a name="l04434"></a>04434       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zp)
<a name="l04435"></a>04435       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zp,NLON,NLPP)
<a name="l04436"></a>04436       zp(:)=psurf*exp(zp(:))
<a name="l04437"></a>04437 <span class="comment">!</span>
<a name="l04438"></a>04438 <span class="comment">!     b) compute loss of kinetic energy</span>
<a name="l04439"></a>04439 <span class="comment">!        (note: only the global average change of kin. e. is &#39;lost&#39;</span>
<a name="l04440"></a>04440 <span class="comment">!         the other changes are just diffusion)</span>
<a name="l04441"></a>04441 <span class="comment">!</span>
<a name="l04442"></a>04442       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04443"></a>04443        zun(:,jlev)=cv*zun(:,jlev)*SQRT(rcsq(:))
<a name="l04444"></a>04444        zvn(:,jlev)=cv*zvn(:,jlev)*SQRT(rcsq(:))
<a name="l04445"></a>04445        zdu2(:,jlev)=zun(:,jlev)-zu(:,jlev)
<a name="l04446"></a>04446        zdv2(:,jlev)=zvn(:,jlev)-zv(:,jlev)
<a name="l04447"></a>04447        zdekin(:,jlev)=(zun(:,jlev)*zun(:,jlev)                          &amp;
<a name="l04448"></a>04448      &amp;                -zu(:,jlev)*zu(:,jlev)                            &amp;
<a name="l04449"></a>04449      &amp;                +zvn(:,jlev)*zvn(:,jlev)                          &amp;
<a name="l04450"></a>04450      &amp;                -zv(:,jlev)*zv(:,jlev))*0.5/zdelt                 &amp;
<a name="l04451"></a>04451      &amp;               *zp(:)/ga*dsigma(jlev)   
<a name="l04452"></a>04452       <span class="keyword">enddo</span>
<a name="l04453"></a>04453 <span class="comment">!</span>
<a name="l04454"></a>04454 <span class="comment">!     c) get the global average and transform it back</span>
<a name="l04455"></a>04455 <span class="comment">!</span>
<a name="l04456"></a>04456       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdekin,NLON,NLPP*NLEV)
<a name="l04457"></a>04457       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04458"></a>04458        call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdekin(:,jlev),zsdef(:,jlev))
<a name="l04459"></a>04459       <span class="keyword">enddo</span>
<a name="l04460"></a>04460       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zsdef,zsde,NLEV)
<a name="l04461"></a>04461       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsdef,zsde,NLEV)
<a name="l04462"></a>04462       zsdef(2:NESP,:)=0.
<a name="l04463"></a>04463       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04464"></a>04464          call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsdef(1,jlev),zdekin(1,jlev))
<a name="l04465"></a>04465       <span class="keyword">enddo</span>
<a name="l04466"></a>04466       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zdekin,NLON,NLPP*NLEV)
<a name="l04467"></a>04467 <span class="comment">!</span>
<a name="l04468"></a>04468 <span class="comment">!     d) compute temperature tendency</span>
<a name="l04469"></a>04469 <span class="comment">!</span>
<a name="l04470"></a>04470       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04471"></a>04471        zdtdt2(:,jlev)=-zdekin(:,jlev)*ga/zp(:)/dsigma(jlev)/zcp
<a name="l04472"></a>04472        zdtdt3(:,jlev)=-(zdu1(:,jlev)*zdu2(:,jlev)                       &amp;
<a name="l04473"></a>04473      &amp;                 +zdv1(:,jlev)*zdv2(:,jlev))/zdelt/zcp
<a name="l04474"></a>04474       <span class="keyword">enddo</span>
<a name="l04475"></a>04475 <span class="comment">!</span>
<a name="l04476"></a>04476       zdtdt1(:,:)=zdtdt1(:,:)/ct/ww
<a name="l04477"></a>04477       zdtdt2(:,:)=zdtdt2(:,:)/ct/ww
<a name="l04478"></a>04478       zdtdt3(:,:)=zdtdt3(:,:)/ct/ww
<a name="l04479"></a>04479 <span class="comment">!</span>
<a name="l04480"></a>04480       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdtdt1,NLON,NLPP*NLEV)
<a name="l04481"></a>04481       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdtdt2,NLON,NLPP*NLEV)
<a name="l04482"></a>04482       call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdtdt3,NLON,NLPP*NLEV)
<a name="l04483"></a>04483       <span class="keyword">do</span> jlev=1,NLEV
<a name="l04484"></a>04484        call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdtdt1(:,jlev),zstf1(:,jlev))
<a name="l04485"></a>04485        call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdtdt2(:,jlev),zstf2(:,jlev))
<a name="l04486"></a>04486        call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdtdt3(:,jlev),zstf3(:,jlev))
<a name="l04487"></a>04487       <span class="keyword">enddo</span>
<a name="l04488"></a>04488       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf1,zstt1,NLEV)
<a name="l04489"></a>04489       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf2,zstt2,NLEV)
<a name="l04490"></a>04490       call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf3,zstt3,NLEV)
<a name="l04491"></a>04491 <span class="comment">!</span>
<a name="l04492"></a>04492 <span class="comment">!     add the temprature tendencies</span>
<a name="l04493"></a>04493 <span class="comment">!</span>
<a name="l04494"></a>04494       stt(:,:)=stt(:,:)+zstt1(:,:)+zstt2(:,:)+zstt3(:,:)
<a name="l04495"></a>04495 <span class="comment">!</span>
<a name="l04496"></a>04496 <span class="comment">!     energy diagnostics</span>
<a name="l04497"></a>04497 <span class="comment">!</span>
<a name="l04498"></a>04498       <span class="keyword">if</span>(nenergy &gt; 0) <span class="keyword">then</span>
<a name="l04499"></a>04499        zspt(:)=0.
<a name="l04500"></a>04500        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstt1,zsp,zspt,denergy(:,5))
<a name="l04501"></a>04501        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstt2,zsp,zspt,denergy(:,6))
<a name="l04502"></a>04502        call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstt3,zsp,zspt,denergy(:,7))
<a name="l04503"></a>04503       <span class="keyword">endif</span>
<a name="l04504"></a>04504       <span class="keyword">if</span>(nentropy &gt; 0) <span class="keyword">then</span>
<a name="l04505"></a>04505        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstt1,zsp,dentropy(:,5))
<a name="l04506"></a>04506        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstt2,zsp,dentropy(:,6))
<a name="l04507"></a>04507        call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstt3,zsp,dentropy(:,7))
<a name="l04508"></a>04508       <span class="keyword">endif</span>
<a name="l04509"></a>04509 
<a name="l04510"></a>04510 <span class="comment">!</span>
<a name="l04511"></a>04511       return
<a name="l04512"></a>04512 <span class="keyword">      end subroutine mkdheat</span>
<a name="l04513"></a>04513 
<a name="l04514"></a>04514 <span class="comment">!     =================</span>
<a name="l04515"></a>04515 <span class="comment">!     SUBROUTINE MKEKIN</span>
<a name="l04516"></a>04516 <span class="comment">!     =================</span>
<a name="l04517"></a>04517 
<a name="l04518"></a><a class="code" href="puma_8f90.html#a30cefc96eb08dde625692abb8eae576e">04518</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a30cefc96eb08dde625692abb8eae576e">mkekin</a>(zszp,zsdp,zp,zekin)
<a name="l04519"></a>04519       use <span class="keywordflow">pumamod</span>
<a name="l04520"></a>04520 <span class="comment">!</span>
<a name="l04521"></a>04521       <span class="keywordtype">real</span> zszp(NSPP,NLEV),zsdp(NSPP,NLEV)
<a name="l04522"></a>04522       <span class="keywordtype">real</span> zp(NHOR),zekin(NHOR)
<a name="l04523"></a>04523 <span class="comment">!</span>
<a name="l04524"></a>04524       <span class="keywordtype">real</span> zsd(NESP,NLEV),zsz(NESP,NLEV)
<a name="l04525"></a>04525       <span class="keywordtype">real</span> zu(NHOR,NLEV),zv(NHOR,NLEV)
<a name="l04526"></a>04526 <span class="comment">!</span>
<a name="l04527"></a>04527 <span class="comment">!     some constants</span>
<a name="l04528"></a>04528 <span class="comment">!</span>
<a name="l04529"></a>04529       zdelt=delt2/ww     <span class="comment">! timestep in s</span>
<a name="l04530"></a>04530       zcp=gascon/akap    <span class="comment">! heat capacity</span>
<a name="l04531"></a>04531 <span class="comment">!</span>
<a name="l04532"></a>04532       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV)
<a name="l04533"></a>04533       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV)
<a name="l04534"></a>04534       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04535"></a>04535          call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zu(1,jlev),zv(1,jlev))
<a name="l04536"></a>04536       <span class="keyword">enddo</span>
<a name="l04537"></a>04537       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zu,NLON,NLPP*NLEV)
<a name="l04538"></a>04538       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zv,NLON,NLPP*NLEV)
<a name="l04539"></a>04539 <span class="comment">!</span>
<a name="l04540"></a>04540       zekin(:)=0.
<a name="l04541"></a>04541       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04542"></a>04542        zu(:,jlev)=cv*zu(:,jlev)*SQRT(rcsq(:))
<a name="l04543"></a>04543        zv(:,jlev)=cv*zv(:,jlev)*SQRT(rcsq(:))
<a name="l04544"></a>04544        zekin(:)=(zu(:,jlev)*zu(:,jlev)+zv(:,jlev)*zv(:,jlev))*0.5       &amp;
<a name="l04545"></a>04545      &amp;         *zp(:)/ga*dsigma(jlev)+zekin(:)
<a name="l04546"></a>04546       <span class="keyword">enddo</span>
<a name="l04547"></a>04547 <span class="comment">!</span>
<a name="l04548"></a>04548       return
<a name="l04549"></a>04549 <span class="keyword">      end</span>
<a name="l04550"></a><a class="code" href="puma_8f90.html#abc6f135f96d6f8c9636cef2d9c9dd796">04550</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#abc6f135f96d6f8c9636cef2d9c9dd796">mkekin2</a>(zszp,zsdp,zspp,zekin)
<a name="l04551"></a>04551       use <span class="keywordflow">pumamod</span>
<a name="l04552"></a>04552 <span class="comment">!</span>
<a name="l04553"></a>04553       <span class="keywordtype">real</span> zszp(NSPP,NLEV),zsdp(NSPP,NLEV),zspp(NSPP)
<a name="l04554"></a>04554       <span class="keywordtype">real</span> zp(NHOR),zekin(NHOR)
<a name="l04555"></a>04555 <span class="comment">!</span>
<a name="l04556"></a>04556       <span class="keywordtype">real</span> zsd(NESP,NLEV),zsz(NESP,NLEV),zsp(NESP)
<a name="l04557"></a>04557       <span class="keywordtype">real</span> zu(NHOR,NLEV),zv(NHOR,NLEV)
<a name="l04558"></a>04558 <span class="comment">!</span>
<a name="l04559"></a>04559 <span class="comment">!     some constants</span>
<a name="l04560"></a>04560 <span class="comment">!</span>
<a name="l04561"></a>04561       zdelt=delt2/ww     <span class="comment">! timestep in s</span>
<a name="l04562"></a>04562       zcp=gascon/akap    <span class="comment">! heat capacity</span>
<a name="l04563"></a>04563 <span class="comment">!</span>
<a name="l04564"></a>04564       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV)
<a name="l04565"></a>04565       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV)
<a name="l04566"></a>04566       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsp,zspp,NLEV)
<a name="l04567"></a>04567       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04568"></a>04568          call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zu(1,jlev),zv(1,jlev))
<a name="l04569"></a>04569       <span class="keyword">enddo</span>
<a name="l04570"></a>04570       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsp,zp)
<a name="l04571"></a>04571       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zu,NLON,NLPP*NLEV)
<a name="l04572"></a>04572       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zv,NLON,NLPP*NLEV)
<a name="l04573"></a>04573       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zp,NLON,NLPP)
<a name="l04574"></a>04574 <span class="comment">!</span>
<a name="l04575"></a>04575       zp(:)=psurf*exp(zp(:))
<a name="l04576"></a>04576       zekin(:)=0.
<a name="l04577"></a>04577       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04578"></a>04578        zu(:,jlev)=cv*zu(:,jlev)*SQRT(rcsq(:))
<a name="l04579"></a>04579        zv(:,jlev)=cv*zv(:,jlev)*SQRT(rcsq(:))
<a name="l04580"></a>04580        zekin(:)=(zu(:,jlev)*zu(:,jlev)+zv(:,jlev)*zv(:,jlev))*0.5       &amp;
<a name="l04581"></a>04581      &amp;         *zp(:)/ga*dsigma(jlev)+zekin(:)
<a name="l04582"></a>04582       <span class="keyword">enddo</span>
<a name="l04583"></a>04583 <span class="comment">!</span>
<a name="l04584"></a>04584       return
<a name="l04585"></a>04585 <span class="keyword">      end</span>
<a name="l04586"></a>04586 
<a name="l04587"></a>04587 
<a name="l04588"></a>04588 <span class="comment">!     =================</span>
<a name="l04589"></a>04589 <span class="comment">!     SUBROUTINE MKEPOT</span>
<a name="l04590"></a>04590 <span class="comment">!     =================</span>
<a name="l04591"></a>04591 
<a name="l04592"></a><a class="code" href="puma_8f90.html#a0af984bd0f7283956290a0964e69cf0e">04592</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0af984bd0f7283956290a0964e69cf0e">mkepot</a>(zstp,zp,zepot)
<a name="l04593"></a>04593       use <span class="keywordflow">pumamod</span>
<a name="l04594"></a>04594 <span class="comment">!</span>
<a name="l04595"></a>04595       <span class="keywordtype">real</span> zstp(NSPP,NLEV)
<a name="l04596"></a>04596       <span class="keywordtype">real</span> zp(NHOR),zepot(NHOR)
<a name="l04597"></a>04597 <span class="comment">!</span>
<a name="l04598"></a>04598       <span class="keywordtype">real</span> zst(NESP,NLEV)
<a name="l04599"></a>04599       <span class="keywordtype">real</span> zt(NHOR,NLEV)
<a name="l04600"></a>04600 <span class="comment">!</span>
<a name="l04601"></a>04601 <span class="comment">!     some constants</span>
<a name="l04602"></a>04602 <span class="comment">!</span>
<a name="l04603"></a>04603       zdelt=delt2/ww     <span class="comment">! timestep in s</span>
<a name="l04604"></a>04604       zcp=gascon/akap    <span class="comment">! heat capacity</span>
<a name="l04605"></a>04605 <span class="comment">!</span>
<a name="l04606"></a>04606       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zst,zstp,NLEV)
<a name="l04607"></a>04607       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04608"></a>04608        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zst(1,jlev),zt(1,jlev))
<a name="l04609"></a>04609       <span class="keyword">enddo</span>
<a name="l04610"></a>04610       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zt,NLON,NLPP*NLEV)
<a name="l04611"></a>04611 <span class="comment">!</span>
<a name="l04612"></a>04612       zepot(:)=0.
<a name="l04613"></a>04613       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04614"></a>04614        zt(:,jlev)=ct*(zt(:,jlev)+t0(jlev))
<a name="l04615"></a>04615        zepot(:)=zt(:,jlev)*zcp   &amp;
<a name="l04616"></a>04616      &amp;         *zp(:)/ga*dsigma(jlev)+zepot(:)
<a name="l04617"></a>04617       <span class="keyword">enddo</span>
<a name="l04618"></a>04618 <span class="comment">!</span>
<a name="l04619"></a>04619       return
<a name="l04620"></a>04620 <span class="keyword">      end</span>
<a name="l04621"></a><a class="code" href="puma_8f90.html#a23384f45e8ba553e7aaed8b22a9a80e8">04621</a>       <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a23384f45e8ba553e7aaed8b22a9a80e8">mkepot2</a>(zstp,zspp,zepot)
<a name="l04622"></a>04622       use <span class="keywordflow">pumamod</span>
<a name="l04623"></a>04623 <span class="comment">!</span>
<a name="l04624"></a>04624       <span class="keywordtype">real</span> zstp(NSPP,NLEV),zspp(NSPP)
<a name="l04625"></a>04625       <span class="keywordtype">real</span> zp(NHOR),zepot(NHOR)
<a name="l04626"></a>04626 <span class="comment">!</span>
<a name="l04627"></a>04627       <span class="keywordtype">real</span> zst(NESP,NLEV),zsp(NESP)
<a name="l04628"></a>04628       <span class="keywordtype">real</span> zt(NHOR,NLEV)
<a name="l04629"></a>04629 <span class="comment">!</span>
<a name="l04630"></a>04630 <span class="comment">!     some constants</span>
<a name="l04631"></a>04631 <span class="comment">!</span>
<a name="l04632"></a>04632       zdelt=delt2/ww     <span class="comment">! timestep in s</span>
<a name="l04633"></a>04633       zcp=gascon/akap    <span class="comment">! heat capacity</span>
<a name="l04634"></a>04634 <span class="comment">!</span>
<a name="l04635"></a>04635       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zst,zstp,NLEV)
<a name="l04636"></a>04636       call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsp,zspp,1)
<a name="l04637"></a>04637       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04638"></a>04638        call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zst(1,jlev),zt(1,jlev))
<a name="l04639"></a>04639       <span class="keyword">enddo</span>
<a name="l04640"></a>04640       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsp,zp)
<a name="l04641"></a>04641       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zt,NLON,NLPP*NLEV)
<a name="l04642"></a>04642       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zp,NLON,NLPP)
<a name="l04643"></a>04643 <span class="comment">!</span>
<a name="l04644"></a>04644       zp(:)=psurf*exp(zp(:))
<a name="l04645"></a>04645       zepot(:)=0.
<a name="l04646"></a>04646       <span class="keyword">do</span> jlev = 1 , NLEV
<a name="l04647"></a>04647        zt(:,jlev)=ct*(zt(:,jlev)+t0(jlev))
<a name="l04648"></a>04648        zepot(:)=zt(:,jlev)*zcp   &amp;
<a name="l04649"></a>04649      &amp;         *zp(:)/ga*dsigma(jlev)+zepot(:)
<a name="l04650"></a>04650       <span class="keyword">enddo</span>
<a name="l04651"></a>04651 <span class="comment">!</span>
<a name="l04652"></a>04652       return
<a name="l04653"></a>04653 <span class="keyword">      end</span>
<a name="l04654"></a>04654 
</pre></div></div>
</div>
  <div id="nav-path" class="navpath">
    <ul>
      <li class="navelem"><a class="el" href="puma_8f90.html">puma.f90</a>      </li>
<!-- window showing the filter options -->
<div id="MSearchSelectWindow"
     onmouseover="return searchBox.OnSearchSelectShow()"
     onmouseout="return searchBox.OnSearchSelectHide()"
     onkeydown="return searchBox.OnSearchSelectKey(event)">
<a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(0)"><span class="SelectionMark">&#160;</span>All</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(1)"><span class="SelectionMark">&#160;</span>Classes</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(2)"><span class="SelectionMark">&#160;</span>Files</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(3)"><span class="SelectionMark">&#160;</span>Functions</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(4)"><span class="SelectionMark">&#160;</span>Variables</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(5)"><span class="SelectionMark">&#160;</span>Defines</a></div>

<!-- iframe showing the search results (closed by default) -->
<div id="MSearchResultsWindow">
<iframe src="javascript:void(0)" frameborder="0" 
        name="MSearchResults" id="MSearchResults">
</iframe>
</div>


    <li class="footer">Generated on Wed Sep 21 2011 12:35:46 for PUMA by
    <a href="http://www.doxygen.org/index.html">
    <img class="footer" src="doxygen.png" alt="doxygen"/></a> 1.7.5.1 </li>
   </ul>
 </div>


</body>
</html>