TECLIM
/
PlaSim


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154
							<!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/ppp.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('ppp_8f90.html','');
</script>
<div id="doc-content">
<div class="header">
  <div class="headertitle">
<div class="title">/Users/home/WC/puma/src/ppp.f90</div>  </div>
</div>
<div class="contents">
<a href="ppp_8f90.html">Go to the documentation of this file.</a><div class="fragment"><pre class="fragment"><a name="l00001"></a><a class="code" href="classpumamod.html">00001</a>       <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">!     *                      Puma Pre Processor                      *</span>
<a name="l00005"></a>00005 <span class="comment">!     ****************************************************************</span>
<a name="l00006"></a>00006 <span class="comment">!     *                 E. Kirk &amp; T. Kunz &amp; F. Lunkeit               *</span>
<a name="l00007"></a>00007 <span class="comment">!     *                   Meteorologisches Institut                  *</span>
<a name="l00008"></a>00008 <span class="comment">!     *                      Universitaet Hamburg                    *</span>
<a name="l00009"></a>00009 <span class="comment">!     *                        Bundesstrasse 55                      *</span>
<a name="l00010"></a>00010 <span class="comment">!     *                          20146 HAMBURG                       *</span>
<a name="l00011"></a>00011 <span class="comment">!     * 20-Apr-2009                 GERMANY                          *</span>
<a name="l00012"></a>00012 <span class="comment">!     ****************************************************************</span>
<a name="l00013"></a>00013 
<a name="l00014"></a>00014 <span class="comment">!     ****************************************************************</span>
<a name="l00015"></a>00015 <span class="comment">!     * Insert your own code for modification of initial data to:    *</span>
<a name="l00016"></a>00016 <span class="comment">!     * subroutine modify_orography                                  *</span>
<a name="l00017"></a>00017 <span class="comment">!     * subroutine modify_ground_temperature                         *</span>
<a name="l00018"></a>00018 <span class="comment">!     ****************************************************************</span>
<a name="l00019"></a>00019 
<a name="l00020"></a>00020 <span class="comment">!     ****************************************************************</span>
<a name="l00021"></a>00021 <span class="comment">!     * PUMA in its default setup can run without initial data       *</span>
<a name="l00022"></a>00022 <span class="comment">!     * The default setup is an aqua planet with no orography and    *</span>
<a name="l00023"></a>00023 <span class="comment">!     * zonally symmetric forcing (newtonian cooling with Tr)        *</span>
<a name="l00024"></a>00024 <span class="comment">!     * The atmosphere starts at rest with no horizontal gradients   *</span>
<a name="l00025"></a>00025 <span class="comment">!     *                                                              *</span>
<a name="l00026"></a>00026 <span class="comment">!     * This preprocessor program performs following tasks:          *</span>
<a name="l00027"></a>00027 <span class="comment">!     * 1) Prepare a realistic orography (T21 or T42)                *</span>
<a name="l00028"></a>00028 <span class="comment">!     * 2) Enable user modification of this orography                *</span>
<a name="l00029"></a>00029 <span class="comment">!     * 3) Enable user modification of the ground temperature field  *</span>
<a name="l00030"></a>00030 <span class="comment">!     * 4) Adjust vertical profiles of Restoration Temperature       *</span>
<a name="l00031"></a>00031 <span class="comment">!     * 5) Adjust the mean value of surface pressure                 *</span>
<a name="l00032"></a>00032 <span class="comment">!     * 6) Build an initial Ps field adjusted to orography           *</span>
<a name="l00033"></a>00033 <span class="comment">!     * 7) Setup Yoden-profiles                                      *</span>
<a name="l00034"></a>00034 <span class="comment">!     *                                                              *</span>
<a name="l00035"></a>00035 <span class="comment">!     *   Inputfile: &lt;Naaa_surf_0129.sra&gt; with aaa=032,048,064, ...  *</span>
<a name="l00036"></a>00036 <span class="comment">!     *              &lt;Naaa_surf_0139.sra&gt; : Ts anomalies             *</span>
<a name="l00037"></a>00037 <span class="comment">!     * Outputfiles: &lt;Naaa_surf_0129.sra&gt; : topography [m2/s2]       *</span>
<a name="l00038"></a>00038 <span class="comment">!     *              &lt;Naaa_surf_0134.sra&gt; : Surface pressure [hPa]   *</span>
<a name="l00039"></a>00039 <span class="comment">!     *              &lt;Naaa_surf_0121.sra&gt; : Constant part of Tr      *</span>
<a name="l00040"></a>00040 <span class="comment">!     *              &lt;Naaa_surf_0122.sra&gt; : Variable part of Tr      *</span>
<a name="l00041"></a>00041 <span class="comment">!     *              &lt;Naaa_surf_0123.sra&gt; : Damping time scales      *</span>
<a name="l00042"></a>00042 <span class="comment">!     *                                                              *</span>
<a name="l00043"></a>00043 <span class="comment">!     * The outputfiles contain topography, surface pressure,        *</span>
<a name="l00044"></a>00044 <span class="comment">!     * the part of Tr, that is constant in time and the part pf Tr  *</span>
<a name="l00045"></a>00045 <span class="comment">!     * that can be modulated by an annual cycle.                    *</span>
<a name="l00046"></a>00046 <span class="comment">!     *                                                              *</span>
<a name="l00047"></a>00047 <span class="comment">!     * All files are written formatted, such avoiding the problems  *</span>
<a name="l00048"></a>00048 <span class="comment">!     * assigned to big endian and little endian machines            *</span>
<a name="l00049"></a>00049 <span class="comment">!     ****************************************************************</span>
<a name="l00050"></a>00050 
<a name="l00051"></a>00051 
<a name="l00052"></a>00052 <span class="comment">! ****************************************************************</span>
<a name="l00053"></a>00053 <span class="comment">! * The horizontal resolution of PUMA by the number of latitudes *</span>
<a name="l00054"></a>00054 <span class="comment">! * nlat is read from file &quot;resolution_namelist&quot;                 *</span>
<a name="l00055"></a>00055 <span class="comment">! ****************************************************************</span>
<a name="l00056"></a><a class="code" href="classpumamod.html#a3411ab6d530e7e20888d7bfbe0f2bc41">00056</a> <span class="keywordtype">integer</span> :: nlat = 32
<a name="l00057"></a>00057 
<a name="l00058"></a>00058 <span class="comment">! example values:  32,  48,  64, 128,  192,  256,  512,  1024</span>
<a name="l00059"></a>00059 <span class="comment">! truncation:     T21, T31, T42, T85, T127, T170, T341,  T682</span>
<a name="l00060"></a>00060 
<a name="l00061"></a>00061 
<a name="l00062"></a>00062 <span class="comment">! *****************************************************************</span>
<a name="l00063"></a>00063 <span class="comment">! * The number of sigma levels of PUMA are modified after reading *  </span>
<a name="l00064"></a>00064 <span class="comment">! * file &lt;resolution_namelist&gt;.                                   *     </span>
<a name="l00065"></a>00065 <span class="comment">! *****************************************************************</span>
<a name="l00066"></a><a class="code" href="classpumamod.html#a3de2d3dcdd767a858dfb9f64f129087f">00066</a> <span class="keywordtype">integer</span> :: nlev =   10 <span class="comment">! Levels</span>
<a name="l00067"></a>00067 
<a name="l00068"></a>00068 
<a name="l00069"></a>00069 <span class="comment">! *****************************************************************!</span>
<a name="l00070"></a>00070 <span class="comment">! * Grid related paramters, which are reset after reading the file !</span>
<a name="l00071"></a>00071 <span class="comment">! * &lt;resolution_namelist&gt;. All parameters are initialized for the  !</span>
<a name="l00072"></a>00072 <span class="comment">! * T21 truncation                                                 !</span>
<a name="l00073"></a>00073 <span class="comment">! *****************************************************************!</span>
<a name="l00074"></a><a class="code" href="classpumamod.html#ac6cf2d31f555e462d15dfb23afd6a035">00074</a> <span class="keywordtype">integer</span> :: nlon =   64 <span class="comment">! Longitudes = 2 * latitudes</span>
<a name="l00075"></a><a class="code" href="classpumamod.html#ae619e60539d80754ec4298f0fdc6724e">00075</a> <span class="keywordtype">integer</span> :: ntru =   21 <span class="comment">! (nlon-1) / 3</span>
<a name="l00076"></a><a class="code" href="classpumamod.html#aee2e0766afdaa439ad0c79c10289b723">00076</a> <span class="keywordtype">integer</span> :: nlpp =   32 <span class="comment">! Latitudes per process</span>
<a name="l00077"></a><a class="code" href="classpumamod.html#a8bbbf57ba00e0a60edcb5f55b6c4881f">00077</a> <span class="keywordtype">integer</span> :: nhor = 2048 <span class="comment">! Horizontal part</span>
<a name="l00078"></a><a class="code" href="classpumamod.html#a09581b8e97e093efc8ec479657f637bf">00078</a> <span class="keywordtype">integer</span> :: nlem =    9 <span class="comment">! Levels - 1</span>
<a name="l00079"></a><a class="code" href="classpumamod.html#a05c1015570a9ac8a74602db90dfe9113">00079</a> <span class="keywordtype">integer</span> :: nlep =   11 <span class="comment">! Levels + 1</span>
<a name="l00080"></a><a class="code" href="classpumamod.html#a44c4ca4a17cfda8c24d18f105166817f">00080</a> <span class="keywordtype">integer</span> :: nlsq =  100 <span class="comment">! Levels squared</span>
<a name="l00081"></a><a class="code" href="classpumamod.html#a3f387b7be204f54ea75b61f0be441430">00081</a> <span class="keywordtype">integer</span> :: ntp1 =   22 <span class="comment">! ntru + 1</span>
<a name="l00082"></a><a class="code" href="classpumamod.html#ae42b0619616180a024fc68c07e639f43">00082</a> <span class="keywordtype">integer</span> :: nrsp =  506 <span class="comment">! (ntru+1) * (ntru+2)</span>
<a name="l00083"></a><a class="code" href="classpumamod.html#a40c76f46506eb6542ad7ccbed8dd35ba">00083</a> <span class="keywordtype">integer</span> :: ncsp =  253 <span class="comment">! nrsp / 2</span>
<a name="l00084"></a><a class="code" href="classpumamod.html#a21fc1a421eaa018055d3e84704d8e594">00084</a> <span class="keywordtype">integer</span> :: nspp =  506 <span class="comment">! nodes per process</span>
<a name="l00085"></a><a class="code" href="classpumamod.html#a16c9776cd5fc9e03115b811020c87c5a">00085</a> <span class="keywordtype">integer</span> :: nesp =  506 <span class="comment">! number of extended modes</span>
<a name="l00086"></a><a class="code" href="classpumamod.html#a92c91c6f6d1af535729b74c33c515e87">00086</a> <span class="keywordtype">integer</span> :: nzom =   44 <span class="comment">! Number of zonal modes</span>
<a name="l00087"></a>00087 
<a name="l00088"></a><a class="code" href="classpumamod.html#a6f175a2b93a1284714be362b3a1d6f39">00088</a> <span class="keywordtype">integer</span> :: nlah =   16 <span class="comment">! Half of latitudes</span>
<a name="l00089"></a><a class="code" href="classpumamod.html#a5ac284ed19ba1f7367a214afe2193c1e">00089</a> <span class="keywordtype">integer</span> :: nhpp =   16 <span class="comment">! Half latitudes per process</span>
<a name="l00090"></a>00090 
<a name="l00091"></a>00091 <span class="comment">!     ****************************************************************</span>
<a name="l00092"></a>00092 <span class="comment">!     * Don&#39;t touch the following parameter definitions !            *</span>
<a name="l00093"></a>00093 <span class="comment">!     ****************************************************************</span>
<a name="l00094"></a>00094 
<a name="l00095"></a>00095       parameter(AKAP   = 0.286)            <span class="comment">! Kappa</span>
<a name="l00096"></a>00096       parameter(ALR    = 0.0065)           <span class="comment">! Lapse rate</span>
<a name="l00097"></a>00097       parameter(EZ     = 1.632993161855452D0) <span class="comment">! ez = 1 / sqrt(3/8)</span>
<a name="l00098"></a>00098       parameter(GA     = 9.81)             <span class="comment">! Gravity</span>
<a name="l00099"></a>00099       parameter(GASCON = 287.0)            <span class="comment">! Gas constant</span>
<a name="l00100"></a>00100       parameter(PI     = 3.141592653589793D0) <span class="comment">! Pi</span>
<a name="l00101"></a>00101       parameter(TWOPI  = PI + PI)             <span class="comment">! 2 Pi</span>
<a name="l00102"></a>00102       parameter(PLARAD_EARTH = 6371000.0)        <span class="comment">! Planet radius</span>
<a name="l00103"></a>00103       parameter(SID_DAY_EARTH= 86164.)      <span class="comment">! Siderial day Earth 23h 56m 04s</span>
<a name="l00104"></a>00104       parameter(PNU    = 0.02)             <span class="comment">! Time filter</span>
<a name="l00105"></a>00105       parameter(PNU21  = 1.0 - 2.0*PNU)    <span class="comment">! Time filter 2</span>
<a name="l00106"></a>00106       parameter(PSURF  = 101100.0)         <span class="comment">! Surface pressure [Pa]</span>
<a name="l00107"></a>00107       parameter(WW     = 0.00007292)       <span class="comment">! Rotation speed [1/sec]</span>
<a name="l00108"></a>00108       parameter(CV     = PLARAD_EARTH * WW)      <span class="comment">! cv</span>
<a name="l00109"></a>00109       parameter(CT     = CV*CV/GASCON)     <span class="comment">! ct</span>
<a name="l00110"></a>00110       parameter(OSCAR  = CV*CV/GA)         <span class="comment">! Scale Orography</span>
<a name="l00111"></a>00111 
<a name="l00112"></a>00112 
<a name="l00113"></a>00113 <span class="comment">! *************</span>
<a name="l00114"></a>00114 <span class="comment">! * filenames *</span>
<a name="l00115"></a>00115 <span class="comment">! *************</span>
<a name="l00116"></a>00116 <span class="comment">character (256) :: resolution_namelist = &quot;resolution_namelist&quot;</span>
<a name="l00117"></a>00117 <span class="comment">character (256) :: puma_namelist       = &quot;puma_namelist&quot;</span>
<a name="l00118"></a>00118 <span class="comment">character (256) :: ppp_puma_txt        = &quot;ppp-puma.txt&quot;</span>
<a name="l00119"></a>00119 
<a name="l00120"></a>00120 <span class="comment">! *****************************************************************</span>
<a name="l00121"></a>00121 <span class="comment">! * For multiruns the instance number is appended to the filename *</span>
<a name="l00122"></a>00122 <span class="comment">! * e.g.: puma_namelist_1 puma_diag_1 etc. for instance # 1       *</span>
<a name="l00123"></a>00123 <span class="comment">! *****************************************************************</span>
<a name="l00124"></a>00124 
<a name="l00125"></a>00125 
<a name="l00126"></a>00126 
<a name="l00127"></a>00127 
<a name="l00128"></a>00128 
<a name="l00129"></a>00129 
<a name="l00130"></a>00130 
<a name="l00131"></a>00131 
<a name="l00132"></a>00132 
<a name="l00133"></a>00133 
<a name="l00134"></a>00134 <span class="comment">!     **************************</span>
<a name="l00135"></a>00135 <span class="comment">!     * Global Integer Scalars *</span>
<a name="l00136"></a>00136 <span class="comment">!     **************************</span>
<a name="l00137"></a>00137 
<a name="l00138"></a><a class="code" href="classpumamod.html#a3a1c81fe64adaf2b041e815e66e59e8d">00138</a>       <span class="keywordtype">integer</span> :: kick     =  1 <span class="comment">! kick &gt; 1 initializes eddy generation</span>
<a name="l00139"></a><a class="code" href="classpumamod.html#ae82bde2eb42c2fab72e9d6c5d7b009f7">00139</a>       <span class="keywordtype">integer</span> :: mpstep   =  0 <span class="comment">! PUMA</span>
<a name="l00140"></a><a class="code" href="classpumamod.html#a865b5e1934a6f612b35bade36c2d15bd">00140</a>       <span class="keywordtype">integer</span> :: nafter   =  0 <span class="comment">! PUMA</span>
<a name="l00141"></a><a class="code" href="classpumamod.html#a0b0e7fc78c5ac39d54ce42a9902447a8">00141</a>       <span class="keywordtype">integer</span> :: nwpd     =  1 <span class="comment">! PUMA</span>
<a name="l00142"></a><a class="code" href="classpumamod.html#ab5156c8a13ca4542d36017a32cb2e276">00142</a>       <span class="keywordtype">integer</span> :: ncoeff   =  0 <span class="comment">! number of modes to print</span>
<a name="l00143"></a><a class="code" href="classpumamod.html#a9eabecdccc9c5124168c5d89bc15a1d5">00143</a>       <span class="keywordtype">integer</span> :: ndel     =  6 <span class="comment">! ndel</span>
<a name="l00144"></a><a class="code" href="classpumamod.html#a54f043f98baef026666945f1440f91b5">00144</a>       <span class="keywordtype">integer</span> :: ndiag    = 12 <span class="comment">! write diagnostics interval</span>
<a name="l00145"></a><a class="code" href="classpumamod.html#ae5867c6d3c10e9065d7b541ca679d112">00145</a>       <span class="keywordtype">integer</span> :: nkits    =  3 <span class="comment">! number of initial timesteps</span>
<a name="l00146"></a><a class="code" href="classpumamod.html#a6d50c7a2bbb6196702e7f4f4a0dc5be8">00146</a>       <span class="keywordtype">integer</span> :: nlevt    =  9 <span class="comment">! tropospheric levels (set_vertical_grid)</span>
<a name="l00147"></a>00147 
<a name="l00148"></a><a class="code" href="classpumamod.html#a32948de893d3d7aff01b6372d649f0f6">00148</a>       <span class="keywordtype">integer</span> :: ngui     =  0 <span class="comment">! PUMA variable</span>
<a name="l00149"></a><a class="code" href="classpumamod.html#a87bc07500cf139d8845b380e0dfbe14f">00149</a>       <span class="keywordtype">integer</span> :: nguidbg  =  0 <span class="comment">! PUMA variable</span>
<a name="l00150"></a><a class="code" href="classpumamod.html#aaee4fe4165cbc11489f204620de859b8">00150</a>       <span class="keywordtype">integer</span> :: nqspec   =  1 <span class="comment">! PLASIM variable</span>
<a name="l00151"></a><a class="code" href="classpumamod.html#a461c71616d123104512f1679325a8ecf">00151</a>       <span class="keywordtype">integer</span> :: nrun     =  0 <span class="comment">! PUMA variable</span>
<a name="l00152"></a><a class="code" href="classpumamod.html#a856ad9c4756a0ccbf7fd325b06f1f900">00152</a>       <span class="keywordtype">integer</span> :: nstep    =  0 <span class="comment">! current timestep</span>
<a name="l00153"></a><a class="code" href="classpumamod.html#a01f12039746034a94bf226982a6d64ee">00153</a>       <span class="keywordtype">integer</span> :: nstop    =  0 <span class="comment">! finishing timestep</span>
<a name="l00154"></a><a class="code" href="classpumamod.html#aed2697cde4ae8454c1807fba6dece761">00154</a>       <span class="keywordtype">integer</span> :: nsync    =  0 <span class="comment">! PUMA variable</span>
<a name="l00155"></a><a class="code" href="classpumamod.html#a4e689422a383ca3ce7c337c46c66dc71">00155</a>       <span class="keywordtype">integer</span> :: ntspd    = 24 <span class="comment">! number of timesteps per day</span>
<a name="l00156"></a><a class="code" href="classpumamod.html#a137990cf922778de47c453b0556f611a">00156</a>       <span class="keywordtype">integer</span> :: ncu      =  0 <span class="comment">! check unit (debug output)</span>
<a name="l00157"></a><a class="code" href="classpumamod.html#ae291f08906944ef6e0aff0307de74028">00157</a>       <span class="keywordtype">integer</span> :: noro     =  0 <span class="comment">! 1: read orography</span>
<a name="l00158"></a>00158                                <span class="comment">! 2: orography is computed (sine wave)</span>
<a name="l00159"></a>00159                                <span class="comment">! 3: orography is computed (gauss)</span>
<a name="l00160"></a>00160 
<a name="l00161"></a><a class="code" href="classpumamod.html#a2724444f4ea0cd1c9ddf8f7b40a0cd5c">00161</a>       <span class="keywordtype">integer</span> :: norox    =  0 <span class="comment">! x-wavenumber of idealized orography</span>
<a name="l00162"></a><a class="code" href="classpumamod.html#ad9f0e1be51ddecef14ef8259d22f110b">00162</a>       <span class="keywordtype">integer</span> :: nreverse =  0 <span class="comment">! t-gradient reversal in stratosphere; 0:no 1:yes</span>
<a name="l00163"></a><a class="code" href="classpumamod.html#a1454296ae1e1d03a284178628a4a3e84">00163</a>       <span class="keywordtype">integer</span> :: ncorrect =  0 <span class="comment">! correct tr due to orography (0:no, 1:yes)</span>
<a name="l00164"></a><a class="code" href="classpumamod.html#a688f0876bf83c724d71700aa98835d6e">00164</a>       <span class="keywordtype">integer</span> :: nsym     =  0 <span class="comment">! produces total symmetric initial conditions </span>
<a name="l00165"></a>00165 
<a name="l00166"></a><a class="code" href="classpumamod.html#aca88948c25a082cc21503423423a9cad">00166</a>       <span class="keywordtype">integer</span> :: nsrv     =  1 <span class="comment">! 1: write gridpoint fields for diagnostics</span>
<a name="l00167"></a><a class="code" href="classpumamod.html#a1f0d5ea8b0f0de798929e63bb5904e86">00167</a>       <span class="keywordtype">integer</span> :: lon1oro  =  0 <span class="comment">! Define rectangle for anomaly</span>
<a name="l00168"></a><a class="code" href="classpumamod.html#a5acbb0c115c64b84b8b1b25ad84f30aa">00168</a>       <span class="keywordtype">integer</span> :: lon2oro  =  0 <span class="comment">! </span>
<a name="l00169"></a><a class="code" href="classpumamod.html#aa7bc46dd3fcacd50e1946b36f1df9f6e">00169</a>       <span class="keywordtype">integer</span> :: lat1oro  =  0 <span class="comment">! </span>
<a name="l00170"></a><a class="code" href="classpumamod.html#ab0d522022938c1aea11f6c7e31ad8e65">00170</a>       <span class="keywordtype">integer</span> :: lat2oro  =  0 <span class="comment">! </span>
<a name="l00171"></a><a class="code" href="classpumamod.html#a57aac3712e7ae661fa9dd04fe6495ff0">00171</a>       <span class="keywordtype">integer</span> :: ntgr     =  0 <span class="comment">! 1: read ground temperature</span>
<a name="l00172"></a><a class="code" href="classpumamod.html#a5413d20acb64106fee3e0b8cd6b99efd">00172</a>       <span class="keywordtype">integer</span> :: lon1tgr  =  0 <span class="comment">! Define rectangle for anomaly</span>
<a name="l00173"></a><a class="code" href="classpumamod.html#a76c8a5bcafbc5b01c5d6c9732a5cdcf1">00173</a>       <span class="keywordtype">integer</span> :: lon2tgr  =  0 <span class="comment">! </span>
<a name="l00174"></a><a class="code" href="classpumamod.html#a92dedf7e953e229c20b8bb58cb042415">00174</a>       <span class="keywordtype">integer</span> :: lat1tgr  =  0 <span class="comment">! </span>
<a name="l00175"></a><a class="code" href="classpumamod.html#a3f3522edc6079ba74938bdcf2a780610">00175</a>       <span class="keywordtype">integer</span> :: lat2tgr  =  0 <span class="comment">! </span>
<a name="l00176"></a><a class="code" href="classpumamod.html#a4e187fd01cc77d813b423d7fb921252d">00176</a>       <span class="keywordtype">integer</span> :: nstrato  =  0 <span class="comment">! 1: Torben&#39;s stratosphere forcing</span>
<a name="l00177"></a><a class="code" href="classpumamod.html#adb0a88ab45e621b010dc35fb9648b4e4">00177</a>       <span class="keywordtype">integer</span> :: nsponge  =  0 <span class="comment">! Switch for sponge layer</span>
<a name="l00178"></a><a class="code" href="classpumamod.html#a0f47e459576ce1b123298a6c3dd7d91b">00178</a>       <span class="keywordtype">integer</span> :: nhelsua  =  0 <span class="comment">! 1: Set up Held &amp; Suarez T_R field</span>
<a name="l00179"></a>00179 <span class="comment">!                                   instead of original PUMA T_R field</span>
<a name="l00180"></a>00180 <span class="comment">!                                2: Set up Held &amp; Suarez T_R field</span>
<a name="l00181"></a>00181 <span class="comment">!                                   instead of original PUMA T_R field</span>
<a name="l00182"></a>00182 <span class="comment">!                                   AND use latitudinally varying</span>
<a name="l00183"></a>00183 <span class="comment">!                                   heating timescale in PUMA (H&amp;Z(94)),</span>
<a name="l00184"></a>00184 <span class="comment">!                                   irrelevant for PumaPreProcessor (ppp)</span>
<a name="l00185"></a>00185 <span class="comment">!                                3: Use latitudinally varying</span>
<a name="l00186"></a>00186 <span class="comment">!                                   heating timescale in PUMA (H&amp;Z(94)),</span>
<a name="l00187"></a>00187 <span class="comment">!                                   irrelevant for PumaPreProcessor (ppp)</span>
<a name="l00188"></a><a class="code" href="classpumamod.html#a57b5b04397af1927fb03ce17e7376949">00188</a>       <span class="keywordtype">integer</span>  :: ntestgp = 0 <span class="comment">! switch 0/1 produce a second set of restoration </span>
<a name="l00189"></a>00189                               <span class="comment">! restoration temperatures and damping time scales</span>
<a name="l00190"></a><a class="code" href="classpumamod.html#a24838036db3be03c1a4b61262d662f89">00190</a>       <span class="keywordtype">integer</span>  :: nvg     = 0 <span class="comment">! type of vertical grid</span>
<a name="l00191"></a>00191                               <span class="comment">! 0 = linear</span>
<a name="l00192"></a>00192                               <span class="comment">! 1 = Scinocca &amp; Haynes</span>
<a name="l00193"></a>00193                               <span class="comment">! 2 = Polvani &amp; Kushner</span>
<a name="l00194"></a>00194 
<a name="l00195"></a><a class="code" href="classpumamod.html#ab503ecf77d192f1191181556fa21346e">00195</a>       <span class="keywordtype">integer</span> :: nyoden   = 0 <span class="comment">! &gt; 0 Read yoden profile t0(:) and dt(:)</span>
<a name="l00196"></a><a class="code" href="classpumamod.html#a9cd1e899ff739d1fde6cb241167a0b14">00196</a>       <span class="keywordtype">integer</span> :: npackgp  = 1 <span class="comment">! used in PUMA</span>
<a name="l00197"></a><a class="code" href="classpumamod.html#a3df9e3f62930046dd998328d83f90782">00197</a>       <span class="keywordtype">integer</span> :: npacksp  = 1 <span class="comment">! used in PUMA</span>
<a name="l00198"></a><a class="code" href="classpumamod.html#ab83d8b5f0baf291cbf7be672044ddbaf">00198</a>       <span class="keywordtype">integer</span> :: noutput  = 0 <span class="comment">! used in PUMA</span>
<a name="l00199"></a><a class="code" href="classpumamod.html#a44281642d8b5de10c4c6309d65787612">00199</a>       <span class="keywordtype">integer</span> :: noutsrv  = 0 <span class="comment">! used in PUMA</span>
<a name="l00200"></a>00200 
<a name="l00201"></a>00201 
<a name="l00202"></a>00202 <span class="comment">!     These three predifined Yoden profiles may be selected by setting</span>
<a name="l00203"></a>00203 <span class="comment">!     NYODEN= 1, 3 or 5 and nlev=20</span>
<a name="l00204"></a>00204 
<a name="l00205"></a><a class="code" href="classpumamod.html#a90a6d9081ae4e97368fd93f921dca1d8">00205</a>       <span class="keywordtype">real</span> :: t0yod1(20)  = (/224.14,213.91,211.36,212.95,217.56 
<a name="l00206"></a>00206                              ,224.07,231.24,237.73,243.54,248.87 
<a name="l00207"></a>00207                              ,253.41,257.83,261.72,265.60,268.96 
<a name="l00208"></a>00208                              ,272.33,275.36,278.34,281.06,283.74/)
<a name="l00209"></a><a class="code" href="classpumamod.html#a01f849a7ffd4d78c73588a15edbc3527">00209</a>       <span class="keywordtype">real</span> :: dtyod1(20)  = (/  0.00,  0.00,  2.00,  9.19, 19.13 
<a name="l00210"></a>00210                              , 28.26, 34.91, 40.37, 45.10, 49.19 
<a name="l00211"></a>00211                              , 52.05, 54.69, 56.20, 57.70, 58.31 
<a name="l00212"></a>00212                              , 58.91, 59.26, 59.56, 59.76, 59.94/)
<a name="l00213"></a><a class="code" href="classpumamod.html#ab716103cdc0613b90aea0b0f3f76890e">00213</a>       <span class="keywordtype">real</span> :: t0yod3(20)  = (/265.14,254.91,246.36,240.95,237.56 
<a name="l00214"></a>00214                              ,234.65,235.24,237.73,243.54,248.87 
<a name="l00215"></a>00215                              ,253.41,257.83,261.72,265.60,268.96 
<a name="l00216"></a>00216                              ,272.33,275.36,278.34,281.06,283.74/)
<a name="l00217"></a><a class="code" href="classpumamod.html#a0f35364ab66cbd60fdedebdd3c776eee">00217</a>       <span class="keywordtype">real</span> :: dtyod3(20)  = (/  0.00, -3.05,-20.32,-26.19,-28.13 
<a name="l00218"></a>00218                              , 28.26, 34.91, 40.37, 45.10, 49.19 
<a name="l00219"></a>00219                              , 52.05, 54.69, 56.20, 57.70, 58.31 
<a name="l00220"></a>00220                              , 58.91, 59.26, 59.56, 59.76, 59.94/)
<a name="l00221"></a><a class="code" href="classpumamod.html#aae0fef74d51d5c0b6ac17c46aee81602">00221</a>       <span class="keywordtype">real</span> :: t0yod5(20)  = (/305.00,298.00,292.00,286.00,280.00 
<a name="l00222"></a>00222                              ,274.00,268.00,261.00,256.54,254.87 
<a name="l00223"></a>00223                              ,253.41,257.83,261.72,265.60,268.96 
<a name="l00224"></a>00224                              ,272.33,275.36,278.34,281.06,283.74/)
<a name="l00225"></a><a class="code" href="classpumamod.html#ac054354166003ed7452262a59c8edf70">00225</a>       <span class="keywordtype">real</span> :: dtyod5(20)  = (/  0.00, -3.05,-21.32,-27.19,-29.13 
<a name="l00226"></a>00226                              ,-32.26,-34.91,-40.37,-45.10,-49.19 
<a name="l00227"></a>00227                              , 52.05, 54.69, 56.20, 57.70, 58.31 
<a name="l00228"></a>00228                              , 58.91, 59.26, 59.56, 59.76, 59.94/)
<a name="l00229"></a><a class="code" href="classpumamod.html#ac3109427e5fbc7662c648cc9c556bcee">00229</a>       <span class="keywordtype">real</span> :: t0yod7(20)  = (/265.14,254.91,246.36,240.95,237.56 
<a name="l00230"></a>00230                              ,234.65,235.24,237.73,243.54,248.87 
<a name="l00231"></a>00231                              ,253.41,257.83,261.72,265.60,268.96 
<a name="l00232"></a>00232                              ,272.33,275.36,278.34,281.06,283.74/)
<a name="l00233"></a><a class="code" href="classpumamod.html#a062241f749f35c2747f925d690b667ef">00233</a>       <span class="keywordtype">real</span> :: dtyod7(20)  = (/  0.00,-25.05,-64.32,-58.19,-22.13 
<a name="l00234"></a>00234                              , 28.26, 34.91, 40.37, 45.10, 49.19 
<a name="l00235"></a>00235                              , 52.05, 54.69, 56.20, 57.70, 58.31 
<a name="l00236"></a>00236                              , 58.91, 59.26, 59.56, 59.76, 60.00/)
<a name="l00237"></a><a class="code" href="classpumamod.html#a5a6a9e0c6cef3144d8d0c455fa24e42a">00237</a>       <span class="keywordtype">real</span> :: t0yod8(20)  = (/265.14,254.91,246.36,240.95,237.56 
<a name="l00238"></a>00238                              ,234.65,235.24,237.73,243.54,248.87 
<a name="l00239"></a>00239                              ,253.41,257.83,261.72,265.60,268.96 
<a name="l00240"></a>00240                              ,272.33,275.36,278.34,281.06,283.74/)
<a name="l00241"></a><a class="code" href="classpumamod.html#a850c526a93c8b38f08112d84f46c3d61">00241</a>       <span class="keywordtype">real</span> :: dtyod8(20)  = (/  0.00,-25.05,-64.32,-58.19,-22.13 
<a name="l00242"></a>00242                              , 18.26, 24.91, 30.37, 35.10, 39.19 
<a name="l00243"></a>00243                              , 42.05, 44.69, 46.20, 47.70, 48.31 
<a name="l00244"></a>00244                              , 48.91, 49.26, 49.56, 49.76, 50.00/)
<a name="l00245"></a><a class="code" href="classpumamod.html#ac0e77a6a01e1b88a9c1b29535bf4a5d5">00245</a>       <span class="keywordtype">real</span> :: t0yod9(20)  = (/265.14,254.91,246.36,240.95,237.56 
<a name="l00246"></a>00246                              ,234.65,235.24,237.73,243.54,248.87 
<a name="l00247"></a>00247                              ,253.41,257.83,261.72,265.60,268.96 
<a name="l00248"></a>00248                              ,272.33,275.36,278.34,281.06,283.74/)
<a name="l00249"></a><a class="code" href="classpumamod.html#a9599e6b32e3833c098fe5029b7ee70be">00249</a>       <span class="keywordtype">real</span> :: dtyod9(20)  = (/  0.00,  0.00,  0.00,  0.00,  0.00 
<a name="l00250"></a>00250                              , 28.26, 34.91, 40.37, 45.10, 49.19 
<a name="l00251"></a>00251                              , 52.05, 54.69, 56.20, 57.70, 58.31 
<a name="l00252"></a>00252                              , 58.91, 59.26, 59.56, 59.76, 60.00/)
<a name="l00253"></a>00253 
<a name="l00254"></a><a class="code" href="classpumamod.html#a4766e3a4673c92cf9958d8241cbcbc65">00254</a>       <span class="keywordtype">integer</span> :: nfls     = 1  <span class="comment">! =1: lower stratospheric forcing is applied,</span>
<a name="l00255"></a>00255 <span class="comment">!                                see parameters flsp0, flsdp, flsamp and</span>
<a name="l00256"></a>00256 <span class="comment">!                                flsoff below</span>
<a name="l00257"></a>00257 
<a name="l00258"></a>00258 <span class="comment">!     ***********************</span>
<a name="l00259"></a>00259 <span class="comment">!     * Global Real Scalars *</span>
<a name="l00260"></a>00260 <span class="comment">!     ***********************</span>
<a name="l00261"></a>00261 
<a name="l00262"></a><a class="code" href="classpumamod.html#a439717e747222ba51cf20b010f3e516c">00262</a>       <span class="keywordtype">real</span> :: delt             <span class="comment">! 2 pi / ntspd timestep interval</span>
<a name="l00263"></a><a class="code" href="classpumamod.html#a42f46b51b6a92eed14840e3c161d80a1">00263</a>       <span class="keywordtype">real</span> :: delt2            <span class="comment">! 2 * delt</span>
<a name="l00264"></a>00264 <span class="comment">!</span>
<a name="l00265"></a>00265 <span class="comment">!     namelist parameter for yoden setup</span>
<a name="l00266"></a>00266 <span class="comment">!     (for arrays to and dt see namelist arrays below)</span>
<a name="l00267"></a>00267 
<a name="l00268"></a><a class="code" href="classpumamod.html#ae1160d24a7abdc97bc3389044621d3d7">00268</a>       <span class="keywordtype">real</span> :: dtep  =    60.0  <span class="comment">! delta T equator &lt;-&gt; pole  [K]</span>
<a name="l00269"></a><a class="code" href="classpumamod.html#a9f9ff76b20700deda41db8834db4b3c3">00269</a>       <span class="keywordtype">real</span> :: dtns  =     0.0  <span class="comment">! delta T   north &lt;-&gt; south [K]</span>
<a name="l00270"></a><a class="code" href="classpumamod.html#a58d401b03b69eccd92e7864d3d821c4c">00270</a>       <span class="keywordtype">real</span> :: dtrop = 12000.0  <span class="comment">! Tropopause height [m]</span>
<a name="l00271"></a><a class="code" href="classpumamod.html#ac02146e243330a0df79fb4657d748ef4">00271</a>       <span class="keywordtype">real</span> :: dttrp =     2.0  <span class="comment">! Tropopause smoothing [K]</span>
<a name="l00272"></a><a class="code" href="classpumamod.html#af197fe0d42694469ea20c754ddfb1172">00272</a>       <span class="keywordtype">real</span> :: dtzz  =    10.0  <span class="comment">! delta(Theta)/H additional lapserate in</span>
<a name="l00273"></a><a class="code" href="classpumamod.html#a3584bf754ed1ce4f81f9ae5c2d909c55">00273</a>       <span class="keywordtype">real</span> :: syncstr=    0.0  <span class="comment">! PUMA variable</span>
<a name="l00274"></a>00274 <span class="comment">!                                Held &amp; Suarez T_R field</span>
<a name="l00275"></a><a class="code" href="classpumamod.html#a7e20a606bb6a44f41a19e4b5f5a8cd3c">00275</a>       <span class="keywordtype">real</span> :: ttp   =   200.0  <span class="comment">! Tropopause temperature in</span>
<a name="l00276"></a>00276 <span class="comment">!                                Held &amp; Suarez T_R field</span>
<a name="l00277"></a><a class="code" href="classpumamod.html#aacb92e3b939fec35b06f04caded9fc93">00277</a>       <span class="keywordtype">real</span> :: plavor=    EZ    <span class="comment">! planetary vorticity</span>
<a name="l00278"></a><a class="code" href="classpumamod.html#a80df9669ec5bab4a057cae01f5c1a2e6">00278</a>       <span class="keywordtype">real</span> :: rotspd =     1.0  <span class="comment">! rotation speed 1.0 = normal Earth rotation</span>
<a name="l00279"></a><a class="code" href="classpumamod.html#abc4579c91fd4501ba251a05dd1bf516c">00279</a>       <span class="keywordtype">real</span> :: sigmax=  6.0e-7  <span class="comment">! sigma for top half level</span>
<a name="l00280"></a><a class="code" href="classpumamod.html#a3c92fd62d271fb04326fc32013d8c199">00280</a>       <span class="keywordtype">real</span> :: tdiss =     0.25 <span class="comment">! diffusion time scale [days]</span>
<a name="l00281"></a><a class="code" href="classpumamod.html#aa0e01ba5d349492b3449f389b5f93fed">00281</a>       <span class="keywordtype">real</span> :: tac   =       0. <span class="comment">! length of annual cycle [days] (0 = no cycle)</span>
<a name="l00282"></a><a class="code" href="classpumamod.html#a7784d994e8d1702725dd2241891c1405">00282</a>       <span class="keywordtype">real</span> :: pac   =       0. <span class="comment">! phase of the annual cycle [days]</span>
<a name="l00283"></a><a class="code" href="classpumamod.html#a65df7e27542e483c7082758755d1f328">00283</a>       <span class="keywordtype">real</span> :: tgr   =   288.0  <span class="comment">! Ground Temperature in mean profile [K]</span>
<a name="l00284"></a><a class="code" href="classpumamod.html#aa50284698e4f6c0677ad8674c812a287">00284</a>       <span class="keywordtype">real</span> :: oroano=     0.0  <span class="comment">! Orography anomaly in [gpm]</span>
<a name="l00285"></a><a class="code" href="classpumamod.html#aacd677d71f3a3b99afa150ea6e76ffd7">00285</a>       <span class="keywordtype">real</span> :: tgrano=     0.0  <span class="comment">! Ground temperature anomaly in [K]</span>
<a name="l00286"></a>00286 <span class="comment">!!</span>
<a name="l00287"></a><a class="code" href="classpumamod.html#acc7c9a43a2f8163077730a971e145878">00287</a>       <span class="keywordtype">real</span> :: alrs  =   -0.0000<span class="comment">! stratospheric lapse rate [K/m]</span>
<a name="l00288"></a><a class="code" href="classpumamod.html#aed84e71b62422066731030c119782c49">00288</a>       <span class="keywordtype">real</span> :: horo  =    0.0   <span class="comment">! height of the idealized orography [m]</span>
<a name="l00289"></a><a class="code" href="classpumamod.html#abc7fb7a57043486f15c7aca03158fb2f">00289</a>       <span class="keywordtype">real</span> :: orofac=    1.0   <span class="comment">! factor to scale the orograpy</span>
<a name="l00290"></a><a class="code" href="classpumamod.html#a5d1817a2b6703189d6ab73252b1996af">00290</a>       <span class="keywordtype">real</span> :: ttropo=   250.0  <span class="comment">! temp. at tropopause</span>
<a name="l00291"></a>00291 <span class="comment">!!</span>
<a name="l00292"></a><a class="code" href="classpumamod.html#aabd49cfc66d47dea3cf55589fc8ddabc">00292</a>       <span class="keywordtype">real</span> :: dorox  =    0.0   <span class="comment">! lon. base point for gauss mountain [dec]</span>
<a name="l00293"></a><a class="code" href="classpumamod.html#a2775f20201557322bc0de9c6967cc476">00293</a>       <span class="keywordtype">real</span> :: doroy  =    0.0   <span class="comment">! lat. base point for gauss mountain [dec]</span>
<a name="l00294"></a><a class="code" href="classpumamod.html#a848fc48f89796c7e1bfb0b1a6d2edb50">00294</a>       <span class="keywordtype">real</span> :: doroxs =    0.0   <span class="comment">! gauss mountain scale in lon.-dir. [dec]</span>
<a name="l00295"></a><a class="code" href="classpumamod.html#ad8bf2c0adad70f111c86eb8924c1c52c">00295</a>       <span class="keywordtype">real</span> :: doroys =    0.0   <span class="comment">! gauss mountain scale in lat.-dir. [dec]</span>
<a name="l00296"></a>00296 
<a name="l00297"></a><a class="code" href="classpumamod.html#a2ff5f72c2ec1bb2f7a1931932165c297">00297</a>       <span class="keywordtype">real</span> :: tauta  =    40.0  <span class="comment">! heating timescale far from surface [days]</span>
<a name="l00298"></a><a class="code" href="classpumamod.html#a3e769cf019402107f3c6e96b8740cf35">00298</a>       <span class="keywordtype">real</span> :: tauts  =     4.0  <span class="comment">! heating timescale close to surface [days] </span>
<a name="l00299"></a><a class="code" href="classpumamod.html#a9c5b63f9c6cf129e3aa566b6343beb6a">00299</a>       <span class="keywordtype">real</span> :: sid_day=  SID_DAY_EARTH <span class="comment">! siderial day [sec]</span>
<a name="l00300"></a>00300 
<a name="l00301"></a>00301 
<a name="l00302"></a>00302 
<a name="l00303"></a><a class="code" href="classpumamod.html#ad8b8310adc7cc23bb372abec1bb098b5">00303</a>       <span class="keywordtype">real</span> :: zsigb  =     0.7  <span class="comment">! sigma_b for Held&amp;Suarez frict. and heat. </span>
<a name="l00304"></a>00304                                 <span class="comment">! time scale </span>
<a name="l00305"></a>00305 
<a name="l00306"></a>00306 
<a name="l00307"></a>00307 
<a name="l00308"></a>00308 <span class="comment">!     * parameter for stratospheric forcing *</span>
<a name="l00309"></a>00309 
<a name="l00310"></a><a class="code" href="classpumamod.html#aaf1e5289f2d9067fb27ac9ac6a07e554">00310</a>       <span class="keywordtype">real</span> :: alrpv =   0.002  <span class="comment">! Vertical lapse rate of stratospheric</span>
<a name="l00311"></a>00311 <span class="comment">!                                polar vortex forcing restoration</span>
<a name="l00312"></a>00312 <span class="comment">!                                temperature field. It corresponds to</span>
<a name="l00313"></a>00313 <span class="comment">!                                &#39;gamma&#39; in Polvani &amp; Kushner (2002).</span>
<a name="l00314"></a>00314 <span class="comment">!                                But alrpv is in [K/m], thus,</span>
<a name="l00315"></a>00315 <span class="comment">!                                alrpv=0.002 corresponds to &#39;gamma=2&#39;</span>
<a name="l00316"></a>00316 <span class="comment">!                                in P&amp;K (2002).</span>
<a name="l00317"></a><a class="code" href="classpumamod.html#a3d7cf5223d98e0c95a4377560f9aac6c">00317</a>       <span class="keywordtype">real</span> :: radpv = 50.      <span class="comment">! Radius of stratospheric polar vortex</span>
<a name="l00318"></a>00318 <span class="comment">!                                forcing [deg latitude]</span>
<a name="l00319"></a><a class="code" href="classpumamod.html#a69b908f8d7731d272c19d329fcd33706">00319</a>       <span class="keywordtype">real</span> :: edgepv = 10.     <span class="comment">! Width of edge of stratospheric polar</span>
<a name="l00320"></a>00320 <span class="comment">!                                vortex forcing [deg latitude].</span>
<a name="l00321"></a>00321 <span class="comment">!                                If edgepv=0., then no polar vortex is</span>
<a name="l00322"></a>00322 <span class="comment">!                                set up.</span>
<a name="l00323"></a><a class="code" href="classpumamod.html#a7171bac7e6ef17b935eac4171b1149ff">00323</a>       <span class="keywordtype">real</span> :: pmaxpv = 10000.  <span class="comment">! Lower boundary of stratospheric polar</span>
<a name="l00324"></a>00324 <span class="comment">!                                vortex forcing, max. pressure [Pa].</span>
<a name="l00325"></a>00325 <span class="comment">!                                If pmaxpv=0. then pmaxpv is set to the</span>
<a name="l00326"></a>00326 <span class="comment">!                                pressure at tropopause height, specified</span>
<a name="l00327"></a>00327 <span class="comment">!                                by dtrop, according to the US standard</span>
<a name="l00328"></a>00328 <span class="comment">!                                atmosphere (USSA) vertical profile, used</span>
<a name="l00329"></a>00329 <span class="comment">!                                for contruction of the restoration</span>
<a name="l00330"></a>00330 <span class="comment">!                                temperature field. With the standard</span>
<a name="l00331"></a>00331 <span class="comment">!                                setting (dtrop=11000m, ALR=0.0065K/m,</span>
<a name="l00332"></a>00332 <span class="comment">!                                tgr=288.15K) this gives pmaxpv=22632Pa.</span>
<a name="l00333"></a>00333 <span class="comment">!                                ++++NOTE: pmaxpv should be within the</span>
<a name="l00334"></a>00334 <span class="comment">!                                second USSA layer, that is the interval</span>
<a name="l00335"></a>00335 <span class="comment">!                                from 54749Pa to 22632Pa (in case of</span>
<a name="l00336"></a>00336 <span class="comment">!                                standard parameter setting).++++</span>
<a name="l00337"></a>00337 
<a name="l00338"></a><a class="code" href="classpumamod.html#a13482db37c1abe130d4dc4af706bbfcd">00338</a>       <span class="keywordtype">real</span> :: flsp0 = 10000.   <span class="comment">! pressure of max. lower stratospheric forcing</span>
<a name="l00339"></a>00339 <span class="comment">!                                field [Pa]</span>
<a name="l00340"></a><a class="code" href="classpumamod.html#a51e58c7fbc975478f8dbe96463b3a433">00340</a>       <span class="keywordtype">real</span> :: flsdp =  9000.   <span class="comment">! half of vertical extension of lower</span>
<a name="l00341"></a>00341 <span class="comment">!                                stratospheric forcing field [Pa]</span>
<a name="l00342"></a><a class="code" href="classpumamod.html#a3989013e6e41db4fe84fe588114e3298">00342</a>       <span class="keywordtype">real</span> :: flsamp =  15.    <span class="comment">! amplitude of lower stratospheric forcing</span>
<a name="l00343"></a>00343 <span class="comment">!                                field [K]</span>
<a name="l00344"></a><a class="code" href="classpumamod.html#a2a580be12b22eb35c66b88168ad41a5a">00344</a>       <span class="keywordtype">real</span> :: flsoff =  -5.    <span class="comment">! offset of lower stratospheric forcing</span>
<a name="l00345"></a>00345 <span class="comment">!                                field [K]</span>
<a name="l00346"></a>00346 
<a name="l00347"></a>00347 
<a name="l00348"></a>00348 <span class="comment">!     *******************</span>
<a name="l00349"></a>00349 <span class="comment">!     * Namelist Arrays *</span>
<a name="l00350"></a>00350 <span class="comment">!     *******************</span>
<a name="l00351"></a>00351 <span class="comment">!     workaround for older fortran versions, where allocatable arrays</span>
<a name="l00352"></a>00352 <span class="comment">!     are not allowed in namelists</span>
<a name="l00353"></a>00353 
<a name="l00354"></a>00354 
<a name="l00355"></a><a class="code" href="classpumamod.html#a80d5840e4839b80e13a754bc1ad9e5cd">00355</a>       <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXLEV   = 100
<a name="l00356"></a><a class="code" href="classpumamod.html#ab32dffe308b27471e38da867575f6811">00356</a>       <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXSELZW =  42
<a name="l00357"></a><a class="code" href="classpumamod.html#a9d128654f0c25001f195e33b7a28029d">00357</a>       <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXSELSP = ((MAXSELZW+1) * (MAXSELZW+2)) / 2
<a name="l00358"></a><a class="code" href="classpumamod.html#af4ef7f7d21aa9c3043e4efaa1a0b0c3e">00358</a>       <span class="keywordtype">integer</span> :: nselect(0:MAXSELZW) = 1 <span class="comment">! NSELECT can be used up tp T42</span>
<a name="l00359"></a><a class="code" href="classpumamod.html#a2c894b8fdb5ec54ea52d347187671e2c">00359</a>       <span class="keywordtype">integer</span> :: nspecsel(MAXSELSP)  = 1
<a name="l00360"></a><a class="code" href="classpumamod.html#a15b0384953f7f10aa3e03dee7662e0f3">00360</a>       <span class="keywordtype">integer</span> :: ndl(MAXLEV)         = 0
<a name="l00361"></a><a class="code" href="classpumamod.html#a89c938c5067b7da4825d70342cc62fc5">00361</a>       <span class="keywordtype">real</span>    :: restim(MAXLEV)      = 15.0
<a name="l00362"></a><a class="code" href="classpumamod.html#a0fe6c7d70c84c4134653d23d7ba1f542">00362</a>       <span class="keywordtype">real</span>    :: sigmah(MAXLEV)      = 0.0
<a name="l00363"></a><a class="code" href="classpumamod.html#a15be485545b52c4c0fa534fe17e9408b">00363</a>       <span class="keywordtype">real</span>    :: t0k(MAXLEV)         = 250.0
<a name="l00364"></a><a class="code" href="classpumamod.html#aaa502cf0bf055e6a77058cb9a894c808">00364</a>       <span class="keywordtype">real</span>    :: t0(MAXLEV)          = 250.0
<a name="l00365"></a><a class="code" href="classpumamod.html#ac25246ebd045c4eba43e3cf8d1d7596e">00365</a>       <span class="keywordtype">real</span>    :: tfrc(MAXLEV)        = 0.0
<a name="l00366"></a><a class="code" href="classpumamod.html#ad1899f0a731ed4ab715422d9fd8d444b">00366</a>       <span class="keywordtype">real</span>    :: dt(MAXLEV)          = 0.0
<a name="l00367"></a>00367 
<a name="l00368"></a>00368 <span class="comment">!     **************************</span>
<a name="l00369"></a>00369 <span class="comment">!     * Global Spectral Arrays *</span>
<a name="l00370"></a>00370 <span class="comment">!     **************************</span>
<a name="l00371"></a>00371 
<a name="l00372"></a><a class="code" href="classpumamod.html#a25b4901a49e21188037f1e234de26a52">00372</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sor(:)    <span class="comment">! Spectral Orography</span>
<a name="l00373"></a><a class="code" href="classpumamod.html#a9e408d75104293064d995076d4dbbce4">00373</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: ssp(:)    <span class="comment">! Spectral surface pressure</span>
<a name="l00374"></a><a class="code" href="classpumamod.html#ab9cb9fb36cedabd96373ce2d69554d93">00374</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stg(:)    <span class="comment">! Spectral ground temperature</span>
<a name="l00375"></a><a class="code" href="classpumamod.html#a0a5b087ce0b768e344e2e0fd38dccd49">00375</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sep(:)    <span class="comment">! Spectral equator-pole gradient</span>
<a name="l00376"></a><a class="code" href="classpumamod.html#af7adda7c9fa3da6ac86737a9579b4588">00376</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sns(:)    <span class="comment">! Spectral north-south  gradient</span>
<a name="l00377"></a><a class="code" href="classpumamod.html#a8da7a3798ee3323bf38b6c7b815a3928">00377</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spnorm(:) <span class="comment">! ECHAM -&gt; PUMA normalization factors</span>
<a name="l00378"></a><a class="code" href="classpumamod.html#a3eb3e9be54dfc5066878573e5bac8386">00378</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sr1(:,:)  <span class="comment">! Constant part of Tr</span>
<a name="l00379"></a><a class="code" href="classpumamod.html#ae778b35555f5b6530d47f7cb75422a94">00379</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sr2(:,:)  <span class="comment">! Variable part of Tr</span>
<a name="l00380"></a>00380 
<a name="l00381"></a>00381 <span class="comment">!     ***************************</span>
<a name="l00382"></a>00382 <span class="comment">!     * Global Gridpoint Arrays *</span>
<a name="l00383"></a>00383 <span class="comment">!     ***************************</span>
<a name="l00384"></a>00384 
<a name="l00385"></a><a class="code" href="classpumamod.html#a40784d8720abb9ae62f1a66c0dbf666d">00385</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gor(:,:)     <span class="comment">! Orography</span>
<a name="l00386"></a><a class="code" href="classpumamod.html#aade6f1ed946b27ba82c9ec0249699994">00386</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gsp(:,:)     <span class="comment">! Surface pressure</span>
<a name="l00387"></a><a class="code" href="classpumamod.html#ad349c2130e94459e9c8e90c4b4208876">00387</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtg(:,:)     <span class="comment">! Ground temperature</span>
<a name="l00388"></a><a class="code" href="classpumamod.html#aa15249f48df29a85f239fb007058eacb">00388</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gan(:,:)     <span class="comment">! Ground temperature anomaly</span>
<a name="l00389"></a><a class="code" href="classpumamod.html#a8f2231a34a19b8792db080ae8e4d9454">00389</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gep(:,:)     <span class="comment">! Equator-pole gradient</span>
<a name="l00390"></a><a class="code" href="classpumamod.html#adaa3dc50fbf3e39e14e9e2e9320e8f6f">00390</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gns(:,:)     <span class="comment">! North-south  gradient</span>
<a name="l00391"></a><a class="code" href="classpumamod.html#acb21b0133fc9d543c9a472c65c1fc025">00391</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtc(:,:,:)   <span class="comment">! Restoration Temperature</span>
<a name="l00392"></a><a class="code" href="classpumamod.html#a24ec113507c8c09685e26fdf2ad94948">00392</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtv(:,:,:)   <span class="comment">! Restoration Temperature NS mode</span>
<a name="l00393"></a><a class="code" href="classpumamod.html#afde0b96dd53a26b1703595f64071516d">00393</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtdamp(:,:,:)<span class="comment">! Reciprocal of damping time scale for T </span>
<a name="l00394"></a><a class="code" href="classpumamod.html#a7b5ac8c859782a4cc38346f7b9a61dcd">00394</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gaf(:,:,:)   <span class="comment">! Anomaly factors</span>
<a name="l00395"></a><a class="code" href="classpumamod.html#a5cb12da2095a04506c22df1b670575f6">00395</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gra(:)       <span class="comment">! Gradient factors</span>
<a name="l00396"></a>00396 
<a name="l00397"></a>00397 <span class="comment">!     *******************</span>
<a name="l00398"></a>00398 <span class="comment">!     * Latitude Arrays *</span>
<a name="l00399"></a>00399 <span class="comment">!     *******************</span>
<a name="l00400"></a>00400 
<a name="l00401"></a><a class="code" href="classpumamod.html#a657def2270ed1f8c5137ba82b1d2cb69">00401</a>       <span class="keywordtype">character (3)</span>, <span class="keywordtype">allocatable</span> :: chlat(:) <span class="comment">! label for latitudes</span>
<a name="l00402"></a>00402 
<a name="l00403"></a><a class="code" href="classpumamod.html#afaa36786d595931f29f0eb93f01ed83d">00403</a>       <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">allocatable</span> :: sid(:)   <span class="comment">! sin(phi)</span>
<a name="l00404"></a><a class="code" href="classpumamod.html#af7724a88a5fba5e0ea4a278eca324b7b">00404</a>       <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">allocatable</span> :: gwd(:)   <span class="comment">! Gaussian weight</span>
<a name="l00405"></a><a class="code" href="classpumamod.html#a5be628a4dc3f151cd3a2500954bd707a">00405</a>       <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">allocatable</span> :: csq(:)   <span class="comment">! cos(phi)^2</span>
<a name="l00406"></a><a class="code" href="classpumamod.html#af689f39b83711b2d5c805279eb5391c1">00406</a>       <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">allocatable</span> :: dla(:)   <span class="comment">! phi</span>
<a name="l00407"></a>00407  
<a name="l00408"></a>00408 
<a name="l00409"></a>00409 <span class="comment">!     ****************</span>
<a name="l00410"></a>00410 <span class="comment">!     * Level Arrays *</span>
<a name="l00411"></a>00411 <span class="comment">!     ****************</span>
<a name="l00412"></a>00412 
<a name="l00413"></a><a class="code" href="classpumamod.html#a2ce41df1b8a64f3eb8788faa374977e7">00413</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: t0d(:)   <span class="comment">! vertical t0k gradient</span>
<a name="l00414"></a><a class="code" href="classpumamod.html#a11d50c855ac5c212c04a3640ddfa362d">00414</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: dsigma(:)
<a name="l00415"></a><a class="code" href="classpumamod.html#af7f7c6447115a5e0079679528c5e20af">00415</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: rdsig(:)
<a name="l00416"></a><a class="code" href="classpumamod.html#a645a8743bd64422c6d0b4dfc7182fa23">00416</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sigma(:)
<a name="l00417"></a><a class="code" href="classpumamod.html#af17f19dbdc2165bfaca19bed26fd393d">00417</a>       <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: tkp(:)
<a name="l00418"></a>00418 
<a name="l00419"></a>00419 <span class="comment">!     **********************</span>
<a name="l00420"></a>00420 <span class="comment">!     * Dummy declarations *</span>
<a name="l00421"></a>00421 <span class="comment">!     **********************</span>
<a name="l00422"></a>00422 
<a name="l00423"></a><a class="code" href="classpumamod.html#ac97014556deaf23263381f8f385e24bf">00423</a>       <span class="keywordtype">real</span> :: gp(2)
<a name="l00424"></a><a class="code" href="classpumamod.html#a7ca052eca893b2dd15b3e2c59417383b">00424</a>       <span class="keywordtype">real</span> :: sp(2)
<a name="l00425"></a><a class="code" href="classpumamod.html#a7e9cb053d22629a087d9fb20373d6845">00425</a>       <span class="keywordtype">real</span> :: gpj(2)
<a name="l00426"></a><a class="code" href="classpumamod.html#af0504dba05d1852caaa89cc26864d4c1">00426</a>       <span class="keywordtype">real</span> :: gu(2,2)
<a name="l00427"></a><a class="code" href="classpumamod.html#a2c2f72279b235e6fabc99913fed1f718">00427</a>       <span class="keywordtype">real</span> :: gv(2,2)
<a name="l00428"></a><a class="code" href="classpumamod.html#a9bd99450c5fc8037436814f7b574e29f">00428</a>       <span class="keywordtype">real</span> :: sd(2,2)
<a name="l00429"></a><a class="code" href="classpumamod.html#a74c9dc30cb632807156f147f54448742">00429</a>       <span class="keywordtype">real</span> :: st(2,2)
<a name="l00430"></a><a class="code" href="classpumamod.html#a94eae8b357e81b00aec6660f112b76b0">00430</a>       <span class="keywordtype">real</span> :: sq(2,2)
<a name="l00431"></a><a class="code" href="classpumamod.html#acdc2f913a6792772fcb9a2ebf1b0b043">00431</a>       <span class="keywordtype">real</span> :: sz(2,2)
<a name="l00432"></a><a class="code" href="classpumamod.html#a00b4d8ae29f6999627d3b93cdfcec1ea">00432</a>       <span class="keywordtype">real</span> :: gd(2,2)
<a name="l00433"></a><a class="code" href="classpumamod.html#abcc9eef5e9aa5ecf04a6d77fd888feb9">00433</a>       <span class="keywordtype">real</span> :: gq(2,2)
<a name="l00434"></a><a class="code" href="classpumamod.html#a19345ffa11bc96c6b5a16f205d54d59c">00434</a>       <span class="keywordtype">real</span> :: gt(2,2)
<a name="l00435"></a><a class="code" href="classpumamod.html#a0e0c4c718b441b61b728ccb5b97b8184">00435</a>       <span class="keywordtype">real</span> :: gz(2,2)
<a name="l00436"></a>00436 
<a name="l00437"></a>00437 <span class="keyword">      end module pumamod</span>
<a name="l00438"></a>00438 
<a name="l00439"></a><a class="code" href="ppp_8f90.html#a4d3d5ecbb97268b3c90454dee07327fe">00439</a>       <span class="keyword">program</span> <a class="code" href="ppp_8f90.html#a4d3d5ecbb97268b3c90454dee07327fe">ppp</a>
<a name="l00440"></a>00440 
<a name="l00441"></a>00441 <span class="comment">!     open file ppp-puma interface information</span>
<a name="l00442"></a>00442       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> 
<a name="l00443"></a>00443          <span class="keyword">open</span>(95,file=<span class="stringliteral">&quot;ppp-puma.txt&quot;</span>,form=<span class="stringliteral">&#39;formatted&#39;</span>)  
<a name="l00444"></a>00444       <span class="keyword">endif</span>
<a name="l00445"></a>00445 
<a name="l00446"></a>00446       call <a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">resolution</a>
<a name="l00447"></a>00447       call <a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">prolog</a>
<a name="l00448"></a>00448       call <a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a>
<a name="l00449"></a>00449 
<a name="l00450"></a>00450 <span class="comment">!     close file ppp-puma interface information</span>
<a name="l00451"></a>00451       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> 
<a name="l00452"></a>00452          <span class="keyword">close</span>(95)             
<a name="l00453"></a>00453       <span class="keyword">endif</span>
<a name="l00454"></a>00454 
<a name="l00455"></a>00455       stop
<a name="l00456"></a>00456 <span class="keyword">      end</span>
<a name="l00457"></a>00457 
<a name="l00458"></a>00458  <span class="comment">! ******************************</span>
<a name="l00459"></a>00459  <span class="comment">! * SUBROUTINE ALLOCATE_ARRAYS *</span>
<a name="l00460"></a>00460  <span class="comment">! ******************************</span>
<a name="l00461"></a>00461 
<a name="l00462"></a><a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">00462</a>  <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">allocate_arrays</a>
<a name="l00463"></a>00463  use <span class="keywordflow">pumamod</span>
<a name="l00464"></a>00464 
<a name="l00465"></a>00465  <span class="comment">!---  Global Spectral Arrays </span>
<a name="l00466"></a>00466  <span class="keyword">allocate</span>(sor(nesp))       ; sor(:)      = 0.0 <span class="comment">! Spectral Orography</span>
<a name="l00467"></a>00467  <span class="keyword">allocate</span>(ssp(nesp))       ; ssp(:)      = 0.0 <span class="comment">! Spectral surface pressure</span>
<a name="l00468"></a>00468  <span class="keyword">allocate</span>(stg(nesp))       ; stg(:)      = 0.0 <span class="comment">! Spectral ground temperature</span>
<a name="l00469"></a>00469  <span class="keyword">allocate</span>(sep(nesp))       ; sep(:)      = 0.0 <span class="comment">! Spectral equator-pole gradient</span>
<a name="l00470"></a>00470  <span class="keyword">allocate</span>(sns(nesp))       ; sns(:)      = 0.0 <span class="comment">! Spectral north-south  gradient</span>
<a name="l00471"></a>00471  <span class="keyword">allocate</span>(spnorm(nesp))    ; spnorm(:)   = 0.0 <span class="comment">! ECHAM -&gt; PUMA normalization</span>
<a name="l00472"></a>00472  <span class="keyword">allocate</span>(sr1(nesp,nlev))  ; sr1(:,:)    = 0.0 <span class="comment">! Constant part of Tr</span>
<a name="l00473"></a>00473  <span class="keyword">allocate</span>(sr2(nesp,nlev))  ; sr2(:,:)    = 0.0 <span class="comment">! Variable part of Tr</span>
<a name="l00474"></a>00474 
<a name="l00475"></a>00475  <span class="comment">!---  Global Gridpoint Arrays</span>
<a name="l00476"></a>00476  <span class="keyword">allocate</span>(gor(nlon,nlat))        ; gor(:,:)      =  0.0 <span class="comment">! Orography</span>
<a name="l00477"></a>00477  <span class="keyword">allocate</span>(gsp(nlon,nlat))        ; gsp(:,:)      =  0.0 <span class="comment">! Surface pressure</span>
<a name="l00478"></a>00478  <span class="keyword">allocate</span>(gtg(nlon,nlat))        ; gtg(:,:)      =  0.0 <span class="comment">! Ground temperature</span>
<a name="l00479"></a>00479  <span class="keyword">allocate</span>(gan(nlon,nlat))        ; gan(:,:)      =  0.0 <span class="comment">! Ground temperature anomaly</span>
<a name="l00480"></a>00480  <span class="keyword">allocate</span>(gep(nlon,nlat))        ; gep(:,:)      =  0.0 <span class="comment">! Equator-pole gradient</span>
<a name="l00481"></a>00481  <span class="keyword">allocate</span>(gns(nlon,nlat))        ; gns(:,:)      =  0.0 <span class="comment">! North-south  gradient</span>
<a name="l00482"></a>00482  <span class="keyword">allocate</span>(gtc(nlon,nlat,nlev))   ; gtc(:,:,:)    =  0.0 <span class="comment">! Restoration Temperature</span>
<a name="l00483"></a>00483  <span class="keyword">allocate</span>(gtv(nlon,nlat,nlev))   ; gtv(:,:,:)    =  0.0 <span class="comment">! Rest. Temperature NS mode</span>
<a name="l00484"></a>00484  <span class="keyword">allocate</span>(gtdamp(nlon,nlat,nlev)); gtdamp(:,:,:) =  0.0 <span class="comment">! Reciprocal of damping time scale for T</span>
<a name="l00485"></a>00485  <span class="keyword">allocate</span>(gaf(nlon,nlat,nlev))   ; gaf(:,:,:)    =  0.0 <span class="comment">! Anomaly factors</span>
<a name="l00486"></a>00486 
<a name="l00487"></a>00487  <span class="comment">!---  Latitude Arrays</span>
<a name="l00488"></a>00488  <span class="keyword">allocate</span>(chlat(nlat))  ; chlat(:) = <span class="stringliteral">&quot;   &quot;</span>  <span class="comment">! label for latitudes</span>
<a name="l00489"></a>00489  <span class="keyword">allocate</span>(sid(nlat))    ; sid(:)   = 0.0    <span class="comment">! sin(phi)</span>
<a name="l00490"></a>00490  <span class="keyword">allocate</span>(gwd(nlat))    ; gwd(:)   = 0.0    <span class="comment">! Gaussian weight</span>
<a name="l00491"></a>00491  <span class="keyword">allocate</span>(csq(nlat))    ; csq(:)   = 0.0    <span class="comment">! cos(phi)^2</span>
<a name="l00492"></a>00492  <span class="keyword">allocate</span>(dla(nlat))    ; dla(:)   = 0.0    <span class="comment">! phi</span>
<a name="l00493"></a>00493 
<a name="l00494"></a>00494  <span class="comment">!---  Level Arrays</span>
<a name="l00495"></a>00495  <span class="keyword">allocate</span>(gra(nlev))    ; gra(:)    = 0.0    <span class="comment">! Gradient factors</span>
<a name="l00496"></a>00496  <span class="keyword">allocate</span>(t0d(nlev))    ; t0d(:)    = 0.0    <span class="comment">! vertical t0k gradient</span>
<a name="l00497"></a>00497  <span class="keyword">allocate</span>(dsigma(nlev)) ; dsigma(:) = 0.0
<a name="l00498"></a>00498  <span class="keyword">allocate</span>(rdsig(nlev))  ; rdsig(:)  = 0.0
<a name="l00499"></a>00499  <span class="keyword">allocate</span>(sigma(nlev))  ; sigma(:)  = 0.0
<a name="l00500"></a>00500  <span class="keyword">allocate</span>(tkp(nlev))    ; tkp(:)    = 0.0
<a name="l00501"></a>00501 
<a name="l00502"></a>00502  return
<a name="l00503"></a>00503 <span class="keyword"> end subroutine allocate_arrays</span>
<a name="l00504"></a>00504 
<a name="l00505"></a>00505 <span class="comment">!     ===========================</span>
<a name="l00506"></a>00506 <span class="comment">!     SUBROUTINE MODIFY_OROGRAPHY</span>
<a name="l00507"></a>00507 <span class="comment">!     ===========================</span>
<a name="l00508"></a>00508 
<a name="l00509"></a><a class="code" href="ppp_8f90.html#a4b65f4d96e40adbdb96584789e31c413">00509</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a4b65f4d96e40adbdb96584789e31c413">modify_orography</a>(por)
<a name="l00510"></a>00510       use <span class="keywordflow">pumamod</span>
<a name="l00511"></a>00511       <span class="keywordtype">real</span> :: por(nlon,nlat)
<a name="l00512"></a>00512 
<a name="l00513"></a>00513 <span class="comment">!     Array &lt;por&gt; contains the orography on a Gaussian grid</span>
<a name="l00514"></a>00514 <span class="comment">!     the units are that of a geopotential [m2/s2] (gpm * g)</span>
<a name="l00515"></a>00515 <span class="comment">!     You may modify the orography here with your own code</span>
<a name="l00516"></a>00516 <span class="comment">!     The new orography is spectrally fitted after this routine</span>
<a name="l00517"></a>00517 <span class="comment">!     A gridpoint representation is written in service format</span>
<a name="l00518"></a>00518 <span class="comment">!     to file &lt;puma_oro_tnn.srv&gt; with nn = spectral truncation.</span>
<a name="l00519"></a>00519 
<a name="l00520"></a>00520       <span class="keyword">if</span> (noro == 2) call <a class="code" href="ppp_8f90.html#af163501e7aad4a154d2317e8adbf8414">mkoro</a>(por)
<a name="l00521"></a>00521       <span class="keyword">if</span> (noro == 3) call <a class="code" href="ppp_8f90.html#af9ce54d8de253b6c88bc6b01b3a247a5">mkorog</a>(por)
<a name="l00522"></a>00522 
<a name="l00523"></a>00523 <span class="comment">!     Rectangular anomaly</span>
<a name="l00524"></a>00524 
<a name="l00525"></a>00525 <span class="comment">!     if (oroano /= 0.0 .and. lat1oro &gt; 0 .and. lat2oro &lt;= nlat &amp;</span>
<a name="l00526"></a>00526 <span class="comment">!                       .and. lon1oro &gt; 0 .and. lon2oro &lt;= nlon &amp;</span>
<a name="l00527"></a>00527 <span class="comment">!                       .and. lat1oro &lt; lat2oro .and. lon1oro &lt; lon2oro) then</span>
<a name="l00528"></a>00528 <span class="comment">!        do jlat = lat1oro , lat2oro</span>
<a name="l00529"></a>00529 <span class="comment">!           do jlon = lon1oro , lon2oro</span>
<a name="l00530"></a>00530 <span class="comment">!              por(jlon,jlat) = por(jlon,jlat) + oroano * GA</span>
<a name="l00531"></a>00531 <span class="comment">!              if (por(jlon,jlat) &lt; 0.0) por(jlon,jlat) = 0.0</span>
<a name="l00532"></a>00532 <span class="comment">!           enddo</span>
<a name="l00533"></a>00533 <span class="comment">!        enddo</span>
<a name="l00534"></a>00534 <span class="comment">!     endif</span>
<a name="l00535"></a>00535 
<a name="l00536"></a>00536 <span class="comment">!     Elliptic anomaly</span>
<a name="l00537"></a>00537 
<a name="l00538"></a>00538       <span class="keyword">if</span> (oroano /= 0.0 .and. lat1oro &gt; 0 .and. lat2oro &lt;= nlat &amp;
<a name="l00539"></a>00539                         .and. lon1oro &gt; 0 .and. lon2oro &lt;= nlon &amp;
<a name="l00540"></a>00540                         .and. lat1oro &lt; lat2oro .and. lon1oro &lt; lon2oro) <span class="keyword">then</span>
<a name="l00541"></a>00541          x0 = (lon1oro + lon2oro) * 0.5
<a name="l00542"></a>00542          y0 = (lat1oro + lat2oro) * 0.5
<a name="l00543"></a>00543          xf = PI / (lon2oro - lon1oro)
<a name="l00544"></a>00544          yf = PI / (lat2oro - lat1oro)
<a name="l00545"></a>00545          <span class="keyword">do</span> jlat = lat1oro , lat2oro
<a name="l00546"></a>00546             yb = (jlat - y0) * yf
<a name="l00547"></a>00547             <span class="keyword">do</span> jlon = lon1oro , lon2oro
<a name="l00548"></a>00548                xa = (jlon - x0) * xf
<a name="l00549"></a>00549                cx = cos(xa)
<a name="l00550"></a>00550                cy = cos(yb)
<a name="l00551"></a>00551                <span class="keyword">if</span> (cx &gt; 0.0 .and. cy &gt; 0.0) <span class="keyword">then</span>
<a name="l00552"></a>00552                   por(jlon,jlat) = por(jlon,jlat) + oroano * GA * cx * cy
<a name="l00553"></a>00553                <span class="keyword">endif</span>
<a name="l00554"></a>00554                <span class="keyword">if</span> (por(jlon,jlat) &lt; 0.0) por(jlon,jlat) = 0.0
<a name="l00555"></a>00555             <span class="keyword">enddo</span>
<a name="l00556"></a>00556          <span class="keyword">enddo</span>
<a name="l00557"></a>00557       <span class="keyword">endif</span>
<a name="l00558"></a>00558 
<a name="l00559"></a>00559       return
<a name="l00560"></a>00560 <span class="keyword">      end</span>
<a name="l00561"></a>00561 
<a name="l00562"></a>00562 <span class="comment">!     ====================================</span>
<a name="l00563"></a>00563 <span class="comment">!     SUBROUTINE MODIFY_GROUND_TEMPERATURE</span>
<a name="l00564"></a>00564 <span class="comment">!     ====================================</span>
<a name="l00565"></a>00565 
<a name="l00566"></a><a class="code" href="ppp_8f90.html#a7c8f4c3a7e4437cad6804ae0ce847552">00566</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a7c8f4c3a7e4437cad6804ae0ce847552">modify_ground_temperature</a>(ptgr)
<a name="l00567"></a>00567       use <span class="keywordflow">pumamod</span>
<a name="l00568"></a>00568       <span class="keywordtype">real</span> :: ptgr(nlon,nlat)
<a name="l00569"></a>00569 
<a name="l00570"></a>00570 <span class="comment">!     Array &lt;ptgr&gt; contains the ground temperature on a Gaussian grid.</span>
<a name="l00571"></a>00571 <span class="comment">!     The units are [K]</span>
<a name="l00572"></a>00572 <span class="comment">!     You may modify the ground temperature here with your own code.</span>
<a name="l00573"></a>00573 <span class="comment">!     The new ground temperature is used to construct the temperature</span>
<a name="l00574"></a>00574 <span class="comment">!     profile of the restoration temperature on each grid point.</span>
<a name="l00575"></a>00575 <span class="comment">!     A gridpoint representation is written in service format</span>
<a name="l00576"></a>00576 <span class="comment">!     to file &lt;puma_gtgr_tnn.srv&gt; with nn = spectral truncation.</span>
<a name="l00577"></a>00577 
<a name="l00578"></a>00578       <span class="keyword">if</span> (tgrano /= 0.0 .and. lat1tgr &gt; 0 .and. lat2tgr &lt;= nlat &amp;
<a name="l00579"></a>00579                         .and. lon1tgr &gt; 0 .and. lon2tgr &lt;= nlon &amp;
<a name="l00580"></a>00580                         .and. lat1tgr &lt; lat2tgr .and. lon1tgr &lt; lon2tgr) <span class="keyword">then</span>
<a name="l00581"></a>00581          <span class="keyword">do</span> jlat = lat1tgr , lat2tgr
<a name="l00582"></a>00582             <span class="keyword">do</span> jlon = lon1tgr , lon2tgr
<a name="l00583"></a>00583                gan(jlon,jlat) = gan(jlon,jlat) + tgrano
<a name="l00584"></a>00584                ptgr(jlon,jlat) = ptgr(jlon,jlat) + tgrano
<a name="l00585"></a>00585                <span class="keyword">if</span> (ptgr(jlon,jlat) &lt; 0.0) ptgr(jlon,jlat) = 0.0
<a name="l00586"></a>00586             <span class="keyword">enddo</span>
<a name="l00587"></a>00587          <span class="keyword">enddo</span>
<a name="l00588"></a>00588       <span class="keyword">endif</span>
<a name="l00589"></a>00589 
<a name="l00590"></a>00590       return
<a name="l00591"></a>00591 <span class="keyword">      end</span>
<a name="l00592"></a>00592 
<a name="l00593"></a>00593 
<a name="l00594"></a>00594 <span class="comment">!     ================</span>
<a name="l00595"></a>00595 <span class="comment">!     SUBROUTINE MKORO</span>
<a name="l00596"></a>00596 <span class="comment">!     ================</span>
<a name="l00597"></a>00597 
<a name="l00598"></a><a class="code" href="ppp_8f90.html#af163501e7aad4a154d2317e8adbf8414">00598</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#af163501e7aad4a154d2317e8adbf8414">mkoro</a>(por)
<a name="l00599"></a>00599       use <span class="keywordflow">pumamod</span>
<a name="l00600"></a>00600 <span class="comment">!</span>
<a name="l00601"></a>00601       <span class="keywordtype">real</span> por(nlon,nlat)
<a name="l00602"></a>00602 <span class="comment">!</span>
<a name="l00603"></a>00603       zscale=horo*GA*0.5
<a name="l00604"></a>00604 <span class="comment">!</span>
<a name="l00605"></a>00605       por(:,:)=0.
<a name="l00606"></a>00606 <span class="comment">!</span>
<a name="l00607"></a>00607       <span class="keyword">do</span> jlat=1,nlat/2
<a name="l00608"></a>00608        zlat=dla(jlat)
<a name="l00609"></a>00609        zfacy=(sin(2.*zlat))**2
<a name="l00610"></a>00610        <span class="keyword">do</span> jlon=1,nlon
<a name="l00611"></a>00611         <span class="keyword">if</span>(norox &gt; 0) <span class="keyword">then</span>
<a name="l00612"></a>00612          zfacx=(1.+cos(norox*<span class="keywordtype">real</span>(jlon)*TWOPI/<span class="keywordtype">real</span>(nlon)))
<a name="l00613"></a>00613         <span class="keyword">else</span>
<a name="l00614"></a>00614          zfacx=1.
<a name="l00615"></a>00615         <span class="keyword">endif</span>
<a name="l00616"></a>00616         por(jlon,jlat)=zscale*zfacx*zfacy
<a name="l00617"></a>00617        <span class="keyword">enddo</span>
<a name="l00618"></a>00618       <span class="keyword">enddo</span>
<a name="l00619"></a>00619 <span class="comment">!</span>
<a name="l00620"></a>00620       <span class="keyword">if</span>(nsym == 1) <span class="keyword">then</span>
<a name="l00621"></a>00621        <span class="keyword">do</span> jlat=1,nlat/2
<a name="l00622"></a>00622         j2=nlat+1-jlat
<a name="l00623"></a>00623         por(:,j2)=por(:,jlat)
<a name="l00624"></a>00624        <span class="keyword">enddo</span>
<a name="l00625"></a>00625       <span class="keyword">endif</span>
<a name="l00626"></a>00626 <span class="comment">!</span>
<a name="l00627"></a>00627       return
<a name="l00628"></a>00628 <span class="keyword">      end</span>
<a name="l00629"></a>00629 
<a name="l00630"></a>00630 <span class="comment">!     =================</span>
<a name="l00631"></a>00631 <span class="comment">!     SUBROUTINE MKOROG</span>
<a name="l00632"></a>00632 <span class="comment">!     =================</span>
<a name="l00633"></a>00633 
<a name="l00634"></a><a class="code" href="ppp_8f90.html#af9ce54d8de253b6c88bc6b01b3a247a5">00634</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#af9ce54d8de253b6c88bc6b01b3a247a5">mkorog</a>(por)
<a name="l00635"></a>00635       use <span class="keywordflow">pumamod</span>
<a name="l00636"></a>00636 <span class="comment">!</span>
<a name="l00637"></a>00637       <span class="keywordtype">real</span> por(nlon,nlat)
<a name="l00638"></a>00638 <span class="comment">!</span>
<a name="l00639"></a>00639       zscale=horo*GA
<a name="l00640"></a>00640 <span class="comment">!</span>
<a name="l00641"></a>00641       zlon0=dorox*PI/180.
<a name="l00642"></a>00642       zlat0=doroy*PI/180.
<a name="l00643"></a>00643       zlons=(180./(doroxs*PI))**2
<a name="l00644"></a>00644       zlats=(180./(doroys*PI))**2
<a name="l00645"></a>00645 <span class="comment">!</span>
<a name="l00646"></a>00646       <span class="keyword">do</span> jlat=1,nlat
<a name="l00647"></a>00647        zlat=dla(jlat)
<a name="l00648"></a>00648 <span class="comment">!!     zcos2=cos(zlat)**2</span>
<a name="l00649"></a>00649        zcos2=1.
<a name="l00650"></a>00650        zdlat2=(zlat-zlat0)**2
<a name="l00651"></a>00651        <span class="keyword">do</span> jlon=1,nlon
<a name="l00652"></a>00652         zlon=TWOPI*<span class="keywordtype">real</span>(jlon-1)/<span class="keywordtype">real</span>(nlon)
<a name="l00653"></a>00653         zdlon=abs(zlon-zlon0)
<a name="l00654"></a>00654         <span class="keyword">if</span>(zdlon &gt; PI) zdlon=TWOPI-zdlon
<a name="l00655"></a>00655         zdlon2=zdlon**2
<a name="l00656"></a>00656         por(jlon,jlat)=zscale*EXP(-zlons*zcos2*zdlon2-zlats*zdlat2)
<a name="l00657"></a>00657        <span class="keyword">enddo</span>
<a name="l00658"></a>00658       <span class="keyword">enddo</span>
<a name="l00659"></a>00659 <span class="comment">!</span>
<a name="l00660"></a>00660       <span class="keyword">if</span>(nsym == 1 .and. zlat0 &gt; 0.) <span class="keyword">then</span>
<a name="l00661"></a>00661        <span class="keyword">do</span> jlat=1,nlat/2
<a name="l00662"></a>00662         j2=nlat+1-jlat
<a name="l00663"></a>00663         por(:,j2)=por(:,jlat)
<a name="l00664"></a>00664        <span class="keyword">enddo</span>
<a name="l00665"></a>00665       elseif(nsym == 1 .and. zlat0 &lt; 0.) <span class="keyword">then</span>
<a name="l00666"></a>00666        <span class="keyword">do</span> jlat=1,nlat/2
<a name="l00667"></a>00667         j2=nlat+1-jlat
<a name="l00668"></a>00668         por(:,jlat)=por(:,j2)
<a name="l00669"></a>00669        <span class="keyword">enddo</span>
<a name="l00670"></a>00670       <span class="keyword">endif</span>
<a name="l00671"></a>00671 <span class="comment">!</span>
<a name="l00672"></a>00672       return
<a name="l00673"></a>00673 <span class="keyword">      end</span>
<a name="l00674"></a>00674 
<a name="l00675"></a>00675 <span class="comment">!     =================</span>
<a name="l00676"></a>00676 <span class="comment">!     SUBROUTINE PROLOG</span>
<a name="l00677"></a>00677 <span class="comment">!     =================</span>
<a name="l00678"></a>00678 
<a name="l00679"></a><a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">00679</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">prolog</a>
<a name="l00680"></a>00680       use <span class="keywordflow">pumamod</span>
<a name="l00681"></a>00681 
<a name="l00682"></a>00682      
<a name="l00683"></a>00683 
<a name="l00684"></a>00684       call <a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">allocate_arrays</a>
<a name="l00685"></a>00685 
<a name="l00686"></a>00686       call <a class="code" href="ppp_8f90.html#a57e32ca0b91b99739b892a459ec40953">printparameter</a>
<a name="l00687"></a>00687       call <a class="code" href="gaussmod_8f90.html#a841a2f8e9025371eddc985235e1831ab">inigau</a>(nlat,sid,gwd)
<a name="l00688"></a>00688       call <a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">inilat</a>
<a name="l00689"></a>00689       call <a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">legpri</a>
<a name="l00690"></a>00690       call <a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">readnl</a>
<a name="l00691"></a>00691       call <a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">initpm</a>
<a name="l00692"></a>00692       call <a class="code" href="legsym_8f90.html#a86bc436e65d6c4ddde72bb3cce7dc8c8">legini</a>(nlat,nlpp,nesp,nlev,plavor,sid,gwd)
<a name="l00693"></a>00693       call <a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">initfd</a>
<a name="l00694"></a>00694 
<a name="l00695"></a>00695 
<a name="l00696"></a>00696       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l00697"></a>00697          call <a class="code" href="ppp_8f90.html#adbcdb3579718dc6067a1b2ec4d26e476">ppp_write_i</a>(<span class="stringliteral">&#39;NLAT&#39;</span>,1,nlat)
<a name="l00698"></a>00698          call <a class="code" href="ppp_8f90.html#adbcdb3579718dc6067a1b2ec4d26e476">ppp_write_i</a>(<span class="stringliteral">&#39;NLEV&#39;</span>,1,nlev)
<a name="l00699"></a>00699          call <a class="code" href="ppp_8f90.html#adbcdb3579718dc6067a1b2ec4d26e476">ppp_write_i</a>(<span class="stringliteral">&#39;NHELSUA&#39;</span>,1,nhelsua)
<a name="l00700"></a>00700          call <a class="code" href="ppp_8f90.html#a74276344215789d1e8fdce713dd9cd25">ppp_write_r</a>(<span class="stringliteral">&#39;SIGMH&#39;</span>,NLEV,sigmah)
<a name="l00701"></a>00701       <span class="keyword">endif</span>
<a name="l00702"></a>00702 
<a name="l00703"></a>00703       return
<a name="l00704"></a>00704 <span class="keyword">      end</span>
<a name="l00705"></a>00705 
<a name="l00706"></a>00706 <span class="comment">!     =================</span>
<a name="l00707"></a>00707 <span class="comment">!     SUBROUTINE INITFD</span>
<a name="l00708"></a>00708 <span class="comment">!     =================</span>
<a name="l00709"></a>00709 
<a name="l00710"></a><a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">00710</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">initfd</a>
<a name="l00711"></a>00711       use <span class="keywordflow">pumamod</span>
<a name="l00712"></a>00712 
<a name="l00713"></a>00713       dimension zrmean(nlev)
<a name="l00714"></a>00714 
<a name="l00715"></a>00715       zfmode0  = sqrt(2.0)
<a name="l00716"></a>00716       zfmode1  = 1.0 / sqrt(6.0)
<a name="l00717"></a>00717       zfmode2  = -2.0 / 3.0 * sqrt(0.4)
<a name="l00718"></a>00718 
<a name="l00719"></a>00719       stg(1)   = zfmode0 * tgr  <span class="comment">! Ground temperature  [K]</span>
<a name="l00720"></a>00720       sns(3)   = zfmode1 * dtns <span class="comment">! North-South gradient [K]</span>
<a name="l00721"></a>00721       sep(5)   = zfmode2 * dtep <span class="comment">! Equator-Pole gradient [K]</span>
<a name="l00722"></a>00722 
<a name="l00723"></a>00723 <span class="comment">!     Find sigma at dtrop</span>
<a name="l00724"></a>00724 
<a name="l00725"></a>00725       zttrop = tgr - dtrop * ALR
<a name="l00726"></a>00726       ztps   = (zttrop/tgr)**(GA/(ALR*GASCON))
<a name="l00727"></a>00727 
<a name="l00728"></a>00728 <span class="comment">!     The North-South and Equator-Pole gradients are defined on z=0.</span>
<a name="l00729"></a>00729 <span class="comment">!     gra() modifies the gradient from full at z=0 to zero at tropopause</span>
<a name="l00730"></a>00730 <span class="comment">!     PUMA aquaplanet compatibility mode (sine function used)</span>
<a name="l00731"></a>00731 
<a name="l00732"></a>00732       <span class="keyword">do</span> jlev = 1 , nlev
<a name="l00733"></a>00733          gra(jlev) = sin(0.5 * PI * (sigma(jlev) - ztps) / (1.0-ztps))
<a name="l00734"></a>00734          <span class="keyword">if</span> (gra(jlev) &lt; 0.0) gra(jlev) = 0.0
<a name="l00735"></a>00735       <span class="keyword">enddo</span>
<a name="l00736"></a>00736 
<a name="l00737"></a>00737       return
<a name="l00738"></a>00738 <span class="keyword">      end</span>
<a name="l00739"></a>00739 
<a name="l00740"></a>00740 <span class="comment">!     ==========================</span>
<a name="l00741"></a>00741 <span class="comment">!     SUBROUTINE ANOMALY_FACTORS</span>
<a name="l00742"></a>00742 <span class="comment">!     ==========================</span>
<a name="l00743"></a>00743 
<a name="l00744"></a><a class="code" href="ppp_8f90.html#a7f841b10d9e4f470513770f91f92c0bc">00744</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a7f841b10d9e4f470513770f91f92c0bc">anomaly_factors</a>
<a name="l00745"></a>00745       use <span class="keywordflow">pumamod</span>
<a name="l00746"></a>00746 
<a name="l00747"></a>00747       <span class="keyword">do</span> jlat = 1 , nlat
<a name="l00748"></a>00748       <span class="keyword">do</span> jlon = 1 , nlon
<a name="l00749"></a>00749 
<a name="l00750"></a>00750 <span class="comment">!     Find sigma at dtrop</span>
<a name="l00751"></a>00751 
<a name="l00752"></a>00752       zttrop = tgr - dtrop * ALR
<a name="l00753"></a>00753       ztps   = (zttrop/gtg(jlon,jlat))**(GA/(ALR*GASCON))
<a name="l00754"></a>00754 
<a name="l00755"></a>00755 <span class="comment">!     The North-South and Equator-Pole gradients are defined on z=0.</span>
<a name="l00756"></a>00756 <span class="comment">!     gaf() modifies the gradient from full at z=0 to zero at tropopause</span>
<a name="l00757"></a>00757 <span class="comment">!     PUMA aquaplanet compatibility mode (sine function used)</span>
<a name="l00758"></a>00758 
<a name="l00759"></a>00759       <span class="keyword">if</span>(nreverse == 0) <span class="keyword">then</span>
<a name="l00760"></a>00760        <span class="keyword">do</span> jlev = 1 , nlev
<a name="l00761"></a>00761         gaf(jlon,jlat,jlev) = sin(0.5 * PI * (sigma(jlev) - ztps) / (1.0-ztps))
<a name="l00762"></a>00762         <span class="keyword">if</span> (gaf(jlon,jlat,jlev) &lt; 0.0) gaf(jlon,jlat,jlev) = 0.0
<a name="l00763"></a>00763        <span class="keyword">enddo</span>
<a name="l00764"></a>00764       <span class="keyword">else</span>
<a name="l00765"></a>00765        <span class="keyword">do</span> jlev = 1 , nlev
<a name="l00766"></a>00766          gaf(jlon,jlat,jlev) = sin(0.5 * PI * (sigma(jlev) - ztps) / (1.0-ztps))
<a name="l00767"></a>00767          <span class="keyword">if</span> (sigma(jlev) &lt; ztps)                                        &amp;
<a name="l00768"></a>00768      &amp;   gaf(jlon,jlat,jlev) = sin(PI*(sigma(jlev)-ztps)/(ztps-sigma(1)))
<a name="l00769"></a>00769        <span class="keyword">enddo</span>
<a name="l00770"></a>00770       <span class="keyword">endif</span>
<a name="l00771"></a>00771 
<a name="l00772"></a>00772       <span class="keyword">enddo</span>
<a name="l00773"></a>00773       <span class="keyword">enddo</span>
<a name="l00774"></a>00774 
<a name="l00775"></a>00775       return
<a name="l00776"></a>00776 <span class="keyword">      end</span>
<a name="l00777"></a>00777 
<a name="l00778"></a>00778 
<a name="l00779"></a>00779 <span class="comment">!     ========================</span>
<a name="l00780"></a>00780 <span class="comment">!     SUBROUTINE READ_GAN_GRID</span>
<a name="l00781"></a>00781 <span class="comment">!     ========================</span>
<a name="l00782"></a>00782 
<a name="l00783"></a><a class="code" href="ppp_8f90.html#ab9365bc6b428500db06eb0a96278de88">00783</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#ab9365bc6b428500db06eb0a96278de88">read_gan_grid</a>(kread)
<a name="l00784"></a>00784       use <span class="keywordflow">pumamod</span>
<a name="l00785"></a>00785 
<a name="l00786"></a>00786       <span class="keywordtype">logical</span> :: lexist
<a name="l00787"></a>00787       <span class="keywordtype">integer</span> :: ihead(8)
<a name="l00788"></a>00788       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l00789"></a>00789       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l00790"></a>00790 
<a name="l00791"></a>00791 <span class="comment">!     Read temperature anomalies for PUMA</span>
<a name="l00792"></a>00792 <span class="comment">!     Use formatted Service style</span>
<a name="l00793"></a>00793 
<a name="l00794"></a>00794       kread = 0
<a name="l00795"></a>00795 
<a name="l00796"></a>00796       <span class="keyword">if</span> (nlat &lt; 1000) <span class="keyword">then</span>
<a name="l00797"></a>00797          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I3.3)&#39;</span>) nlat
<a name="l00798"></a>00798       <span class="keyword">else</span>
<a name="l00799"></a>00799          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I4.4)&#39;</span>) nlat
<a name="l00800"></a>00800       <span class="keyword">endif</span>
<a name="l00801"></a>00801 
<a name="l00802"></a>00802       yfilename = <span class="stringliteral">&quot;N&quot;</span> // trim(adjustl(ynumber)) // <span class="stringliteral">&quot;_surf_0139.sra&quot;</span>
<a name="l00803"></a>00803       <span class="keyword">inquire</span>(file=yfilename,exist=lexist)
<a name="l00804"></a>00804       <span class="keyword">if</span> (lexist) <span class="keyword">then</span>
<a name="l00805"></a>00805          <span class="keyword">write</span>(*,*) <span class="stringliteral">&#39; Reading anomaly temperature from file &lt;&#39;</span>,trim(yfilename),<span class="stringliteral">&#39;&gt;&#39;</span>
<a name="l00806"></a>00806          <span class="keyword">open</span> (65,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l00807"></a>00807          <span class="keyword">read</span> (65,*) ihead(:)
<a name="l00808"></a>00808          <span class="keyword">read</span> (65,*) gan(:,:)
<a name="l00809"></a>00809          <span class="keyword">close</span>(65)
<a name="l00810"></a>00810          kread = 1
<a name="l00811"></a>00811       <span class="keyword">else</span>
<a name="l00812"></a>00812          <span class="keyword">write</span>(*,*) <span class="stringliteral">&#39; No anomaly temperature file&#39;</span>
<a name="l00813"></a>00813       <span class="keyword">endif</span>
<a name="l00814"></a>00814       return
<a name="l00815"></a>00815 <span class="keyword">      end subroutine read_gan_grid</span>
<a name="l00816"></a>00816 
<a name="l00817"></a>00817 
<a name="l00818"></a>00818 <span class="comment">!     ========================</span>
<a name="l00819"></a>00819 <span class="comment">!     SUBROUTINE READ_ORO_GRID</span>
<a name="l00820"></a>00820 <span class="comment">!     ========================</span>
<a name="l00821"></a>00821 
<a name="l00822"></a><a class="code" href="ppp_8f90.html#a0160f7188865bdf68c170ebafa9e63ba">00822</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a0160f7188865bdf68c170ebafa9e63ba">read_oro_grid</a>(kread)
<a name="l00823"></a>00823       use <span class="keywordflow">pumamod</span>
<a name="l00824"></a>00824 
<a name="l00825"></a>00825       <span class="keywordtype">logical</span> :: lexist
<a name="l00826"></a>00826       <span class="keywordtype">integer</span> :: ihead(8)
<a name="l00827"></a>00827       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l00828"></a>00828       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l00829"></a>00829 
<a name="l00830"></a>00830 <span class="comment">!     Read orography for PUMA</span>
<a name="l00831"></a>00831 <span class="comment">!     Use formatted Service style</span>
<a name="l00832"></a>00832 
<a name="l00833"></a>00833       kread = 0
<a name="l00834"></a>00834 
<a name="l00835"></a>00835       <span class="keyword">if</span> (nlat &lt; 1000) <span class="keyword">then</span>
<a name="l00836"></a>00836          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I3.3)&#39;</span>) nlat
<a name="l00837"></a>00837       <span class="keyword">else</span>
<a name="l00838"></a>00838          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I4.4)&#39;</span>) nlat
<a name="l00839"></a>00839       <span class="keyword">endif</span>
<a name="l00840"></a>00840 
<a name="l00841"></a>00841       yfilename = <span class="stringliteral">&quot;N&quot;</span> // trim(adjustl(ynumber)) // <span class="stringliteral">&quot;_surf_0129.sra&quot;</span>
<a name="l00842"></a>00842       <span class="keyword">inquire</span>(file=yfilename,exist=lexist)
<a name="l00843"></a>00843       <span class="keyword">if</span> (lexist) <span class="keyword">then</span>
<a name="l00844"></a>00844          <span class="keyword">write</span>(*,*) <span class="stringliteral">&#39; Reading orography from file &lt;&#39;</span>,trim(yfilename),<span class="stringliteral">&#39;&gt;&#39;</span>
<a name="l00845"></a>00845          <span class="keyword">open</span> (65,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l00846"></a>00846          <span class="keyword">read</span> (65,*) ihead(:)
<a name="l00847"></a>00847          <span class="keyword">read</span> (65,*) gor(:,:)
<a name="l00848"></a>00848          <span class="keyword">close</span>(65)
<a name="l00849"></a>00849          kread = 1
<a name="l00850"></a>00850       <span class="keyword">else</span>
<a name="l00851"></a>00851          gor(:,:) = 0.0
<a name="l00852"></a>00852          <span class="keyword">write</span>(*,*) <span class="stringliteral">&#39; No orography file - starting with zero orography&#39;</span>
<a name="l00853"></a>00853       <span class="keyword">endif</span>
<a name="l00854"></a>00854       return
<a name="l00855"></a>00855 <span class="keyword">      end subroutine read_oro_grid</span>
<a name="l00856"></a>00856 
<a name="l00857"></a>00857 
<a name="l00858"></a>00858 <span class="comment">!     ====================</span>
<a name="l00859"></a>00859 <span class="comment">!     SUBROUTINE WRITE_ORO</span>
<a name="l00860"></a>00860 <span class="comment">!     ====================</span>
<a name="l00861"></a>00861 
<a name="l00862"></a><a class="code" href="ppp_8f90.html#a874acd25b1eb736cf7273817e3dcbdf8">00862</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a874acd25b1eb736cf7273817e3dcbdf8">write_oro</a>
<a name="l00863"></a>00863       use <span class="keywordflow">pumamod</span>
<a name="l00864"></a>00864 
<a name="l00865"></a>00865       dimension itime(8)
<a name="l00866"></a>00866       dimension ihead(8)
<a name="l00867"></a>00867 
<a name="l00868"></a>00868       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l00869"></a>00869       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l00870"></a>00870 
<a name="l00871"></a>00871       call date_and_time(values=itime)
<a name="l00872"></a>00872 
<a name="l00873"></a>00873 <span class="comment">!     Write orography for PUMA</span>
<a name="l00874"></a>00874 <span class="comment">!     Use formatted Service style</span>
<a name="l00875"></a>00875 
<a name="l00876"></a>00876       <span class="keyword">if</span> (nlat &lt; 1000) <span class="keyword">then</span>
<a name="l00877"></a>00877          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I3.3)&#39;</span>) nlat
<a name="l00878"></a>00878       <span class="keyword">else</span>
<a name="l00879"></a>00879          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I4.4)&#39;</span>) nlat
<a name="l00880"></a>00880       <span class="keyword">endif</span>
<a name="l00881"></a>00881 
<a name="l00882"></a>00882       yfilename = <span class="stringliteral">&quot;N&quot;</span> // trim(adjustl(ynumber)) // <span class="stringliteral">&quot;_surf_0129.sra&quot;</span>
<a name="l00883"></a>00883       <span class="keyword">open</span>(60,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l00884"></a>00884       ihead(1) = 129   <span class="comment">! code for orography</span>
<a name="l00885"></a>00885       ihead(2) =   0   <span class="comment">! level</span>
<a name="l00886"></a>00886       ihead(3) = itime(1) * 10000 + itime(2) * 100 + itime(3) <span class="comment">! YYYYMMDD</span>
<a name="l00887"></a>00887       ihead(4) = itime(5) * 100   + itime(6)                  <span class="comment">! HHMM</span>
<a name="l00888"></a>00888       ihead(5) = nlon  <span class="comment">! 1. dimension</span>
<a name="l00889"></a>00889       ihead(6) = nlat  <span class="comment">! 2. dimension</span>
<a name="l00890"></a>00890       ihead(7) =    1
<a name="l00891"></a>00891       ihead(8) =    0
<a name="l00892"></a>00892 
<a name="l00893"></a>00893       <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8I10)&#39;</span>) ihead(:)
<a name="l00894"></a>00894       <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8F10.3)&#39;</span>) gor(:,:)
<a name="l00895"></a>00895 
<a name="l00896"></a>00896       <span class="keyword">close</span>(60)
<a name="l00897"></a>00897 
<a name="l00898"></a>00898       return
<a name="l00899"></a>00899 <span class="keyword">      end subroutine write_oro</span>
<a name="l00900"></a>00900 
<a name="l00901"></a>00901 
<a name="l00902"></a>00902 <span class="comment">!     ===================</span>
<a name="l00903"></a>00903 <span class="comment">!     SUBROUTINE WRITE_PS</span>
<a name="l00904"></a>00904 <span class="comment">!     ===================</span>
<a name="l00905"></a>00905 
<a name="l00906"></a><a class="code" href="ppp_8f90.html#a9ffa8d77da63780dde165c7f4651592a">00906</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a9ffa8d77da63780dde165c7f4651592a">write_ps</a>
<a name="l00907"></a>00907       use <span class="keywordflow">pumamod</span>
<a name="l00908"></a>00908 
<a name="l00909"></a>00909       dimension itime(8)
<a name="l00910"></a>00910       dimension ihead(8)
<a name="l00911"></a>00911 
<a name="l00912"></a>00912       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l00913"></a>00913       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l00914"></a>00914 
<a name="l00915"></a>00915       <span class="keywordtype">real</span> :: zpres(nlon,nlat)
<a name="l00916"></a>00916 
<a name="l00917"></a>00917       call date_and_time(values=itime)
<a name="l00918"></a>00918 
<a name="l00919"></a>00919 <span class="comment">!     Write surface pressure for PUMA</span>
<a name="l00920"></a>00920 <span class="comment">!     Use formatted Service style</span>
<a name="l00921"></a>00921 
<a name="l00922"></a>00922       <span class="keyword">if</span> (nlat &lt; 1000) <span class="keyword">then</span>
<a name="l00923"></a>00923          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I3.3)&#39;</span>) nlat
<a name="l00924"></a>00924       <span class="keyword">else</span>
<a name="l00925"></a>00925          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I4.4)&#39;</span>) nlat
<a name="l00926"></a>00926       <span class="keyword">endif</span>
<a name="l00927"></a>00927       yfilename = <span class="stringliteral">&quot;N&quot;</span> // trim(adjustl(ynumber)) // <span class="stringliteral">&quot;_surf_0134.sra&quot;</span>
<a name="l00928"></a>00928       <span class="keyword">open</span>(60,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l00929"></a>00929       ihead(1) = 134   <span class="comment">! code for surface pressure [hPa]</span>
<a name="l00930"></a>00930       ihead(2) =   0   <span class="comment">! level</span>
<a name="l00931"></a>00931       ihead(3) = itime(1) * 10000 + itime(2) * 100 + itime(3) <span class="comment">! YYYYMMDD</span>
<a name="l00932"></a>00932       ihead(4) = itime(5) * 100   + itime(6)                  <span class="comment">! HHMM</span>
<a name="l00933"></a>00933       ihead(5) = nlon  <span class="comment">! 1. dimension</span>
<a name="l00934"></a>00934       ihead(6) = nlat  <span class="comment">! 2. dimension</span>
<a name="l00935"></a>00935       ihead(7) =    1
<a name="l00936"></a>00936       ihead(8) =    0
<a name="l00937"></a>00937 
<a name="l00938"></a>00938       zpres(:,:) = 0.01 * PSURF * exp(gsp(:,:)) <span class="comment">! Store as [hPa]</span>
<a name="l00939"></a>00939 
<a name="l00940"></a>00940       <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8I10)&#39;</span>) ihead(:)
<a name="l00941"></a>00941       <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8F10.4)&#39;</span>) zpres(:,:)
<a name="l00942"></a>00942 
<a name="l00943"></a>00943       <span class="keyword">close</span>(60)
<a name="l00944"></a>00944 
<a name="l00945"></a>00945       return
<a name="l00946"></a>00946 <span class="keyword">      end subroutine write_ps</span>
<a name="l00947"></a>00947 
<a name="l00948"></a>00948 
<a name="l00949"></a>00949 <span class="comment">!     ====================</span>
<a name="l00950"></a>00950 <span class="comment">!     SUBROUTINE WRITE_GTC</span>
<a name="l00951"></a>00951 <span class="comment">!     ====================</span>
<a name="l00952"></a>00952 
<a name="l00953"></a><a class="code" href="ppp_8f90.html#ae20643bdbfabfc228f286eec7a42e944">00953</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#ae20643bdbfabfc228f286eec7a42e944">write_gtc</a>
<a name="l00954"></a>00954       use <span class="keywordflow">pumamod</span>
<a name="l00955"></a>00955 
<a name="l00956"></a>00956       dimension itime(8)
<a name="l00957"></a>00957       dimension ihead(8)
<a name="l00958"></a>00958 
<a name="l00959"></a>00959       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l00960"></a>00960       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l00961"></a>00961 
<a name="l00962"></a>00962       call date_and_time(values=itime)
<a name="l00963"></a>00963 
<a name="l00964"></a>00964 <span class="comment">!     Write constant part of Tr</span>
<a name="l00965"></a>00965 <span class="comment">!     Use formatted Service style</span>
<a name="l00966"></a>00966 
<a name="l00967"></a>00967       <span class="keyword">if</span> (nlat &lt; 1000) <span class="keyword">then</span>
<a name="l00968"></a>00968          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I3.3)&#39;</span>) nlat
<a name="l00969"></a>00969       <span class="keyword">else</span>
<a name="l00970"></a>00970          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I4.4)&#39;</span>) nlat
<a name="l00971"></a>00971       <span class="keyword">endif</span>
<a name="l00972"></a>00972       yfilename = <span class="stringliteral">&quot;N&quot;</span> // trim(adjustl(ynumber)) // <span class="stringliteral">&quot;_surf_0121.sra&quot;</span>
<a name="l00973"></a>00973 
<a name="l00974"></a>00974       <span class="keyword">open</span>(60,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l00975"></a>00975       ihead(1) = 121   <span class="comment">! code for Tr const</span>
<a name="l00976"></a>00976       ihead(2) =   0   <span class="comment">! level</span>
<a name="l00977"></a>00977       ihead(3) = itime(1) * 10000 + itime(2) * 100 + itime(3) <span class="comment">! YYYYMMDD</span>
<a name="l00978"></a>00978       ihead(4) = itime(5) * 100   + itime(6)                  <span class="comment">! HHMM</span>
<a name="l00979"></a>00979       ihead(5) = nlon  <span class="comment">! 1. dimension</span>
<a name="l00980"></a>00980       ihead(6) = nlat  <span class="comment">! 2. dimension</span>
<a name="l00981"></a>00981       ihead(7) =    1
<a name="l00982"></a>00982       ihead(8) =    0
<a name="l00983"></a>00983 
<a name="l00984"></a>00984       <span class="keyword">do</span> jlev = 1 , nlev
<a name="l00985"></a>00985          ihead(2) = jlev
<a name="l00986"></a>00986          <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8I10)&#39;</span>) ihead(:)
<a name="l00987"></a>00987          <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8F10.4)&#39;</span>) gtc(:,:,jlev)
<a name="l00988"></a>00988       <span class="keyword">enddo</span>
<a name="l00989"></a>00989 
<a name="l00990"></a>00990       <span class="keyword">close</span>(60)
<a name="l00991"></a>00991 
<a name="l00992"></a>00992       return
<a name="l00993"></a>00993 <span class="keyword">      end subroutine write_gtc</span>
<a name="l00994"></a>00994 
<a name="l00995"></a>00995 
<a name="l00996"></a>00996 
<a name="l00997"></a>00997 <span class="comment">!     ====================</span>
<a name="l00998"></a>00998 <span class="comment">!     SUBROUTINE WRITE_GTV</span>
<a name="l00999"></a>00999 <span class="comment">!     ====================</span>
<a name="l01000"></a>01000 
<a name="l01001"></a><a class="code" href="ppp_8f90.html#a89cf301d11495b03846a06a6b3cb095f">01001</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a89cf301d11495b03846a06a6b3cb095f">write_gtv</a>
<a name="l01002"></a>01002       use <span class="keywordflow">pumamod</span>
<a name="l01003"></a>01003 
<a name="l01004"></a>01004       dimension itime(8)
<a name="l01005"></a>01005       dimension ihead(8)
<a name="l01006"></a>01006 
<a name="l01007"></a>01007       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l01008"></a>01008       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l01009"></a>01009 
<a name="l01010"></a>01010       call date_and_time(values=itime)
<a name="l01011"></a>01011 
<a name="l01012"></a>01012 <span class="comment">!     Write variable part of Tr</span>
<a name="l01013"></a>01013 <span class="comment">!     Use formatted Service style</span>
<a name="l01014"></a>01014 
<a name="l01015"></a>01015       <span class="keyword">if</span> (nlat &lt; 1000) <span class="keyword">then</span>
<a name="l01016"></a>01016          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I3.3)&#39;</span>) nlat
<a name="l01017"></a>01017       <span class="keyword">else</span>
<a name="l01018"></a>01018          <span class="keyword">write</span>(ynumber,<span class="stringliteral">&#39;(I4.4)&#39;</span>) nlat
<a name="l01019"></a>01019       <span class="keyword">endif</span>
<a name="l01020"></a>01020       yfilename = <span class="stringliteral">&quot;N&quot;</span> // trim(adjustl(ynumber)) // <span class="stringliteral">&quot;_surf_0122.sra&quot;</span>
<a name="l01021"></a>01021       <span class="keyword">open</span>(60,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l01022"></a>01022       ihead(1) = 122   <span class="comment">! code for Tr variable</span>
<a name="l01023"></a>01023       ihead(2) =   0   <span class="comment">! level</span>
<a name="l01024"></a>01024       ihead(3) = itime(1) * 10000 + itime(2) * 100 + itime(3) <span class="comment">! YYYYMMDD</span>
<a name="l01025"></a>01025       ihead(4) = itime(5) * 100   + itime(6)                  <span class="comment">! HHMM</span>
<a name="l01026"></a>01026       ihead(5) = nlon  <span class="comment">! 1. dimension</span>
<a name="l01027"></a>01027       ihead(6) = nlat  <span class="comment">! 2. dimension</span>
<a name="l01028"></a>01028       ihead(7) =    1
<a name="l01029"></a>01029       ihead(8) =    0
<a name="l01030"></a>01030 
<a name="l01031"></a>01031       <span class="keyword">do</span> jlev = 1 , nlev
<a name="l01032"></a>01032          ihead(2) = jlev
<a name="l01033"></a>01033          <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8I10)&#39;</span>) ihead(:)
<a name="l01034"></a>01034          <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8F10.4)&#39;</span>) gtv(:,:,jlev)
<a name="l01035"></a>01035       <span class="keyword">enddo</span>
<a name="l01036"></a>01036 
<a name="l01037"></a>01037       <span class="keyword">close</span>(60)
<a name="l01038"></a>01038 
<a name="l01039"></a>01039       return
<a name="l01040"></a>01040 <span class="keyword">      end subroutine write_gtv</span>
<a name="l01041"></a>01041 
<a name="l01042"></a>01042 
<a name="l01043"></a>01043 <span class="comment">!     ========================</span>
<a name="l01044"></a>01044 <span class="comment">!     SUBROUTINE WRITE_VARGP2D</span>
<a name="l01045"></a>01045 <span class="comment">!     ========================</span>
<a name="l01046"></a>01046 
<a name="l01047"></a><a class="code" href="ppp_8f90.html#a2d0d1495a01c220ffb26fc235bcbfc8d">01047</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a2d0d1495a01c220ffb26fc235bcbfc8d">write_vargp2D</a>(zgp,kcode)
<a name="l01048"></a>01048       use <span class="keywordflow">pumamod</span>
<a name="l01049"></a>01049 
<a name="l01050"></a>01050       dimension itime(8)
<a name="l01051"></a>01051       dimension ihead(8)
<a name="l01052"></a>01052 
<a name="l01053"></a>01053       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l01054"></a>01054       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l01055"></a>01055       <span class="keywordtype">real</span> :: zgp(nlon,nlat)
<a name="l01056"></a>01056 
<a name="l01057"></a>01057 
<a name="l01058"></a>01058       call date_and_time(values=itime)
<a name="l01059"></a>01059 
<a name="l01060"></a>01060 <span class="comment">!     produce file name to be written</span>
<a name="l01061"></a>01061       <span class="keyword">if</span> (NLAT &lt; 1000) <span class="keyword">then</span>
<a name="l01062"></a>01062          <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="l01063"></a>01063       <span class="keyword">else</span>
<a name="l01064"></a>01064          <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="l01065"></a>01065       <span class="keyword">endif</span>
<a name="l01066"></a>01066 
<a name="l01067"></a>01067 
<a name="l01068"></a>01068 
<a name="l01069"></a>01069       <span class="keyword">open</span>(60,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l01070"></a>01070       ihead(1) = kcode  <span class="comment">! code for reciprocal of damping time scale </span>
<a name="l01071"></a>01071       ihead(2) =   0    <span class="comment">! level</span>
<a name="l01072"></a>01072       ihead(3) = itime(1) * 10000 + itime(2) * 100 + itime(3) <span class="comment">! YYYYMMDD</span>
<a name="l01073"></a>01073       ihead(4) = itime(5) * 100   + itime(6)                  <span class="comment">! HHMM</span>
<a name="l01074"></a>01074       ihead(5) = nlon  <span class="comment">! 1. dimension</span>
<a name="l01075"></a>01075       ihead(6) = nlat  <span class="comment">! 2. dimension</span>
<a name="l01076"></a>01076       ihead(7) =    1
<a name="l01077"></a>01077       ihead(8) =    0
<a name="l01078"></a>01078 
<a name="l01079"></a>01079       <span class="keyword">select</span> <span class="keyword">case</span>(kcode)
<a name="l01080"></a>01080       <span class="keyword">case</span>(129,134)
<a name="l01081"></a>01081          ihead(2) = 0 
<a name="l01082"></a>01082          <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8I10)&#39;</span>) ihead(:)
<a name="l01083"></a>01083          <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8(X,E16.10))&#39;</span>) zgp(:,:)
<a name="l01084"></a>01084       <span class="keyword">end select</span>
<a name="l01085"></a>01085 
<a name="l01086"></a>01086       <span class="keyword">close</span>(60)
<a name="l01087"></a>01087 
<a name="l01088"></a>01088       return
<a name="l01089"></a>01089 <span class="keyword">      end subroutine write_vargp2D</span>
<a name="l01090"></a>01090 
<a name="l01091"></a>01091 <span class="comment">!     ========================</span>
<a name="l01092"></a>01092 <span class="comment">!     SUBROUTINE WRITE_VARGP3D</span>
<a name="l01093"></a>01093 <span class="comment">!     ========================</span>
<a name="l01094"></a>01094 
<a name="l01095"></a><a class="code" href="ppp_8f90.html#a5a952435a8bde10e925935c211aa9c4f">01095</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a5a952435a8bde10e925935c211aa9c4f">write_vargp3D</a>(zgp,kcode,klev)
<a name="l01096"></a>01096       use <span class="keywordflow">pumamod</span>
<a name="l01097"></a>01097 
<a name="l01098"></a>01098       dimension itime(8)
<a name="l01099"></a>01099       dimension ihead(8)
<a name="l01100"></a>01100 
<a name="l01101"></a>01101       <span class="keywordtype">character(20)</span>  :: ynumber
<a name="l01102"></a>01102       <span class="keywordtype">character(256)</span> :: yfilename
<a name="l01103"></a>01103       <span class="keywordtype">real</span> :: zgp(nlon,nlat,klev)
<a name="l01104"></a>01104 
<a name="l01105"></a>01105 
<a name="l01106"></a>01106       call date_and_time(values=itime)
<a name="l01107"></a>01107 
<a name="l01108"></a>01108 <span class="comment">!     produce file name to be written</span>
<a name="l01109"></a>01109       <span class="keyword">if</span> (NLAT &lt; 1000) <span class="keyword">then</span>
<a name="l01110"></a>01110          <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="l01111"></a>01111       <span class="keyword">else</span>
<a name="l01112"></a>01112          <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="l01113"></a>01113       <span class="keyword">endif</span>
<a name="l01114"></a>01114 
<a name="l01115"></a>01115 
<a name="l01116"></a>01116 
<a name="l01117"></a>01117       <span class="keyword">open</span>(60,file=yfilename,form=<span class="stringliteral">&#39;formatted&#39;</span>)
<a name="l01118"></a>01118       ihead(1) = kcode  <span class="comment">! code for reciprocal of damping time scale </span>
<a name="l01119"></a>01119       ihead(2) =   0    <span class="comment">! level</span>
<a name="l01120"></a>01120       ihead(3) = itime(1) * 10000 + itime(2) * 100 + itime(3) <span class="comment">! YYYYMMDD</span>
<a name="l01121"></a>01121       ihead(4) = itime(5) * 100   + itime(6)                  <span class="comment">! HHMM</span>
<a name="l01122"></a>01122       ihead(5) = nlon  <span class="comment">! 1. dimension</span>
<a name="l01123"></a>01123       ihead(6) = nlat  <span class="comment">! 2. dimension</span>
<a name="l01124"></a>01124       ihead(7) =    1
<a name="l01125"></a>01125       ihead(8) =    0
<a name="l01126"></a>01126 
<a name="l01127"></a>01127       <span class="keyword">select</span> <span class="keyword">case</span>(kcode)
<a name="l01128"></a>01128       <span class="keyword">case</span>(121,122,123,124,125,126)
<a name="l01129"></a>01129          <span class="keyword">do</span> jlev = 1 , klev
<a name="l01130"></a>01130             ihead(2) = jlev
<a name="l01131"></a>01131             <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8I10)&#39;</span>) ihead(:)
<a name="l01132"></a>01132             <span class="keyword">write</span> (60,<span class="stringliteral">&#39;(8(X,E16.10))&#39;</span>) zgp(:,:,jlev)
<a name="l01133"></a>01133          <span class="keyword">enddo</span>
<a name="l01134"></a>01134       <span class="keyword">end select</span>
<a name="l01135"></a>01135 
<a name="l01136"></a>01136       <span class="keyword">close</span>(60)
<a name="l01137"></a>01137 
<a name="l01138"></a>01138       return
<a name="l01139"></a>01139 <span class="keyword">      end subroutine write_vargp3D</span>
<a name="l01140"></a>01140 
<a name="l01141"></a>01141 
<a name="l01142"></a>01142 <span class="comment">!     ====================</span>
<a name="l01143"></a>01143 <span class="comment">!     SUBROUTINE GRIDPOINT</span>
<a name="l01144"></a>01144 <span class="comment">!     ====================</span>
<a name="l01145"></a>01145 
<a name="l01146"></a><a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">01146</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a>
<a name="l01147"></a>01147       use <span class="keywordflow">pumamod</span>
<a name="l01148"></a>01148 <span class="comment">!!</span>
<a name="l01149"></a>01149       dimension ihead(8)
<a name="l01150"></a>01150       dimension zprof(nlev)
<a name="l01151"></a>01151       dimension zzprof(nlon,nlat,nlev)
<a name="l01152"></a>01152       <span class="keywordtype">character(256)</span> :: yfilename,yfohead,yfodata,ymessage
<a name="l01153"></a>01153       <span class="keywordtype">logical</span> :: exist
<a name="l01154"></a>01154 
<a name="l01155"></a>01155 <span class="comment">!     Read orography</span>
<a name="l01156"></a>01156 
<a name="l01157"></a>01157       gor(:,:) = 0.0
<a name="l01158"></a>01158       <span class="keyword">if</span> (noro &gt; 0) <span class="keyword">then</span>
<a name="l01159"></a>01159          call <a class="code" href="ppp_8f90.html#a0160f7188865bdf68c170ebafa9e63ba">read_oro_grid</a>(iread)
<a name="l01160"></a>01160       <span class="keyword">endif</span>
<a name="l01161"></a>01161 
<a name="l01162"></a>01162 <span class="comment">!     Read ground anomaly temperature</span>
<a name="l01163"></a>01163 
<a name="l01164"></a>01164       call <a class="code" href="ppp_8f90.html#ab9365bc6b428500db06eb0a96278de88">read_gan_grid</a>(iread)
<a name="l01165"></a>01165 
<a name="l01166"></a>01166       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sns,gns)
<a name="l01167"></a>01167       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sep,gep)
<a name="l01168"></a>01168       call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(stg,gtg)
<a name="l01169"></a>01169 
<a name="l01170"></a>01170       call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(gns,1)
<a name="l01171"></a>01171       call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(gep,1)
<a name="l01172"></a>01172       call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(gtg,1)
<a name="l01173"></a>01173 
<a name="l01174"></a>01174 
<a name="l01175"></a>01175       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gns,nlon,nlat)
<a name="l01176"></a>01176       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gep,nlon,nlat)
<a name="l01177"></a>01177       call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gtg,nlon,nlat)
<a name="l01178"></a>01178 
<a name="l01179"></a>01179       gtg(:,:) = gtg(:,:) + gan(:,:)
<a name="l01180"></a>01180 
<a name="l01181"></a>01181       call <a class="code" href="ppp_8f90.html#a4b65f4d96e40adbdb96584789e31c413">modify_orography</a>(gor) <span class="comment">! User interface</span>
<a name="l01182"></a>01182 
<a name="l01183"></a>01183       <span class="keyword">if</span> (nyoden /= 0) <span class="keyword">then</span>
<a name="l01184"></a>01184          call <a class="code" href="ppp_8f90.html#a76e236098c9f27c53d3a8827d11554cf">yoden</a>
<a name="l01185"></a>01185       <span class="keyword">else</span>
<a name="l01186"></a>01186 <span class="comment">!        compute ground temperature on orography surface</span>
<a name="l01187"></a>01187 
<a name="l01188"></a>01188          gtg(:,:) = gtg(:,:) - ALR * gor(:,:) / GA <span class="comment">! [gpm]</span>
<a name="l01189"></a>01189 
<a name="l01190"></a>01190          call <a class="code" href="ppp_8f90.html#a7c8f4c3a7e4437cad6804ae0ce847552">modify_ground_temperature</a>(gtg) <span class="comment">! User interface</span>
<a name="l01191"></a>01191 
<a name="l01192"></a>01192          call <a class="code" href="ppp_8f90.html#a7f841b10d9e4f470513770f91f92c0bc">anomaly_factors</a>       <span class="comment">! Compute factors for NS &amp; EP</span>
<a name="l01193"></a>01193 
<a name="l01194"></a>01194 <span class="comment">!        Compute vertical profile for each column</span>
<a name="l01195"></a>01195 
<a name="l01196"></a>01196          <span class="keyword">do</span> jlat = 1 , nlat
<a name="l01197"></a>01197          <span class="keyword">do</span> jlon = 1 , nlon
<a name="l01198"></a>01198             call <a class="code" href="ppp_8f90.html#a109d8c58aa308107712782398903ea71">tprofile</a>(gtg(jlon,jlat),zprof,gor(jlon,jlat)/GA)
<a name="l01199"></a>01199             gtc(jlon,jlat,:) = zprof(:)
<a name="l01200"></a>01200          <span class="keyword">enddo</span>
<a name="l01201"></a>01201          <span class="keyword">enddo</span>
<a name="l01202"></a>01202 
<a name="l01203"></a>01203 <span class="comment">!        Modify Restoration Temperature with EP mode</span>
<a name="l01204"></a>01204 
<a name="l01205"></a>01205          <span class="keyword">do</span> jlev = 1 , nlev
<a name="l01206"></a>01206             gtc(:,:,jlev) = gtc(:,:,jlev) + gaf(:,:,jlev) * gep(:,:)
<a name="l01207"></a>01207          <span class="keyword">enddo</span>
<a name="l01208"></a>01208 
<a name="l01209"></a>01209 <span class="comment">!        Compute vertical profile for each column including variable NS mode</span>
<a name="l01210"></a>01210 
<a name="l01211"></a>01211          <span class="keyword">do</span> jlev = 1 , nlev
<a name="l01212"></a>01212             gtv(:,:,jlev) = gaf(:,:,jlev) * gns(:,:)
<a name="l01213"></a>01213          <span class="keyword">enddo</span>
<a name="l01214"></a>01214 
<a name="l01215"></a>01215       <span class="keyword">endif</span> <span class="comment">! (nyoden == 1)</span>
<a name="l01216"></a>01216 
<a name="l01217"></a>01217 <span class="comment">!     Initialize surface pressure (LnPs)</span>
<a name="l01218"></a>01218 
<a name="l01219"></a>01219       <span class="keyword">do</span> jlat = 1 , nlat
<a name="l01220"></a>01220       <span class="keyword">do</span> jlon = 1 , nlon
<a name="l01221"></a>01221          gsp(jlon,jlat) = -gor(jlon,jlat) / (GASCON*tgr)
<a name="l01222"></a>01222       <span class="keyword">enddo</span>
<a name="l01223"></a>01223       <span class="keyword">enddo</span>
<a name="l01224"></a>01224 
<a name="l01225"></a>01225 <span class="comment">!     if (nhelsua == 1 .or. nhelsua == 2) then</span>
<a name="l01226"></a>01226       <span class="keyword">if</span> (nhelsua &gt; 0) <span class="keyword">then</span>
<a name="l01227"></a>01227          call <a class="code" href="ppp_8f90.html#a6e5d7b2cf5629dbed1ee32fc656595dc">heldsuarez</a>
<a name="l01228"></a>01228          gor(:,:)   = 0.0
<a name="l01229"></a>01229          gsp(:,:)   = 0.0
<a name="l01230"></a>01230       <span class="keyword">endif</span>
<a name="l01231"></a>01231 
<a name="l01232"></a>01232 
<a name="l01233"></a>01233       <span class="keyword">if</span> (nstrato == 1) <span class="keyword">then</span>
<a name="l01234"></a>01234          call <a class="code" href="ppp_8f90.html#aa036704b2d766c3d7b7b48756b972d05">setzt2</a> <span class="comment">! Torben&#39;s forcing initialisation</span>
<a name="l01235"></a>01235       <span class="keyword">endif</span>
<a name="l01236"></a>01236 
<a name="l01237"></a>01237       call <a class="code" href="ppp_8f90.html#a874acd25b1eb736cf7273817e3dcbdf8">write_oro</a>
<a name="l01238"></a>01238       call <a class="code" href="ppp_8f90.html#a9ffa8d77da63780dde165c7f4651592a">write_ps</a>
<a name="l01239"></a>01239       call <a class="code" href="ppp_8f90.html#ae20643bdbfabfc228f286eec7a42e944">write_gtc</a>
<a name="l01240"></a>01240       call <a class="code" href="ppp_8f90.html#a89cf301d11495b03846a06a6b3cb095f">write_gtv</a>
<a name="l01241"></a>01241       call <a class="code" href="ppp_8f90.html#a5a952435a8bde10e925935c211aa9c4f">write_vargp3D</a>(gtdamp,123,nlev)
<a name="l01242"></a>01242       <span class="keyword">if</span> (ntestgp == 1) <span class="keyword">then</span>
<a name="l01243"></a>01243          call <a class="code" href="ppp_8f90.html#a5a952435a8bde10e925935c211aa9c4f">write_vargp3D</a>(gtc,124,nlev)
<a name="l01244"></a>01244          call <a class="code" href="ppp_8f90.html#a5a952435a8bde10e925935c211aa9c4f">write_vargp3D</a>(gtv,125,nlev)
<a name="l01245"></a>01245          call <a class="code" href="ppp_8f90.html#a5a952435a8bde10e925935c211aa9c4f">write_vargp3D</a>(gtdamp,126,nlev)
<a name="l01246"></a>01246       <span class="keyword">endif</span>
<a name="l01247"></a>01247 
<a name="l01248"></a>01248       call <a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">printprofile</a>
<a name="l01249"></a>01249 
<a name="l01250"></a>01250       return
<a name="l01251"></a>01251 <span class="keyword">      end</span>
<a name="l01252"></a>01252 
<a name="l01253"></a>01253 <span class="comment">!     =====================</span>
<a name="l01254"></a>01254 <span class="comment">!     SUBROUTINE HELDSUAREZ</span>
<a name="l01255"></a>01255 <span class="comment">!     =====================</span>
<a name="l01256"></a>01256 
<a name="l01257"></a><a class="code" href="ppp_8f90.html#a6e5d7b2cf5629dbed1ee32fc656595dc">01257</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a6e5d7b2cf5629dbed1ee32fc656595dc">heldsuarez</a>
<a name="l01258"></a>01258       use <span class="keywordflow">pumamod</span>
<a name="l01259"></a>01259 
<a name="l01260"></a>01260 <span class="comment">!     Set up the restoration temperature field according to that given</span>
<a name="l01261"></a>01261 <span class="comment">!     in Held &amp; Suarez (1994, Bul. Amer. Meteor. Soc.).</span>
<a name="l01262"></a>01262 <span class="comment">!     Only difference: There is an offset of 1./3. added to the sine of</span>
<a name="l01263"></a>01263 <span class="comment">!     latitude. The reason is that the namelist parameter TGR still</span>
<a name="l01264"></a>01264 <span class="comment">!     represents the global mean of surface restoration temperature.</span>
<a name="l01265"></a>01265 <span class="comment">!</span>
<a name="l01266"></a>01266 <span class="comment">!     ==&gt; Set TGR=295. in order to get exactly the same restoration</span>
<a name="l01267"></a>01267 <span class="comment">!         temperature field as in Held &amp; Suarez (1994).</span>
<a name="l01268"></a>01268 <span class="comment">!</span>
<a name="l01269"></a>01269 <span class="comment">!     ==&gt; DTNS in H&amp;S (1994) is the equator-pole difference while</span>
<a name="l01270"></a>01270 <span class="comment">!         PUMA uses DTNS for pole-pole difference. Therefore we use</span>
<a name="l01271"></a>01271 <span class="comment">!         0.5 * dtns in this subroutine.</span>
<a name="l01272"></a>01272 
<a name="l01273"></a>01273 
<a name="l01274"></a>01274 <span class="comment">!     Produce restoration temperature</span>
<a name="l01275"></a>01275 
<a name="l01276"></a>01276       <span class="keywordtype">real</span> :: zp0,z3
<a name="l01277"></a>01277       <span class="keywordtype">real</span> :: zdtc,zdtv,zsip
<a name="l01278"></a>01278 
<a name="l01279"></a>01279       zp0 = 100000.
<a name="l01280"></a>01280       z3  = 1.0 / 3.0
<a name="l01281"></a>01281       <span class="keyword">if</span> (nhelsua == 1 .or. nhelsua == 2) <span class="keyword">then</span>
<a name="l01282"></a>01282          <span class="keyword">do</span> jlev=1,nlev
<a name="l01283"></a>01283             <span class="keyword">do</span> jlat=1,nlat
<a name="l01284"></a>01284                zsip = sigma(jlev)*PSURF/zp0
<a name="l01285"></a>01285                zdtc = dtep * (sid(jlat)**2-z3) + dtzz * log(zsip) * csq(jlat)
<a name="l01286"></a>01286                zdtv = zdtc - 0.5 * dtns * sid(jlat)
<a name="l01287"></a>01287                gtc(:,jlat,jlev) = max(ttp, (tgr - zdtc) * zsip**AKAP)
<a name="l01288"></a>01288                gtv(:,jlat,jlev) = max(ttp, (tgr - zdtv) * zsip**AKAP)
<a name="l01289"></a>01289             <span class="keyword">enddo</span>
<a name="l01290"></a>01290          <span class="keyword">enddo</span>
<a name="l01291"></a>01291          gtv(:,:,:) = gtv(:,:,:) - gtc(:,:,:)
<a name="l01292"></a>01292       <span class="keyword">endif</span>
<a name="l01293"></a>01293 
<a name="l01294"></a>01294 <span class="comment">!     Produce reciprocal of damping time scale for T [1/sec]</span>
<a name="l01295"></a>01295 
<a name="l01296"></a>01296 <span class="comment">!     tauta = 1.0 / (TWOPI * tauta)</span>
<a name="l01297"></a>01297 <span class="comment">!     tauts = 1.0 / (TWOPI * tauts)</span>
<a name="l01298"></a>01298 
<a name="l01299"></a>01299       rtauta_dim = 1.0 /(tauta*sid_day)
<a name="l01300"></a>01300       rtauts_dim = 1.0 /(tauts*sid_day)
<a name="l01301"></a>01301       <span class="keyword">if</span> (nhelsua == 2 .or. nhelsua == 3) <span class="keyword">then</span>
<a name="l01302"></a>01302          <span class="keyword">do</span> jlev=1,nlev
<a name="l01303"></a>01303             <span class="keyword">if</span> (sigma(jlev) &gt; zsigb) <span class="keyword">then</span>
<a name="l01304"></a>01304                <span class="keyword">do</span> jlat = 1,nlat
<a name="l01305"></a>01305                   gtdamp(1:nlon,jlat,jlev) = rtauta_dim                 &amp;
<a name="l01306"></a>01306      &amp;       + (rtauts_dim - rtauta_dim) * ((sigma(jlev) - zsigb) / (1. - zsigb)) &amp;
<a name="l01307"></a>01307      &amp;                                          * (1. - sid(jlat)**2)**2
<a name="l01308"></a>01308                <span class="keyword">enddo</span>
<a name="l01309"></a>01309             <span class="keyword">else</span>
<a name="l01310"></a>01310                gtdamp(:,:,jlev) = rtauta_dim
<a name="l01311"></a>01311             <span class="keyword">endif</span>
<a name="l01312"></a>01312          <span class="keyword">enddo</span>
<a name="l01313"></a>01313       <span class="keyword">endif</span>
<a name="l01314"></a>01314 
<a name="l01315"></a>01315       return
<a name="l01316"></a>01316 <span class="keyword">      end</span>
<a name="l01317"></a>01317 
<a name="l01318"></a>01318 <span class="comment">!     =====================</span>
<a name="l01319"></a>01319 <span class="comment">!     SUBROUTINE RESOLUTION</span>
<a name="l01320"></a>01320 <span class="comment">!     =====================</span>
<a name="l01321"></a>01321 
<a name="l01322"></a><a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">01322</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">resolution</a>
<a name="l01323"></a>01323       use <span class="keywordflow">pumamod</span>
<a name="l01324"></a>01324       <span class="keywordtype">logical</span> :: lex
<a name="l01325"></a>01325       namelist /res/ nlat, nlev
<a name="l01326"></a>01326 
<a name="l01327"></a>01327       nlat = 32
<a name="l01328"></a>01328       nlev = 10
<a name="l01329"></a>01329 
<a name="l01330"></a>01330       <span class="keyword">inquire</span>(file=resolution_namelist,exist=lex)
<a name="l01331"></a>01331       <span class="keyword">if</span> (.not. lex) <span class="keyword">then</span>
<a name="l01332"></a>01332          resolution_namelist = trim(resolution_namelist) // <span class="stringliteral">&quot;_00&quot;</span>
<a name="l01333"></a>01333          <span class="keyword">inquire</span>(file=resolution_namelist,exist=lex)
<a name="l01334"></a>01334       <span class="keyword">endif</span>
<a name="l01335"></a>01335 
<a name="l01336"></a>01336       <span class="keyword">if</span> (lex) <span class="keyword">then</span>
<a name="l01337"></a>01337          <span class="keyword">open</span>(14,file=resolution_namelist)
<a name="l01338"></a>01338          <span class="keyword">read</span>(14,res)
<a name="l01339"></a>01339          <span class="keyword">close</span>(14)
<a name="l01340"></a>01340       <span class="keyword">endif</span>
<a name="l01341"></a>01341 
<a name="l01342"></a>01342       nlem = nlev - 1
<a name="l01343"></a>01343       nlep = nlev + 1
<a name="l01344"></a>01344       nlsq = nlev * nlev
<a name="l01345"></a>01345 
<a name="l01346"></a>01346       nlon = nlat + nlat <span class="comment">! Longitudes</span>
<a name="l01347"></a>01347       nlah = nlat / 2
<a name="l01348"></a>01348       nlpp = nlat
<a name="l01349"></a>01349       nhpp = nlah
<a name="l01350"></a>01350       nhor = nlon * nlpp
<a name="l01351"></a>01351 
<a name="l01352"></a>01352       ntru = (nlon - 1) / 3
<a name="l01353"></a>01353       ntp1 = ntru + 1
<a name="l01354"></a>01354       nzom = ntp1 + ntp1
<a name="l01355"></a>01355       nrsp = (ntru + 1) * (ntru + 2)
<a name="l01356"></a>01356       ncsp = nrsp / 2
<a name="l01357"></a>01357       nspp = nrsp
<a name="l01358"></a>01358       nesp = nspp
<a name="l01359"></a>01359 
<a name="l01360"></a>01360       return
<a name="l01361"></a>01361 <span class="keyword">      end</span>
<a name="l01362"></a>01362 
<a name="l01363"></a>01363 <span class="comment">!     =================</span>
<a name="l01364"></a>01364 <span class="comment">!     SUBROUTINE READNL</span>
<a name="l01365"></a>01365 <span class="comment">!     =================</span>
<a name="l01366"></a>01366 
<a name="l01367"></a><a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">01367</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">readnl</a>
<a name="l01368"></a>01368       use <span class="keywordflow">pumamod</span>
<a name="l01369"></a>01369 
<a name="l01370"></a>01370 <span class="comment">!     This namelist must be identical to namelist inp in puma.f90</span>
<a name="l01371"></a>01371 
<a name="l01372"></a>01372        namelist /inp/ &amp;
<a name="l01373"></a>01373          alpha   , alrpv   , alrs    , disp    &amp;
<a name="l01374"></a>01374        , dorox   , doroxs  , doroy   , doroys  , dt      , dtep    &amp;
<a name="l01375"></a>01375        , dtns    , dtrop   , dttrp   , dtzz    , dvdiff  , edgepv  &amp;
<a name="l01376"></a>01376        , epsync  &amp;
<a name="l01377"></a>01377        , flsp0   , flsdp   , flsamp  , flsoff  , horo    , kick    &amp;
<a name="l01378"></a>01378        , lat1oro , lat1tgr , lat2oro , lat2tgr &amp;
<a name="l01379"></a>01379        , lon1oro , lon1tgr , lon2oro , lon2tgr &amp;
<a name="l01380"></a>01380        , mpstep  &amp;
<a name="l01381"></a>01381        , nafter  , ncoeff  , ncorrect, ncu     , ndel    , ndiag   &amp;
<a name="l01382"></a>01382        , ndl     , nextout , nfls    , ngui    , nguidbg &amp;
<a name="l01383"></a>01383        , nhelsua, nsync    &amp;
<a name="l01384"></a>01384        , ntestgp , nkits   &amp;
<a name="l01385"></a>01385        , nlevt   , nmonths , noro    , norox   , noutput , noutsrv &amp;
<a name="l01386"></a>01386        , npackgp , npacksp , nreverse&amp;
<a name="l01387"></a>01387        , nruido  , nrun    , nselect , nspecsel, nsponge , nsrv    &amp;
<a name="l01388"></a>01388        , <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>   , nstop   , nstrato , ntgr    , nsym   , ntspd   &amp;
<a name="l01389"></a>01389        , nvg     , nwpd    , nwspini , nyears  , nyoden  &amp;
<a name="l01390"></a>01390        , oroano  , orofac  &amp;
<a name="l01391"></a>01391        , pac     , pmaxpv  , pspon   &amp;
<a name="l01392"></a>01392        , radpv   , restim  , rotspd  &amp;
<a name="l01393"></a>01393        , sigmah  , sigmax  , sponk   &amp;
<a name="l01394"></a>01394        , t0      , t0k     , tac     , tauta   , tauts   &amp;
<a name="l01395"></a>01395        , tdiss   , tfrc    , tgr     , tgrano  , ttp     &amp;
<a name="l01396"></a>01396        , nenergy , nentropy, ndheat
<a name="l01397"></a>01397 
<a name="l01398"></a>01398       nselect(:)     = 1
<a name="l01399"></a>01399       nspecsel(:)    = 1
<a name="l01400"></a>01400       ndl(:)         = 0
<a name="l01401"></a>01401       restim(:)      = 15.0
<a name="l01402"></a>01402       sigmah(:)      = 0.0
<a name="l01403"></a>01403       tfrc(1:nlev)   = (/ (0.0,i=1,nlem), 1.0 /)
<a name="l01404"></a>01404       t0k(:)         = 250.0
<a name="l01405"></a>01405       t0(:)          = 250.0
<a name="l01406"></a>01406       dt(:)          = 0.0
<a name="l01407"></a>01407 
<a name="l01408"></a>01408       <span class="keyword">open</span>(13,file=<span class="stringliteral">&#39;ppp_namelist&#39;</span>)
<a name="l01409"></a>01409       <span class="keyword">read</span> (13,inp)
<a name="l01410"></a>01410 
<a name="l01411"></a>01411 <span class="comment">!     Use predefined Yoden profile ?</span>
<a name="l01412"></a>01412 
<a name="l01413"></a>01413       <span class="keyword">if</span> (nlev == 20 .and. nyoden &gt; 0) <span class="keyword">then</span>
<a name="l01414"></a>01414 <span class="comment">!        noro  =   0    ! Don&#39;t read orography</span>
<a name="l01415"></a>01415 <span class="comment">!        norox =   2    ! Make idealized orography</span>
<a name="l01416"></a>01416 <span class="comment">!        horo  = 500.0  ! Height of idealized orography</span>
<a name="l01417"></a>01417          alrs  = -0.001 <span class="comment">! Stratospheric lapse rate</span>
<a name="l01418"></a>01418          nreverse = 0   <span class="comment">! No T-gradient reversal at tropopause</span>
<a name="l01419"></a>01419          ncorrect = 0   <span class="comment">! No T-correction due to orography</span>
<a name="l01420"></a>01420          idim = min(20,nlev)
<a name="l01421"></a>01421          <span class="keyword">if</span> (nyoden == 1) <span class="keyword">then</span>
<a name="l01422"></a>01422             t0(1:idim) = t0yod1(1:idim)
<a name="l01423"></a>01423             dt(1:idim) = dtyod1(1:idim)
<a name="l01424"></a>01424          <span class="keyword">else</span> <span class="keyword">if</span> (nyoden == 3) <span class="keyword">then</span>
<a name="l01425"></a>01425             t0(1:idim) = t0yod3(1:idim)
<a name="l01426"></a>01426             dt(1:idim) = dtyod3(1:idim)
<a name="l01427"></a>01427          <span class="keyword">else</span> <span class="keyword">if</span> (nyoden == 5) <span class="keyword">then</span>
<a name="l01428"></a>01428             t0(1:idim) = t0yod5(1:idim)
<a name="l01429"></a>01429             dt(1:idim) = dtyod5(1:idim)
<a name="l01430"></a>01430          <span class="keyword">else</span> <span class="keyword">if</span> (nyoden == 7) <span class="keyword">then</span>
<a name="l01431"></a>01431             t0(1:idim) = t0yod7(1:idim)
<a name="l01432"></a>01432             dt(1:idim) = dtyod7(1:idim)
<a name="l01433"></a>01433          <span class="keyword">else</span> <span class="keyword">if</span> (nyoden == 8) <span class="keyword">then</span>
<a name="l01434"></a>01434             t0(1:idim) = t0yod8(1:idim)
<a name="l01435"></a>01435             dt(1:idim) = dtyod8(1:idim)
<a name="l01436"></a>01436          <span class="keyword">else</span> <span class="keyword">if</span> (nyoden == 9) <span class="keyword">then</span>
<a name="l01437"></a>01437             t0(1:idim) = t0yod9(1:idim)
<a name="l01438"></a>01438             dt(1:idim) = dtyod9(1:idim)
<a name="l01439"></a>01439          <span class="keyword">endif</span>
<a name="l01440"></a>01440       <span class="keyword">endif</span>
<a name="l01441"></a>01441      
<a name="l01442"></a>01442       <span class="keyword">close</span>(13)
<a name="l01443"></a>01443       <span class="keyword">write</span>(*,inp)
<a name="l01444"></a>01444 
<a name="l01445"></a>01445       return
<a name="l01446"></a>01446 <span class="keyword">      end</span>
<a name="l01447"></a>01447 
<a name="l01448"></a>01448 <span class="comment">!     =====================</span>
<a name="l01449"></a>01449 <span class="comment">!     * SET VERTICAL GRID *</span>
<a name="l01450"></a>01450 <span class="comment">!     =====================</span>
<a name="l01451"></a>01451 
<a name="l01452"></a><a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">01452</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">set_vertical_grid</a>
<a name="l01453"></a>01453 
<a name="l01454"></a>01454       use <span class="keywordflow">pumamod</span>
<a name="l01455"></a>01455 
<a name="l01456"></a>01456       <span class="keyword">if</span> (sigmah(nlev) /= 0.0) return <span class="comment">! Already read in from namelist INP</span>
<a name="l01457"></a>01457 
<a name="l01458"></a>01458       <span class="keyword">if</span> (nvg == 1) <span class="keyword">then</span>              <span class="comment">! Scinocca &amp; Haynes sigma levels</span>
<a name="l01459"></a>01459 
<a name="l01460"></a>01460          <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="l01461"></a>01461             <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;*** ERROR *** nlevt &gt;= nlev&#39;</span>
<a name="l01462"></a>01462             <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;Number of levels (nlev): &#39;</span>,nlev
<a name="l01463"></a>01463             <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;Number of tropospheric levels (nlevt): &#39;</span>,nlevt
<a name="l01464"></a>01464          <span class="keyword">endif</span>   
<a name="l01465"></a>01465 
<a name="l01466"></a>01466 <span class="comment">!     troposphere: linear spacing in sigma</span>
<a name="l01467"></a>01467 <span class="comment">!     stratosphere: linear spacing in log(sigma)</span>
<a name="l01468"></a>01468 <span class="comment">!     after (see their Appendix):</span>
<a name="l01469"></a>01469 <span class="comment">!     Scinocca, J. F. and P. H. Haynes (1998): Dynamical forcing of</span>
<a name="l01470"></a>01470 <span class="comment">!        stratospheric planetary waves by tropospheric baroclinic eddies.</span>
<a name="l01471"></a>01471 <span class="comment">!        J. Atmos. Sci., 55 (14), 2361-2392</span>
<a name="l01472"></a>01472 
<a name="l01473"></a>01473 <span class="comment">!     Here, zsigtran is set to sigma at dtrop (tropopause height for</span>
<a name="l01474"></a>01474 <span class="comment">!     construction of restoration temperature field). If tgr=288.15K,</span>
<a name="l01475"></a>01475 <span class="comment">!     ALR=0.0065K/km and dtrop=11.km, then zsigtran=0.223 (=0.1 in</span>
<a name="l01476"></a>01476 <span class="comment">!     Scinocca and Haynes (1998)).</span>
<a name="l01477"></a>01477 <span class="comment">!     A smoothing of the transition between linear and logarithmic</span>
<a name="l01478"></a>01478 <span class="comment">!     spacing, as noted in Scinocca and Haynes (1998), is not yet</span>
<a name="l01479"></a>01479 <span class="comment">!     implemented.</span>
<a name="l01480"></a>01480 
<a name="l01481"></a>01481          zsigtran = (1. - ALR * dtrop / tgr)**(GA/(GASCON*ALR))
<a name="l01482"></a>01482          zsigmin = 1. - (1. - zsigtran) / <span class="keywordtype">real</span>(nlevt)
<a name="l01483"></a>01483 
<a name="l01484"></a>01484          <span class="keyword">do</span> jlev=1,nlev
<a name="l01485"></a>01485             <span class="keyword">if</span> (jlev == 1) <span class="keyword">then</span>
<a name="l01486"></a>01486                sigmah(jlev) = 0.000001
<a name="l01487"></a>01487                sigmah(jlev) = sigmax
<a name="l01488"></a>01488             elseif (jlev &gt; 1 .and. jlev &lt; nlev - nlevt) <span class="keyword">then</span>
<a name="l01489"></a>01489                sigmah(jlev) = exp((log(sigmax) - log(zsigtran))         &amp;
<a name="l01490"></a>01490      &amp;             / <span class="keywordtype">real(nlev - nlevt - 1)</span> * <span class="keywordtype">real(nlev - nlevt - jlev)</span> 
<a name="l01491"></a>01491                   + log(zsigtran))
<a name="l01492"></a>01492             elseif (jlev &gt;= nlev - nlevt .and. jlev &lt; nlev - 1) then
<a name="l01493"></a>01493                sigmah(jlev) = (zsigtran - zsigmin) / <span class="keywordtype">real(nlevt - 1)</span>    
<a name="l01494"></a>01494                              * real(nlev - 1 - jlev) + zsigmin
<a name="l01495"></a>01495             elseif (jlev == nlev - 1) then
<a name="l01496"></a>01496                sigmah(jlev) = zsigmin
<a name="l01497"></a>01497             elseif (jlev == nlev) <span class="keyword">then</span>
<a name="l01498"></a>01498                sigmah(jlev) = 1.
<a name="l01499"></a>01499             <span class="keyword">endif</span>
<a name="l01500"></a>01500          <span class="keyword">enddo</span>
<a name="l01501"></a>01501          return 
<a name="l01502"></a>01502       <span class="keyword">endif</span> <span class="comment">! (nvg == 1)</span>
<a name="l01503"></a>01503 
<a name="l01504"></a>01504       <span class="keyword">if</span> (nvg == 2) <span class="keyword">then</span>   <span class="comment">! Polvani &amp; Kushner sigma levels</span>
<a name="l01505"></a>01505          inl = int(<span class="keywordtype">real</span>(nlev)/(1.0 - sigmax**(1.0/5.0)))
<a name="l01506"></a>01506          <span class="keyword">do</span> jlev=1,nlev
<a name="l01507"></a>01507             sigmah(jlev) = (<span class="keywordtype">real(jlev + inl - nlev)</span> / <span class="keywordtype">real</span>(inl))**5
<a name="l01508"></a>01508          <span class="keyword">enddo</span>
<a name="l01509"></a>01509          return
<a name="l01510"></a>01510       <span class="keyword">endif</span> <span class="comment">! (nvg == 2)</span>
<a name="l01511"></a>01511 
<a name="l01512"></a>01512 <span class="comment">!     Default: equidistant sigma levels</span>
<a name="l01513"></a>01513 
<a name="l01514"></a>01514       <span class="keyword">if</span> (nvg == 0) <span class="keyword">then</span>
<a name="l01515"></a>01515          <span class="keyword">do</span> jlev = 1 , nlev
<a name="l01516"></a>01516             sigmah(jlev) = <span class="keywordtype">real(jlev)</span> / <span class="keywordtype">real</span>(nlev)
<a name="l01517"></a>01517          <span class="keyword">enddo</span>
<a name="l01518"></a>01518       <span class="keyword">endif</span> <span class="comment">! (nvg == 0)</span>
<a name="l01519"></a>01519 
<a name="l01520"></a>01520       return
<a name="l01521"></a>01521 <span class="keyword">      end</span>
<a name="l01522"></a>01522 
<a name="l01523"></a>01523 <span class="comment">!     =================</span>
<a name="l01524"></a>01524 <span class="comment">!     SUBROUTINE INITPM</span>
<a name="l01525"></a>01525 <span class="comment">!     =================</span>
<a name="l01526"></a>01526 
<a name="l01527"></a><a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">01527</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">initpm</a>
<a name="l01528"></a>01528       use <span class="keywordflow">pumamod</span>
<a name="l01529"></a>01529 
<a name="l01530"></a>01530       <span class="keywordtype">real (kind=8)</span> radea,zakk,zzakk
<a name="l01531"></a>01531       radea  = PLARAD_EARTH        <span class="comment">! Planet radius in high precision</span>
<a name="l01532"></a>01532       plavor = EZ * rotspd   <span class="comment">! Planetary vorticity</span>
<a name="l01533"></a>01533 
<a name="l01534"></a>01534 <span class="comment">!     *************************************************************</span>
<a name="l01535"></a>01535 <span class="comment">!     * carries out all initialisation of model prior to running. *</span>
<a name="l01536"></a>01536 <span class="comment">!     * major sections identified with comments.                  *</span>
<a name="l01537"></a>01537 <span class="comment">!     * this s/r sets the model parameters and all resolution     *</span>
<a name="l01538"></a>01538 <span class="comment">!     * dependent quantities.                                     *</span>
<a name="l01539"></a>01539 <span class="comment">!     *************************************************************</span>
<a name="l01540"></a>01540 
<a name="l01541"></a>01541 <span class="comment">!     *********************</span>
<a name="l01542"></a>01542 <span class="comment">!     * set vertical grid *</span>
<a name="l01543"></a>01543 <span class="comment">!     *********************</span>
<a name="l01544"></a>01544 
<a name="l01545"></a>01545       call <a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">set_vertical_grid</a>
<a name="l01546"></a>01546 
<a name="l01547"></a>01547       dsigma(1     ) = sigmah(1)
<a name="l01548"></a>01548       dsigma(2:nlev) = sigmah(2:nlev) - sigmah(1:NLEM)
<a name="l01549"></a>01549 
<a name="l01550"></a>01550       rdsig(:) = 0.5 / dsigma(:)
<a name="l01551"></a>01551 
<a name="l01552"></a>01552       sigma(1     ) = 0.5 * sigmah(1)
<a name="l01553"></a>01553       sigma(2:nlev) = 0.5 * (sigmah(1:NLEM) + sigmah(2:nlev))
<a name="l01554"></a>01554 
<a name="l01555"></a>01555 <span class="comment">!     annual cycle period and phase in timesteps</span>
<a name="l01556"></a>01556 
<a name="l01557"></a>01557       <span class="keyword">if</span> (tac &gt; 0.0) tac = TWOPI / (ntspd * tac)
<a name="l01558"></a>01558       pac = pac * ntspd
<a name="l01559"></a>01559 
<a name="l01560"></a>01560 <span class="comment">!     compute internal diffusion parameter</span>
<a name="l01561"></a>01561 
<a name="l01562"></a>01562       jdelh = ndel/2
<a name="l01563"></a>01563       <span class="keyword">if</span> (tdiss &gt; 0.0) <span class="keyword">then</span>
<a name="l01564"></a>01564          zakk = WW*(radea**ndel)/(TWOPI*tdiss*((ntru*(ntru+1.))**jdelh))
<a name="l01565"></a>01565       <span class="keyword">else</span>
<a name="l01566"></a>01566          zakk = 0.0
<a name="l01567"></a>01567       <span class="keyword">endif</span>
<a name="l01568"></a>01568       zzakk = zakk / (WW*(radea**ndel))
<a name="l01569"></a>01569 
<a name="l01570"></a>01570 <span class="comment">!     set coefficients which depend on wavenumber</span>
<a name="l01571"></a>01571 
<a name="l01572"></a>01572       zrsq2 = 1.0 / sqrt(2.0)
<a name="l01573"></a>01573 
<a name="l01574"></a>01574       jr=-1
<a name="l01575"></a>01575       <span class="keyword">do</span> jm=0,ntru
<a name="l01576"></a>01576          <span class="keyword">do</span> jn=jm,ntru
<a name="l01577"></a>01577             jr=jr+2
<a name="l01578"></a>01578             ji=jr+1
<a name="l01579"></a>01579             spnorm(jr)=zrsq2
<a name="l01580"></a>01580             spnorm(ji)=zrsq2
<a name="l01581"></a>01581          <span class="keyword">enddo</span>
<a name="l01582"></a>01582          zrsq2=-zrsq2
<a name="l01583"></a>01583       <span class="keyword">enddo</span>
<a name="l01584"></a>01584 
<a name="l01585"></a>01585       return
<a name="l01586"></a>01586 <span class="keyword">      end</span>
<a name="l01587"></a>01587 
<a name="l01588"></a><a class="code" href="ppp_8f90.html#a57e32ca0b91b99739b892a459ec40953">01588</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a57e32ca0b91b99739b892a459ec40953">printparameter</a>
<a name="l01589"></a>01589       use <span class="keywordflow">pumamod</span>
<a name="l01590"></a>01590       
<a name="l01591"></a>01591       print 8000
<a name="l01592"></a>01592       print 8050
<a name="l01593"></a>01593       print 8000
<a name="l01594"></a>01594       print 8010,nlev
<a name="l01595"></a>01595       print 8020,ntru
<a name="l01596"></a>01596       print 8030,nlat
<a name="l01597"></a>01597       print 8040,nlon
<a name="l01598"></a>01598       print 8000
<a name="l01599"></a>01599       print 8120
<a name="l01600"></a>01600       return
<a name="l01601"></a>01601  8000 format(<span class="stringliteral">&#39; *****************************************&#39;</span>)
<a name="l01602"></a>01602  8010 format(<span class="stringliteral">&#39; * nlev = &#39;</span>,i6,<span class="stringliteral">&#39;   Number of levels      *&#39;</span>)
<a name="l01603"></a>01603  8020 format(<span class="stringliteral">&#39; * ntru = &#39;</span>,i6,<span class="stringliteral">&#39;   Triangular truncation *&#39;</span>)
<a name="l01604"></a>01604  8030 format(<span class="stringliteral">&#39; * nlat = &#39;</span>,i6,<span class="stringliteral">&#39;   Number of latitudes   *&#39;</span>)
<a name="l01605"></a>01605  8040 format(<span class="stringliteral">&#39; * nlon = &#39;</span>,i6,<span class="stringliteral">&#39;   Number of longitues   *&#39;</span>)
<a name="l01606"></a>01606  8050 format(<span class="stringliteral">&#39; *       PPP - Puma Pre Processor        *&#39;</span>)
<a name="l01607"></a>01607  8120 format(/)
<a name="l01608"></a>01608 <span class="keyword">      end</span>
<a name="l01609"></a>01609 
<a name="l01610"></a>01610 
<a name="l01611"></a>01611 <span class="comment">!     ===================</span>
<a name="l01612"></a>01612 <span class="comment">!     SUBROUTINE GPROFILE</span>
<a name="l01613"></a>01613 <span class="comment">!     ===================</span>
<a name="l01614"></a><a class="code" href="ppp_8f90.html#a2da275fb5e4fcd6df1126d74539963cb">01614</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a2da275fb5e4fcd6df1126d74539963cb">gprofile</a>(ptgr,prgrad,pgpm)
<a name="l01615"></a>01615       use <span class="keywordflow">pumamod</span>
<a name="l01616"></a>01616 
<a name="l01617"></a>01617 <span class="comment">!     *************************************************************</span>
<a name="l01618"></a>01618 <span class="comment">!     * Set up the restoration temperature profiles for gradient  *</span>
<a name="l01619"></a>01619 <span class="comment">!     * modes DTNS - mode[0,1] and DTEP - mode[0,2]               *</span>
<a name="l01620"></a>01620 <span class="comment">!     * The lapse rate of ALR K/m is assumed under the tropopause *</span>
<a name="l01621"></a>01621 <span class="comment">!     * and zero above. The tropopause is defined by &lt;dtrop&gt;.     *</span>
<a name="l01622"></a>01622 <span class="comment">!     * The profile is a sine wave with 0 at tropopause sigma and *</span>
<a name="l01623"></a>01623 <span class="comment">!     * 1 at sigma = 1.                                           *</span>
<a name="l01624"></a>01624 <span class="comment">!     ************************************************************* </span>
<a name="l01625"></a>01625 
<a name="l01626"></a>01626       dimension prgrad(nlev)
<a name="l01627"></a>01627 
<a name="l01628"></a>01628       ztpheight = dtrop - pgpm      <span class="comment">! Tropopause height over ground</span>
<a name="l01629"></a>01629       ztptemp   = tgr - ALR * dtrop <span class="comment">! Tropopause temperature</span>
<a name="l01630"></a>01630       ztps = (ztptemp/ptgr)**(GA/(ALR*GASCON)) <span class="comment">! Tropoause sigma</span>
<a name="l01631"></a>01631 
<a name="l01632"></a>01632       <span class="keyword">do</span> jlev = 1 , nlev
<a name="l01633"></a>01633          prgrad(jlev) = sin(0.5*PI*(sigma(jlev)-ztps)/(1.0-ztps))
<a name="l01634"></a>01634          <span class="keyword">if</span> (sigma(jlev) &lt; ztps) prgrad(jlev) = 0.0
<a name="l01635"></a>01635       <span class="keyword">enddo</span>
<a name="l01636"></a>01636 
<a name="l01637"></a>01637       return
<a name="l01638"></a>01638 <span class="keyword">      end</span>
<a name="l01639"></a>01639 
<a name="l01640"></a>01640 <span class="comment">!     ===================</span>
<a name="l01641"></a>01641 <span class="comment">!     SUBROUTINE TPROFILE</span>
<a name="l01642"></a>01642 <span class="comment">!     ===================</span>
<a name="l01643"></a><a class="code" href="ppp_8f90.html#a109d8c58aa308107712782398903ea71">01643</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a109d8c58aa308107712782398903ea71">tprofile</a>(ptgr,prof,pgpm)
<a name="l01644"></a>01644       use <span class="keywordflow">pumamod</span>
<a name="l01645"></a>01645 
<a name="l01646"></a>01646 <span class="comment">!     *************************************************************</span>
<a name="l01647"></a>01647 <span class="comment">!     * Set up the restoration temperature profile for one column *</span>
<a name="l01648"></a>01648 <span class="comment">!     * The temperature at sigma = 1 is &lt;ptgr&gt;, entered in kelvin *</span>
<a name="l01649"></a>01649 <span class="comment">!     * The lapse rate of ALR K/m is assumed under the tropopause *</span>
<a name="l01650"></a>01650 <span class="comment">!     * and zero above. The tropopause is defined by &lt;ztpheight&gt;. *</span>
<a name="l01651"></a>01651 <span class="comment">!     * The smoothing ot the tropopause depends on &lt;dttrp&gt;.       *</span>
<a name="l01652"></a>01652 <span class="comment">!     ************************************************************* </span>
<a name="l01653"></a>01653 
<a name="l01654"></a>01654       dimension prof(nlev)  <span class="comment">! Resulting temperature profile [K]</span>
<a name="l01655"></a>01655 
<a name="l01656"></a>01656       zsigprev  = 1.0               <span class="comment">! sigma value</span>
<a name="l01657"></a>01657       ztprev    = ptgr              <span class="comment">! Temperature [K]</span>
<a name="l01658"></a>01658       zzprev    = 0.0               <span class="comment">! Height      [m]</span>
<a name="l01659"></a>01659       ztpheight = dtrop - pgpm      <span class="comment">! Tropopause height over ground</span>
<a name="l01660"></a>01660       ztptemp   = tgr - ALR * dtrop <span class="comment">! Tropopause temperature</span>
<a name="l01661"></a>01661       zalr      = (ptgr - ztptemp) / ztpheight
<a name="l01662"></a>01662 
<a name="l01663"></a>01663       <span class="keyword">do</span> jlev = nlev , 1 , -1   <span class="comment">! from bottom to top of atmosphere</span>
<a name="l01664"></a>01664          zlogsig = GASCON / GA * log(zsigprev / sigma(jlev))
<a name="l01665"></a>01665          zzp     = zzprev + ztprev * zlogsig
<a name="l01666"></a>01666          ztp=ztptemp+sqrt((.5*zalr*(zzp-ztpheight))**2+dttrp**2)
<a name="l01667"></a>01667          ztp=ztp-.5*zalr*(zzp-ztpheight)
<a name="l01668"></a>01668          ztpm=.5*(ztprev+ztp)
<a name="l01669"></a>01669 
<a name="l01670"></a>01670          zzpp = zzprev + ztpm * zlogsig
<a name="l01671"></a>01671          ztpp=ztptemp+sqrt((.5*zalr*(zzpp-ztpheight))**2+dttrp**2)
<a name="l01672"></a>01672          ztpp=ztpp-.5*zalr*(zzpp-ztpheight)
<a name="l01673"></a>01673 
<a name="l01674"></a>01674          prof(jlev)=ztpp
<a name="l01675"></a>01675          zzprev=zzprev + 0.5 * (ztpp+ztprev) * zlogsig
<a name="l01676"></a>01676          ztprev=ztpp
<a name="l01677"></a>01677          zsigprev=sigma(jlev)
<a name="l01678"></a>01678       <span class="keyword">enddo</span>
<a name="l01679"></a>01679       return
<a name="l01680"></a>01680 <span class="keyword">      end</span>
<a name="l01681"></a>01681 
<a name="l01682"></a>01682 <span class="comment">!     ======================</span>
<a name="l01683"></a>01683 <span class="comment">!     SUBROUTINE ppp_write_i</span>
<a name="l01684"></a>01684 <span class="comment">!     ======================</span>
<a name="l01685"></a>01685 
<a name="l01686"></a><a class="code" href="ppp_8f90.html#adbcdb3579718dc6067a1b2ec4d26e476">01686</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#adbcdb3579718dc6067a1b2ec4d26e476">ppp_write_i</a>(yvarname,nvals,ivals)
<a name="l01687"></a>01687       use <span class="keywordflow">pumamod</span>
<a name="l01688"></a>01688   
<a name="l01689"></a>01689       <span class="keywordtype">character(*)</span>   :: yvarname
<a name="l01690"></a>01690       <span class="keywordtype">integer</span>        :: nvals
<a name="l01691"></a>01691       <span class="keywordtype">integer</span>        :: ivals(nvals)
<a name="l01692"></a>01692 
<a name="l01693"></a>01693       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> 
<a name="l01694"></a>01694          <span class="keyword">write</span>(95,<span class="stringliteral">&#39;(&quot;[&quot;,A,&quot;]&quot;)&#39;</span>) trim(yvarname)
<a name="l01695"></a>01695          <span class="keyword">write</span>(95,<span class="stringliteral">&#39;(I4)&#39;</span>) nvals
<a name="l01696"></a>01696          <span class="keyword">write</span>(95,<span class="stringliteral">&#39;(I6)&#39;</span>) ivals(:)
<a name="l01697"></a>01697       <span class="keyword">endif</span>
<a name="l01698"></a>01698       return
<a name="l01699"></a>01699 <span class="keyword">      end</span>
<a name="l01700"></a>01700 
<a name="l01701"></a>01701 <span class="comment">!     ======================</span>
<a name="l01702"></a>01702 <span class="comment">!     SUBROUTINE ppp_write_r </span>
<a name="l01703"></a>01703 <span class="comment">!     ======================</span>
<a name="l01704"></a>01704 
<a name="l01705"></a><a class="code" href="ppp_8f90.html#a74276344215789d1e8fdce713dd9cd25">01705</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a74276344215789d1e8fdce713dd9cd25">ppp_write_r</a>(yvarname,nvals,pvals)
<a name="l01706"></a>01706       use <span class="keywordflow">pumamod</span>
<a name="l01707"></a>01707 
<a name="l01708"></a>01708       <span class="keywordtype">character(*)</span>   :: yvarname
<a name="l01709"></a>01709       <span class="keywordtype">integer</span>        :: nvals
<a name="l01710"></a>01710       <span class="keywordtype">real</span>           :: pvals(nvals)
<a name="l01711"></a>01711 
<a name="l01712"></a>01712       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
<a name="l01713"></a>01713          <span class="keyword">write</span>(95,<span class="stringliteral">&#39;(&quot;[&quot;,A,&quot;]&quot;)&#39;</span>) trim(yvarname)
<a name="l01714"></a>01714          <span class="keyword">write</span>(95,<span class="stringliteral">&#39;(I4)&#39;</span>) nvals
<a name="l01715"></a>01715          <span class="keyword">write</span>(95,<span class="stringliteral">&#39;(E14.8)&#39;</span>) pvals(:)
<a name="l01716"></a>01716       <span class="keyword">endif</span>
<a name="l01717"></a>01717       return
<a name="l01718"></a>01718 <span class="keyword">      end</span>
<a name="l01719"></a>01719 
<a name="l01720"></a>01720 <span class="comment">!     ================</span>
<a name="l01721"></a>01721 <span class="comment">!     SUBROUTINE yoden</span>
<a name="l01722"></a>01722 <span class="comment">!     ================</span>
<a name="l01723"></a>01723 
<a name="l01724"></a><a class="code" href="ppp_8f90.html#a76e236098c9f27c53d3a8827d11554cf">01724</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a76e236098c9f27c53d3a8827d11554cf">yoden</a>
<a name="l01725"></a>01725       use <span class="keywordflow">pumamod</span>
<a name="l01726"></a>01726 <span class="comment">!</span>
<a name="l01727"></a>01727       <span class="keyword">do</span> jlev=1,nlev
<a name="l01728"></a>01728        <span class="keyword">do</span> jlat=1,nlat/2
<a name="l01729"></a>01729         zlat=dla(jlat)
<a name="l01730"></a>01730         ztres=t0(jlev)+dt(jlev)/2.*(cos(2.*zlat)-1./3.)
<a name="l01731"></a>01731         <span class="keyword">do</span> jlon=1,nlon
<a name="l01732"></a>01732          gtc(jlon,jlat,jlev)=ztres
<a name="l01733"></a>01733         <span class="keyword">enddo</span>
<a name="l01734"></a>01734        <span class="keyword">enddo</span>
<a name="l01735"></a>01735       <span class="keyword">enddo</span>
<a name="l01736"></a>01736 <span class="comment">!</span>
<a name="l01737"></a>01737       <span class="keyword">do</span> jlat=1,nlat/2
<a name="l01738"></a>01738        j2=nlat+1-jlat
<a name="l01739"></a>01739        gtc(:,j2,:)=gtc(:,jlat,:)
<a name="l01740"></a>01740       <span class="keyword">enddo</span>
<a name="l01741"></a>01741 
<a name="l01742"></a>01742       <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39; Computed Yoden profile&#39;</span>,nyoden
<a name="l01743"></a>01743 <span class="comment">!</span>
<a name="l01744"></a>01744       return
<a name="l01745"></a>01745 <span class="keyword">      end</span>
<a name="l01746"></a>01746 <span class="comment">!</span>
<a name="l01747"></a>01747 <span class="comment">!     =======================</span>
<a name="l01748"></a>01748 <span class="comment">!     SUBROUTINE PRINTPROFILE</span>
<a name="l01749"></a>01749 <span class="comment">!     =======================</span>
<a name="l01750"></a>01750 
<a name="l01751"></a><a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">01751</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">printprofile</a>
<a name="l01752"></a>01752       use <span class="keywordflow">pumamod</span>
<a name="l01753"></a>01753 
<a name="l01754"></a>01754 <span class="comment">!     **********************************</span>
<a name="l01755"></a>01755 <span class="comment">!     * write out vertical information *</span>
<a name="l01756"></a>01756 <span class="comment">!     **********************************</span>
<a name="l01757"></a>01757 
<a name="l01758"></a>01758       dimension ztr(nlev+1)
<a name="l01759"></a>01759 
<a name="l01760"></a>01760       ztr(nlev+1) = tgr
<a name="l01761"></a>01761 
<a name="l01762"></a>01762       <span class="keyword">write</span>(*,9001)
<a name="l01763"></a>01763       <span class="keyword">write</span>(*,9002)
<a name="l01764"></a>01764       <span class="keyword">write</span>(*,9003)
<a name="l01765"></a>01765       <span class="keyword">write</span>(*,9002)
<a name="l01766"></a>01766 
<a name="l01767"></a>01767       <span class="keyword">do</span> jlev=1,nlev
<a name="l01768"></a>01768          ztr(jlev) = sum(gtc(:,:,jlev)) / (nlon * nlat)
<a name="l01769"></a>01769       <span class="keyword">enddo</span>
<a name="l01770"></a>01770 
<a name="l01771"></a>01771       <span class="keyword">do</span> jlev=1,nlev
<a name="l01772"></a>01772       <span class="keyword">write</span>(*,9004) jlev,sigma(jlev),ztr(jlev),ztr(jlev+1)-ztr(jlev),gra(jlev)
<a name="l01773"></a>01773       <span class="keyword">enddo</span>
<a name="l01774"></a>01774 
<a name="l01775"></a>01775       <span class="keyword">write</span>(*,9002)
<a name="l01776"></a>01776       <span class="keyword">write</span>(*,9001)
<a name="l01777"></a>01777       return
<a name="l01778"></a>01778  9001 format(/)
<a name="l01779"></a>01779  9002 format(1x,45(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l01780"></a>01780  9003 format(<span class="stringliteral">&#39; * Lv *     Sigma Restor-T  Delta-T    Vfact *&#39;</span>)
<a name="l01781"></a>01781  9004 format(<span class="stringliteral">&#39; *&#39;</span>,i3,<span class="stringliteral">&#39; * &#39;</span>,4f9.3,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l01782"></a>01782 <span class="keyword">      end</span>
<a name="l01783"></a>01783 
<a name="l01784"></a>01784 <span class="comment">!     =====================</span>
<a name="l01785"></a>01785 <span class="comment">!     * SUBROUTINE LEGPRI *</span>
<a name="l01786"></a>01786 <span class="comment">!     =====================</span>
<a name="l01787"></a>01787 
<a name="l01788"></a><a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">01788</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">legpri</a>
<a name="l01789"></a>01789       use <span class="keywordflow">pumamod</span>
<a name="l01790"></a>01790 
<a name="l01791"></a>01791       <span class="keyword">write</span> (*,231)
<a name="l01792"></a>01792       <span class="keyword">write</span> (*,232)
<a name="l01793"></a>01793       <span class="keyword">write</span> (*,233)
<a name="l01794"></a>01794       <span class="keyword">write</span> (*,232)
<a name="l01795"></a>01795       <span class="keyword">do</span> 14 jlat = 1 , nlat
<a name="l01796"></a>01796          zalat = dla(jlat)*180.0/PI
<a name="l01797"></a>01797          <span class="keyword">write</span> (*,234) jlat,zalat,csq(jlat),gwd(jlat)
<a name="l01798"></a>01798    14 continue
<a name="l01799"></a>01799       <span class="keyword">write</span> (*,232)
<a name="l01800"></a>01800       <span class="keyword">write</span> (*,231)
<a name="l01801"></a>01801       return
<a name="l01802"></a>01802   231 format(/)
<a name="l01803"></a>01803   232 format(1x,36(<span class="stringliteral">&#39;*&#39;</span>))
<a name="l01804"></a>01804   233 format(<span class="stringliteral">&#39; * No *   Lat *       csq    weight *&#39;</span>)
<a name="l01805"></a>01805   234 format(<span class="stringliteral">&#39; *&#39;</span>,i3,<span class="stringliteral">&#39; *&#39;</span>,f6.1,<span class="stringliteral">&#39; *&#39;</span>,2f10.4,<span class="stringliteral">&#39; *&#39;</span>)
<a name="l01806"></a>01806 <span class="keyword">      end</span>
<a name="l01807"></a>01807 
<a name="l01808"></a>01808 
<a name="l01809"></a>01809 <span class="comment">!     =================</span>
<a name="l01810"></a>01810 <span class="comment">!     SUBROUTINE INILAT</span>
<a name="l01811"></a>01811 <span class="comment">!     =================</span>
<a name="l01812"></a>01812 
<a name="l01813"></a><a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">01813</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">inilat</a>
<a name="l01814"></a>01814       use <span class="keywordflow">pumamod</span>
<a name="l01815"></a>01815       <span class="keywordtype">character(1)</span> :: ch
<a name="l01816"></a>01816 
<a name="l01817"></a>01817       ch = <span class="stringliteral">&#39;N&#39;</span>
<a name="l01818"></a>01818       <span class="keyword">do</span> jlat = 1 , nlat
<a name="l01819"></a>01819          csq(jlat) = 1.0 - sid(jlat) * sid(jlat)
<a name="l01820"></a>01820          dla(jlat) = asin(sid(jlat))
<a name="l01821"></a>01821       <span class="keyword">enddo</span>
<a name="l01822"></a>01822       <span class="keyword">do</span> jlat = 1 , nlat/2
<a name="l01823"></a>01823          ideg = nint(180.0/PI * asin(sid(jlat)))
<a name="l01824"></a>01824          <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="l01825"></a>01825          <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="l01826"></a>01826       <span class="keyword">enddo</span>
<a name="l01827"></a>01827       return
<a name="l01828"></a>01828 <span class="keyword">      end</span>
<a name="l01829"></a>01829 
<a name="l01830"></a>01830 
<a name="l01831"></a>01831 <span class="comment">!     =================</span>
<a name="l01832"></a>01832 <span class="comment">!     SUBROUTINE SETZT2</span>
<a name="l01833"></a>01833 <span class="comment">!     =================</span>
<a name="l01834"></a><a class="code" href="ppp_8f90.html#aa036704b2d766c3d7b7b48756b972d05">01834</a>       <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aa036704b2d766c3d7b7b48756b972d05">setzt2</a>
<a name="l01835"></a>01835       use <span class="keywordflow">pumamod</span>
<a name="l01836"></a>01836 
<a name="l01837"></a>01837 <span class="comment">!                             US standard atmosphere (1976):</span>
<a name="l01838"></a>01838       parameter(INL = 7)      <span class="comment">! number of defined layers</span>
<a name="l01839"></a>01839       dimension zzus(0:INL)   <span class="comment">! height of interfaces between layers</span>
<a name="l01840"></a>01840       dimension zlus(INL)     <span class="comment">! temperature lapse rates of layers</span>
<a name="l01841"></a>01841       dimension zpus(0:INL)   <span class="comment">! pressure at interfaces between layers</span>
<a name="l01842"></a>01842       dimension ztus(0:INL)   <span class="comment">! temperature at interfaces between layers</span>
<a name="l01843"></a>01843 
<a name="l01844"></a>01844       dimension ztrs(nlev)  <span class="comment">! Mean profile</span>
<a name="l01845"></a>01845       dimension ztpv(nlev)  <span class="comment">! Vertical profile of stratospheric polar</span>
<a name="l01846"></a>01846 <span class="comment">!                             vortex forcing</span>
<a name="l01847"></a>01847       dimension zdtep(nlat)
<a name="l01848"></a>01848       dimension zdtns(nlat)
<a name="l01849"></a>01849       dimension zff(nlev)
<a name="l01850"></a>01850       dimension zfw(nlat,nlev)
<a name="l01851"></a>01851       dimension zfsph(nlat,nlev)
<a name="l01852"></a>01852       dimension zqc(nlat,nlev)
<a name="l01853"></a>01853       dimension zphi(nlat)
<a name="l01854"></a>01854       dimension zgr1(nlon,nlat,nlev)
<a name="l01855"></a>01855       dimension zgr2(nlon,nlat,nlev)
<a name="l01856"></a>01856       dimension zfls(nlat,nlev)
<a name="l01857"></a>01857 
<a name="l01858"></a>01858       <span class="keywordtype">real</span> :: zp
<a name="l01859"></a>01859       <span class="keywordtype">real</span> :: zsigtp
<a name="l01860"></a>01860       <span class="keywordtype">real</span> :: pref
<a name="l01861"></a>01861       <span class="keywordtype">real</span> :: zpmaxsph
<a name="l01862"></a>01862 
<a name="l01863"></a>01863       sr1(:,:) = 0.0 <span class="comment">! NESP,nlev</span>
<a name="l01864"></a>01864       sr2(:,:) = 0.0 <span class="comment">! NESP,nlev</span>
<a name="l01865"></a>01865 
<a name="l01866"></a>01866 <span class="comment">!     1. Mean vertical profile (MVP), approx. US standard atmosphere</span>
<a name="l01867"></a>01867 
<a name="l01868"></a>01868       zzus(0) = 0.
<a name="l01869"></a>01869       zzus(1) = dtrop     <span class="comment">! US standard atmosphere: zzus(1) = 11000.</span>
<a name="l01870"></a>01870       zzus(2) = 20000.
<a name="l01871"></a>01871       zzus(3) = 32000.
<a name="l01872"></a>01872       zzus(4) = 47000.
<a name="l01873"></a>01873       zzus(5) = 51000.
<a name="l01874"></a>01874       zzus(6) = 71000.
<a name="l01875"></a>01875       zzus(7) = 84852.
<a name="l01876"></a>01876       zlus(1) = ALR      <span class="comment">! US standard atmosphere: zlus(1) = 0.0065</span>
<a name="l01877"></a>01877       zlus(2) = 0.0
<a name="l01878"></a>01878       zlus(3) = -0.001
<a name="l01879"></a>01879       zlus(4) = -0.0028
<a name="l01880"></a>01880       zlus(5) = 0.0
<a name="l01881"></a>01881       zlus(6) = 0.0028
<a name="l01882"></a>01882       zlus(7) = 0.002
<a name="l01883"></a>01883 
<a name="l01884"></a>01884 <span class="comment">! calculation of pressure and temperature at layer interfaces</span>
<a name="l01885"></a>01885 
<a name="l01886"></a>01886       zpus(0) = PSURF <span class="comment">! US standard atmosphere: zpus(0) = 1013.25 hPa</span>
<a name="l01887"></a>01887       ztus(0) = tgr   <span class="comment">! US standard atmosphere: ztus(0) = 288.15 K</span>
<a name="l01888"></a>01888 
<a name="l01889"></a>01889       <span class="keyword">do</span> ji=1,INL
<a name="l01890"></a>01890          ztus(ji) = ztus(ji-1) - zlus(ji) * (zzus(ji) - zzus(ji-1))
<a name="l01891"></a>01891          <span class="keyword">if</span> (zlus(ji) == 0.) <span class="keyword">then</span>
<a name="l01892"></a>01892             zpus(ji) = zpus(ji-1) * exp(-GA * (zzus(ji) - zzus(ji-1))   &amp;
<a name="l01893"></a>01893      &amp;                  / (GASCON * ztus(ji-1)))
<a name="l01894"></a>01894          <span class="keyword">else</span>
<a name="l01895"></a>01895             zpus(ji) = zpus(ji-1)                                       &amp;
<a name="l01896"></a>01896      &amp;                 * (ztus(ji) / ztus(ji-1))**(GA/(GASCON*zlus(ji)))
<a name="l01897"></a>01897          <span class="keyword">endif</span>
<a name="l01898"></a>01898       <span class="keyword">enddo</span>
<a name="l01899"></a>01899 
<a name="l01900"></a>01900 <span class="comment">! calculation of temperature on given sigma full levels, sigma(1:nlev)</span>
<a name="l01901"></a>01901       <span class="keyword">do</span> jlev=nlev,1,-1
<a name="l01902"></a>01902          zp = sigma(jlev)*PSURF
<a name="l01903"></a>01903          <span class="keyword">if</span> (zp &lt;= zpus(0) .and. zp &gt; zpus(1)) <span class="keyword">then</span>
<a name="l01904"></a>01904             ztrs(jlev) = ztus(0) * (zp / zpus(0))**(GASCON*zlus(1)/GA)
<a name="l01905"></a>01905          elseif (zp &lt;= zpus(1) .and. zp &gt; zpus(2)) <span class="keyword">then</span>
<a name="l01906"></a>01906             ztrs(jlev) = ztus(1) * (zp / zpus(1))**(GASCON*zlus(2)/GA)
<a name="l01907"></a>01907          elseif (zp &lt;= zpus(2) .and. zp &gt; zpus(3)) <span class="keyword">then</span>
<a name="l01908"></a>01908             ztrs(jlev) = ztus(2) * (zp / zpus(2))**(GASCON*zlus(3)/GA)
<a name="l01909"></a>01909          elseif (zp &lt;= zpus(3) .and. zp &gt; zpus(4)) <span class="keyword">then</span>
<a name="l01910"></a>01910             ztrs(jlev) = ztus(3) * (zp / zpus(3))**(GASCON*zlus(4)/GA)
<a name="l01911"></a>01911          elseif (zp &lt;= zpus(4) .and. zp &gt; zpus(5)) <span class="keyword">then</span>
<a name="l01912"></a>01912             ztrs(jlev) = ztus(4) * (zp / zpus(4))**(GASCON*zlus(5)/GA)
<a name="l01913"></a>01913          elseif (zp &lt;= zpus(5) .and. zp &gt; zpus(6)) <span class="keyword">then</span>
<a name="l01914"></a>01914             ztrs(jlev) = ztus(5) * (zp / zpus(5))**(GASCON*zlus(6)/GA)
<a name="l01915"></a>01915          elseif (zp &lt;= zpus(6) .and. zp &gt; zpus(7)) <span class="keyword">then</span>
<a name="l01916"></a>01916             ztrs(jlev) = ztus(6) * (zp / zpus(6))**(GASCON*zlus(7)/GA)
<a name="l01917"></a>01917          <span class="keyword">else</span>
<a name="l01918"></a>01918             ztrs(jlev) = ztus(7)
<a name="l01919"></a>01919          <span class="keyword">endif</span>
<a name="l01920"></a>01920       <span class="keyword">enddo</span>
<a name="l01921"></a>01921 
<a name="l01922"></a>01922 <span class="comment">!     2. Symmetric equator-pole forcing mode (DTEP) and</span>
<a name="l01923"></a>01923 <span class="comment">!     3. Asymmetric Npole-Spole forcing mode (DTNS)</span>
<a name="l01924"></a>01924 
<a name="l01925"></a>01925 <span class="comment">!     sid(nlat) is sine of latitude, taking into account the nonequally</span>
<a name="l01926"></a>01926 <span class="comment">!     spaced Gaussian latitudes.</span>
<a name="l01927"></a>01927       <span class="keyword">do</span> jlat=1,nlat
<a name="l01928"></a>01928          zdtep(jlat) = -dtep * (sid(jlat)**2 - 1./3.)
<a name="l01929"></a>01929          zdtns(jlat) =  dtns * sid(jlat) / 2.
<a name="l01930"></a>01930       <span class="keyword">enddo</span>
<a name="l01931"></a>01931 
<a name="l01932"></a>01932 <span class="comment">!     4. Factor modulating the DTEP and DTNS modes (f)</span>
<a name="l01933"></a>01933 
<a name="l01934"></a>01934       zsigtp = zpus(1)/zpus(0)   <span class="comment">! sigma at tropopause</span>
<a name="l01935"></a>01935       zff(:) = 0.
<a name="l01936"></a>01936       <span class="keyword">do</span> jlev=1,nlev
<a name="l01937"></a>01937          <span class="keyword">if</span> (sigma(jlev) &gt; zsigtp) <span class="keyword">then</span>
<a name="l01938"></a>01938             zff(jlev) = sin(0.5*PI * (sigma(jlev) - zsigtp)             &amp;
<a name="l01939"></a>01939      &amp;                                                  / (1. - zsigtp))
<a name="l01940"></a>01940          <span class="keyword">endif</span>
<a name="l01941"></a>01941       <span class="keyword">enddo</span>
<a name="l01942"></a>01942 
<a name="l01943"></a>01943 <span class="comment">!     5. Vertical profile of stratospheric polar vortex forcing</span>
<a name="l01944"></a>01944 
<a name="l01945"></a>01945       ztpv(:) = 0.
<a name="l01946"></a>01946       <span class="keyword">if</span> (pmaxpv == 0.) <span class="keyword">then</span>
<a name="l01947"></a>01947          <span class="keyword">do</span> jlev=1,nlev
<a name="l01948"></a>01948             <span class="keyword">if</span> (sigma(jlev) &lt;= zsigtp) <span class="keyword">then</span>
<a name="l01949"></a>01949                ztpv(jlev) = ztus(1) * (sigma(jlev)*PSURF / zpus(1))     &amp;
<a name="l01950"></a>01950      &amp;                                               **(GASCON*alrpv/GA)
<a name="l01951"></a>01951             <span class="keyword">endif</span>
<a name="l01952"></a>01952          <span class="keyword">enddo</span>
<a name="l01953"></a>01953       elseif (pmaxpv &gt; 0.) <span class="keyword">then</span>
<a name="l01954"></a>01954          <span class="keyword">do</span> jlev=1,nlev
<a name="l01955"></a>01955             <span class="keyword">if</span> (sigma(jlev) &lt;= pmaxpv/PSURF) <span class="keyword">then</span>
<a name="l01956"></a>01956                ztpv(jlev) = ztus(1) * (sigma(jlev)*PSURF / pmaxpv)      &amp;
<a name="l01957"></a>01957      &amp;                                               **(GASCON*alrpv/GA)
<a name="l01958"></a>01958             <span class="keyword">else</span>
<a name="l01959"></a>01959                ztpv(jlev) = ztus(1)
<a name="l01960"></a>01960             <span class="keyword">endif</span>
<a name="l01961"></a>01961          <span class="keyword">enddo</span>
<a name="l01962"></a>01962       <span class="keyword">endif</span>
<a name="l01963"></a>01963 
<a name="l01964"></a>01964 <span class="comment">!     6. Factor confining the stratosph. polar vortex to high latitudes</span>
<a name="l01965"></a>01965 
<a name="l01966"></a>01966       zphi(:) = dla(:) * 180. / PI
<a name="l01967"></a>01967       zfw(:,:) = 0.
<a name="l01968"></a>01968       <span class="keyword">if</span> (edgepv &gt; 0.) <span class="keyword">then</span>
<a name="l01969"></a>01969          <span class="keyword">do</span> jlev=1,nlev
<a name="l01970"></a>01970             <span class="keyword">if</span> (sigma(jlev) &lt;= pmaxpv/PSURF) <span class="keyword">then</span>
<a name="l01971"></a>01971                <span class="keyword">do</span> jlat=1,nlat
<a name="l01972"></a>01972                   zfw(jlat,jlev) =                                      &amp;
<a name="l01973"></a>01973      &amp;                  0.5 * (1. - tanh((radpv - zphi(jlat)) / edgepv))
<a name="l01974"></a>01974                <span class="keyword">enddo</span>
<a name="l01975"></a>01975             <span class="keyword">endif</span>
<a name="l01976"></a>01976          <span class="keyword">enddo</span>
<a name="l01977"></a>01977       <span class="keyword">endif</span>
<a name="l01978"></a>01978 
<a name="l01979"></a>01979 <span class="comment">!     7. Lower stratospheric forcing</span>
<a name="l01980"></a>01980 
<a name="l01981"></a>01981       zfls(:,:) = 0.
<a name="l01982"></a>01982       <span class="keyword">if</span> (nfls == 1) <span class="keyword">then</span>
<a name="l01983"></a>01983          <span class="keyword">do</span> jlev=1,nlev
<a name="l01984"></a>01984             zp =sigma(jlev) * PSURF
<a name="l01985"></a>01985             <span class="keyword">do</span> jlat=1,nlat
<a name="l01986"></a>01986                <span class="keyword">if</span> (zp &gt; flsp0-flsdp .and. zp &lt; flsp0+flsdp) <span class="keyword">then</span>
<a name="l01987"></a>01987                   zfls(jlat,jlev) = cos(0.5 * PI * (zp - flsp0) / flsdp)&amp;
<a name="l01988"></a>01988      &amp;            * (flsoff - flsamp * cos(2. * zphi(jlat) * PI / 180.))
<a name="l01989"></a>01989                <span class="keyword">endif</span>
<a name="l01990"></a>01990             <span class="keyword">enddo</span>
<a name="l01991"></a>01991          <span class="keyword">enddo</span>
<a name="l01992"></a>01992       <span class="keyword">endif</span>
<a name="l01993"></a>01993 
<a name="l01994"></a>01994 <span class="comment">!     construct restoration temperature field</span>
<a name="l01995"></a>01995 
<a name="l01996"></a>01996       <span class="keyword">do</span> jlev=1,nlev
<a name="l01997"></a>01997          <span class="keyword">do</span> jlat=1,nlat
<a name="l01998"></a>01998             zgr1(:,jlat,jlev) = ((1. - zfw(jlat,jlev)) * ztrs(jlev)     &amp;
<a name="l01999"></a>01999      &amp;         + zfw(jlat,jlev) * ztpv(jlev) + zff(jlev) * zdtep(jlat)  &amp;
<a name="l02000"></a>02000      &amp;     + (1. - zfw(jlat,jlev)) * zfls(jlat,jlev) - t0k(jlev)) / CT
<a name="l02001"></a>02001             zgr2(:,jlat,jlev) = (zff(jlev) * zdtns(jlat)) / CT
<a name="l02002"></a>02002          <span class="keyword">enddo</span>
<a name="l02003"></a>02003       <span class="keyword">enddo</span>
<a name="l02004"></a>02004 
<a name="l02005"></a>02005       <span class="keyword">do</span> jlev = 1 , nlev
<a name="l02006"></a>02006          gtc(:,:,jlev) = t0k(jlev) + CT * zgr1(:,:,jlev)
<a name="l02007"></a>02007          gtv(:,:,jlev) =             CT * zgr2(:,:,jlev)
<a name="l02008"></a>02008       <span class="keyword">enddo</span>
<a name="l02009"></a>02009 
<a name="l02010"></a>02010 <span class="comment">!     ---------- test output to control T_r field ----------</span>
<a name="l02011"></a>02011       <span class="keyword">open</span>(112,file=<span class="stringliteral">&#39;tr_test.srv&#39;</span>,form=<span class="stringliteral">&#39;unformatted&#39;</span>)
<a name="l02012"></a>02012       <span class="keyword">do</span> jlev=1,nlev
<a name="l02013"></a>02013          ip = int(sigma(jlev) * PSURF * 1000.)
<a name="l02014"></a>02014          <span class="keyword">write</span>(112) 121, ip, 0000, 00, nlon, nlat, 0, 0
<a name="l02015"></a>02015          <span class="keyword">write</span>(112) t0k(jlev) + (zgr1(:,:,jlev) + zgr2(:,:,jlev)) * CT
<a name="l02016"></a>02016       <span class="keyword">enddo</span>
<a name="l02017"></a>02017       <span class="keyword">close</span>(112)
<a name="l02018"></a>02018 <span class="comment">!     ---------- test output to control T_r field ----------</span>
<a name="l02019"></a>02019 
<a name="l02020"></a>02020       print *,<span class="stringliteral">&#39;**************************************************&#39;</span>
<a name="l02021"></a>02021       print *,<span class="stringliteral">&#39;* Restoration Temperature set up for aqua planet *&#39;</span>
<a name="l02022"></a>02022       print *,<span class="stringliteral">&#39;* including stratosphere and polar vortex        *&#39;</span>
<a name="l02023"></a>02023       print *,<span class="stringliteral">&#39;**************************************************&#39;</span>
<a name="l02024"></a>02024       return
<a name="l02025"></a>02025 <span class="keyword">      end</span>
</pre></div></div>
</div>
  <div id="nav-path" class="navpath">
    <ul>
      <li class="navelem"><a class="el" href="ppp_8f90.html">ppp.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>