<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <meta http-equiv="Content-Type" content="text/xhtml;charset=UTF-8"/> <title>PUMA: /Users/home/WC/puma/src/puma.f90 Source File</title> <link href="tabs.css" rel="stylesheet" type="text/css"/> <link href="doxygen.css" rel="stylesheet" type="text/css" /> <link href="navtree.css" rel="stylesheet" type="text/css"/> <script type="text/javascript" src="jquery.js"></script> <script type="text/javascript" src="resize.js"></script> <script type="text/javascript" src="navtree.js"></script> <script type="text/javascript"> $(document).ready(initResizable); </script> <link href="search/search.css" rel="stylesheet" type="text/css"/> <script type="text/javascript" src="search/search.js"></script> <script type="text/javascript"> $(document).ready(function() { searchBox.OnSelectItem(0); }); </script> </head> <body> <div id="top"><!-- do not remove this div! --> <div id="titlearea"> <table cellspacing="0" cellpadding="0"> <tbody> <tr style="height: 56px;"> <td id="projectlogo"><img alt="Logo" src="puma103.jpg"/></td> <td style="padding-left: 0.5em;"> <div id="projectname">PUMA  <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 Page</span></a></li> <li><a href="annotated.html"><span>Data Types 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 List</span></a></li> <li><a href="globals.html"><span>File Members</span></a></li> </ul> </div> </div> <div id="side-nav" class="ui-resizable side-nav-resizable"> <div id="nav-tree"> <div id="nav-tree-contents"> </div> </div> <div id="splitbar" style="-moz-user-select:none;" class="ui-resizable-handle"> </div> </div> <script type="text/javascript"> initNavTree('puma_8f90.html',''); </script> <div id="doc-content"> <div class="header"> <div class="headertitle"> <div class="title">/Users/home/WC/puma/src/puma.f90</div> </div> </div> <div class="contents"> <a href="puma_8f90.html">Go to the documentation of this file.</a><div class="fragment"><pre class="fragment"><a name="l00001"></a>00001 <span class="keyword">module</span> <a class="code" href="classpumamod.html">pumamod</a> <a name="l00002"></a>00002 <a name="l00003"></a>00003 <span class="comment">!*********************************************!</span> <a name="l00004"></a>00004 <span class="comment">! Portable University Model of the Atmosphere !</span> <a name="l00005"></a>00005 <span class="comment">!*********************************************!</span> <a name="l00006"></a>00006 <span class="comment">! Version: 17.0 16-Feb-2011 !</span> <a name="l00007"></a>00007 <span class="comment">!*********************************************!</span> <a name="l00008"></a>00008 <span class="comment">! Klaus Fraedrich !</span> <a name="l00009"></a>00009 <span class="comment">! Frank Lunkeit - Edilbert Kirk !</span> <a name="l00010"></a>00010 <span class="comment">! Frank Sielmann - Torben Kunz !</span> <a name="l00011"></a>00011 <span class="comment">! Hartmut Borth !</span> <a name="l00012"></a>00012 <span class="comment">!*********************************************!</span> <a name="l00013"></a>00013 <span class="comment">! Meteorologisches Institut !</span> <a name="l00014"></a>00014 <span class="comment">! KlimaCampus - Universitaet Hamburg !</span> <a name="l00015"></a>00015 <span class="comment">!*********************************************!</span> <a name="l00016"></a>00016 <span class="comment">! http://www.mi.uni-hamburg.de/puma !</span> <a name="l00017"></a>00017 <span class="comment">!*********************************************!</span> <a name="l00018"></a>00018 <a name="l00019"></a>00019 <span class="comment">!**************************************************************!</span> <a name="l00020"></a>00020 <span class="comment">! The number of processes for processing on parallel machines !</span> <a name="l00021"></a>00021 <span class="comment">! NLAT/2 must be dividable by <npro>. npro can be set by the !</span> <a name="l00022"></a>00022 <span class="comment">! option -n <npro> when calling the puma executable !</span> <a name="l00023"></a>00023 <span class="comment">! This option is only available if the code is compiled with !</span> <a name="l00024"></a>00024 <span class="comment">! an mpi compiler. !</span> <a name="l00025"></a>00025 <span class="comment">!**************************************************************!</span> <a name="l00026"></a><a class="code" href="classpumamod.html#ae915be5ffac65dd8af555f2d75153398">00026</a> <span class="keywordtype">integer</span> :: npro = 1 <a name="l00027"></a>00027 <a name="l00028"></a>00028 <span class="comment">!**************************************************************!</span> <a name="l00029"></a>00029 <span class="comment">! The horizontal resolution of PUMA is set by defining the !</span> <a name="l00030"></a>00030 <span class="comment">! number of latitudes <nlev> with the 1st. command line !</span> <a name="l00031"></a>00031 <span class="comment">! parameter and the number of levels with the 2nd. command !</span> <a name="l00032"></a>00032 <span class="comment">! parameter. A typical call for T42 is: !</span> <a name="l00033"></a>00033 <span class="comment">! puma.x 64 10 !</span> <a name="l00034"></a>00034 <span class="comment">! which sets nlat=64 and nlev=10 !</span> <a name="l00035"></a>00035 <span class="comment">!**************************************************************!</span> <a name="l00036"></a>00036 <span class="keywordtype">integer</span> :: nlat = 32 <a name="l00037"></a>00037 <a name="l00038"></a>00038 <span class="comment">!example values: 32, 48, 64, 128, 192, 256, 512, 1024</span> <a name="l00039"></a>00039 <span class="comment">!truncation: T21, T31, T42, T85, T127, T170, T341, T682</span> <a name="l00040"></a>00040 <a name="l00041"></a>00041 <span class="keywordtype">integer</span> :: nlev = 10 <a name="l00042"></a>00042 <a name="l00043"></a>00043 <span class="comment">!*****************************************************!</span> <a name="l00044"></a>00044 <span class="comment">! Grid related paramters, which are computed from the !</span> <a name="l00045"></a>00045 <span class="comment">! command line arguments <nlat> and <nlev> !</span> <a name="l00046"></a>00046 <span class="comment">! Preset values are for T21 (nlat=32) and nlev=10 !</span> <a name="l00047"></a>00047 <span class="comment">! ****************************************************!</span> <a name="l00048"></a>00048 <a name="l00049"></a>00049 <span class="keywordtype">integer</span> :: nlem = 9 <span class="comment">! Levels - 1</span> <a name="l00050"></a>00050 <span class="keywordtype">integer</span> :: nlep = 11 <span class="comment">! Levels + 1</span> <a name="l00051"></a>00051 <span class="keywordtype">integer</span> :: nlsq = 100 <span class="comment">! Levels squared</span> <a name="l00052"></a>00052 <a name="l00053"></a>00053 <span class="keywordtype">integer</span> :: nlon = 64 <span class="comment">! Longitudes = 2 * latitudes</span> <a name="l00054"></a>00054 <span class="keywordtype">integer</span> :: nlah = 16 <span class="comment">! Half of latitudes</span> <a name="l00055"></a>00055 <span class="keywordtype">integer</span> :: ntru = 21 <span class="comment">! (nlon-1) / 3</span> <a name="l00056"></a>00056 <span class="keywordtype">integer</span> :: ntp1 = 22 <span class="comment">! ntru + 1</span> <a name="l00057"></a>00057 <span class="keywordtype">integer</span> :: nzom = 44 <span class="comment">! Number of zonal modes</span> <a name="l00058"></a>00058 <span class="keywordtype">integer</span> :: nrsp = 506 <span class="comment">! (ntru+1) * (ntru+2)</span> <a name="l00059"></a>00059 <span class="keywordtype">integer</span> :: ncsp = 253 <span class="comment">! nrsp / 2</span> <a name="l00060"></a>00060 <span class="keywordtype">integer</span> :: nspp = 506 <span class="comment">! nodes per process</span> <a name="l00061"></a>00061 <span class="keywordtype">integer</span> :: nesp = 506 <span class="comment">! number of extended modes</span> <a name="l00062"></a>00062 <a name="l00063"></a>00063 <span class="keywordtype">integer</span> :: nlpp = 32 <span class="comment">! Latitudes per process</span> <a name="l00064"></a>00064 <span class="keywordtype">integer</span> :: nhpp = 16 <span class="comment">! Half latitudes per process</span> <a name="l00065"></a>00065 <span class="keywordtype">integer</span> :: nhor = 2048 <span class="comment">! Horizontal part</span> <a name="l00066"></a><a class="code" href="classpumamod.html#aa9e811d28ba93c3dadb44bc26ae09600">00066</a> <span class="keywordtype">integer</span> :: nugp = 2048 <span class="comment">! Horizontal total</span> <a name="l00067"></a><a class="code" href="classpumamod.html#ac20b6aa2c443341280ab5e4ddc9bebd7">00067</a> <span class="keywordtype">integer</span> :: npgp = 1024 <span class="comment">! Horizontal total packed words</span> <a name="l00068"></a>00068 <a name="l00069"></a><a class="code" href="classpumamod.html#ab963b44aa3f4546a551dd941e4e322c8">00069</a> <span class="keywordtype">integer</span> :: nud = 6 <span class="comment">! I/O unit for diagnostic output</span> <a name="l00070"></a>00070 <a name="l00071"></a>00071 <span class="comment">!***********!</span> <a name="l00072"></a>00072 <span class="comment">! filenames !</span> <a name="l00073"></a>00073 <span class="comment">!***********!</span> <a name="l00074"></a><a class="code" href="classpumamod.html#a71c27dcf11504a05aa050a3ee4d436d1">00074</a> <span class="keywordtype">character (256)</span> :: puma_namelist = <span class="stringliteral">"puma_namelist"</span> <a name="l00075"></a><a class="code" href="classpumamod.html#a047f25dcb732cdf09b1f74fd3115126a">00075</a> <span class="keywordtype">character (256)</span> :: puma_output = <span class="stringliteral">"puma_output"</span> <a name="l00076"></a><a class="code" href="classpumamod.html#ad11e2fd3e6aa83543bbc8acd0c59b7a0">00076</a> <span class="keywordtype">character (256)</span> :: puma_diag = <span class="stringliteral">"puma_diag"</span> <a name="l00077"></a><a class="code" href="classpumamod.html#a98f71e6dad074de1b2cb0fd1c5e531c3">00077</a> <span class="keywordtype">character (256)</span> :: puma_restart = <span class="stringliteral">"puma_restart"</span> <a name="l00078"></a><a class="code" href="classpumamod.html#ab188caa1d64091345227ae3bf0e83edd">00078</a> <span class="keywordtype">character (256)</span> :: puma_status = <span class="stringliteral">"puma_status"</span> <a name="l00079"></a><a class="code" href="classpumamod.html#a5f70e9c47b9e4690322963b92bb809de">00079</a> <span class="keywordtype">character (256)</span> :: efficiency_dat = <span class="stringliteral">"efficiency.dat"</span> <a name="l00080"></a><a class="code" href="classpumamod.html#ae6491cb06d104f50f9803d15f195f951">00080</a> <span class="keywordtype">character (256)</span> :: ppp_puma_txt = <span class="stringliteral">"ppp-puma.txt"</span> <a name="l00081"></a><a class="code" href="classpumamod.html#a97179af6f9ebee802a4333f951b0f436">00081</a> <span class="keywordtype">character (256)</span> :: puma_sp_init = <span class="stringliteral">"puma_sp_init"</span> <a name="l00082"></a>00082 <a name="l00083"></a>00083 <span class="comment">! *****************************************************************</span> <a name="l00084"></a>00084 <span class="comment">! * For multiruns the instance number is appended to the filename *</span> <a name="l00085"></a>00085 <span class="comment">! * e.g.: puma_namelist_1 puma_diag_1 etc. for instance # 1 *</span> <a name="l00086"></a>00086 <span class="comment">! *****************************************************************</span> <a name="l00087"></a>00087 <a name="l00088"></a>00088 <span class="comment">! ****************************************************************</span> <a name="l00089"></a>00089 <span class="comment">! * Don't touch the following parameter definitions ! *</span> <a name="l00090"></a>00090 <span class="comment">! ****************************************************************</span> <a name="l00091"></a><a class="code" href="classpumamod.html#a6cfe02b5d7dfcb7850792dcc03ae3a45">00091</a> <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: PUMA = 0 <span class="comment">! Model ID</span> <a name="l00092"></a><a class="code" href="classpumamod.html#a6014a04a0c8a568ae850cff922ec8c36">00092</a> <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: PLASIM = 1 <span class="comment">! Model ID</span> <a name="l00093"></a>00093 <a name="l00094"></a>00094 parameter(NROOT = 0) <span class="comment">! Master node</span> <a name="l00095"></a>00095 <a name="l00096"></a>00096 parameter(PI = 3.141592653589793D0) <span class="comment">! Pi</span> <a name="l00097"></a>00097 parameter(TWOPI = PI + PI) <span class="comment">! 2 Pi</span> <a name="l00098"></a>00098 <a name="l00099"></a>00099 parameter(AKAP_EARTH = 0.286 ) <span class="comment">! Kappa Earth</span> <a name="l00100"></a>00100 parameter(AKAP_MARS = 0.2273) <span class="comment">! Kappa Mars</span> <a name="l00101"></a>00101 parameter(ALR_EARTH = 0.0065) <span class="comment">! Lapse rate Earth</span> <a name="l00102"></a>00102 parameter(ALR_MARS = 0.0025) <span class="comment">! Lapse rate Mars</span> <a name="l00103"></a>00103 parameter(GA_EARTH = 9.81) <span class="comment">! Gravity Earth</span> <a name="l00104"></a>00104 parameter(GA_MARS = 3.74) <span class="comment">! Gravity Mars</span> <a name="l00105"></a>00105 parameter(GASCON_EARTH = 287.0) <span class="comment">! Gas constant for dry air on Earth</span> <a name="l00106"></a>00106 parameter(GASCON_MARS = 188.9) <span class="comment">! Gas constant for dry air on Mars </span> <a name="l00107"></a>00107 parameter(PSURF_EARTH = 101100.0) <span class="comment">! Mean Surface pressure [Pa] on Earth</span> <a name="l00108"></a>00108 <span class="comment">! Trenberth 1981, J. Geoph. Res., Vol.86, 5238-5246</span> <a name="l00109"></a>00109 parameter(PLARAD_EARTH = 6371000.0) <span class="comment">! Earth radius</span> <a name="l00110"></a>00110 parameter(PLARAD_MARS = 3397000.0) <span class="comment">! Mars radius</span> <a name="l00111"></a>00111 parameter(SID_DAY_EARTH= 86164.) <span class="comment">! Siderial day Earth 23h 56m 04s</span> <a name="l00112"></a>00112 parameter(SID_DAY_MARS = 88642.) <span class="comment">! Siderial day Mars 24h 37m 22s</span> <a name="l00113"></a>00113 <a name="l00114"></a>00114 parameter(WW_EARTH = TWOPI/SID_DAY_EARTH) <span class="comment">! reciprocal of time scale </span> <a name="l00115"></a>00115 <span class="comment">! on Earth [1/sec]</span> <a name="l00116"></a>00116 parameter(WW_MARS = TWOPI/SID_DAY_MARS) <span class="comment">! reciprocal of time scale</span> <a name="l00117"></a>00117 <span class="comment">! on Mars [1/sec]</span> <a name="l00118"></a>00118 <a name="l00119"></a>00119 parameter(CV_EARTH = PLARAD_EARTH * WW_EARTH) <span class="comment">! Velocity scale on Earth [m/s]</span> <a name="l00120"></a>00120 parameter(CV_MARS = PLARAD_MARS * WW_MARS) <span class="comment">! Velocity scale on Mars [m/s]</span> <a name="l00121"></a>00121 <a name="l00122"></a>00122 parameter(CT_EARTH = CV_EARTH*CV_EARTH/GASCON_EARTH) <span class="comment">!Temperature scale [K] </span> <a name="l00123"></a>00123 <span class="comment">! on Earth </span> <a name="l00124"></a>00124 parameter(CT_MARS = CV_MARS*CV_MARS/GASCON_MARS) <span class="comment">!Temperature scale [K] </span> <a name="l00125"></a>00125 <span class="comment">! on Mars </span> <a name="l00126"></a>00126 <a name="l00127"></a>00127 parameter(PNU = 0.02) <span class="comment">! Time filter</span> <a name="l00128"></a>00128 parameter(PNU21 = 1.0 - 2.0*PNU) <span class="comment">! Time filter 2</span> <a name="l00129"></a>00129 <a name="l00130"></a>00130 <span class="comment">! *****************************************************************</span> <a name="l00131"></a>00131 <span class="comment">! * EZ: Factor to multiply the spherical harmonic Y_(1,0) to get *</span> <a name="l00132"></a>00132 <span class="comment">! * the non-dimensional planetary vorticity 2 sin(phi). In PUMA *</span> <a name="l00133"></a>00133 <span class="comment">! * Y_(1,0) = sqrt(3/2)*sin(phi) (normalization factor 1/sqrt(2)).*</span> <a name="l00134"></a>00134 <span class="comment">! * The time scale must be given by Tscale = 1/Omega * </span> <a name="l00135"></a>00135 <span class="comment">! *****************************************************************</span> <a name="l00136"></a>00136 parameter(EZ = 1.632993161855452D0) <span class="comment">! ez = 1 / sqrt(3/8)</span> <a name="l00137"></a>00137 <a name="l00138"></a>00138 <a name="l00139"></a>00139 <span class="comment">! **************************************************************</span> <a name="l00140"></a>00140 <span class="comment">! * Planetary parameters & Scales *</span> <a name="l00141"></a>00141 <span class="comment">! * ----------------------------- *</span> <a name="l00142"></a>00142 <span class="comment">! * The Puma model is formulated in non-dimensional form with * </span> <a name="l00143"></a>00143 <span class="comment">! * the planetary radius as length scale and the reciprocal of * </span> <a name="l00144"></a>00144 <span class="comment">! * the planetary rotation rate as time scale. The temperature * </span> <a name="l00145"></a>00145 <span class="comment">! * scale is given by the geopotential scale divided by the * </span> <a name="l00146"></a>00146 <span class="comment">! * gas constant. * </span> <a name="l00147"></a>00147 <span class="comment">! * For the time scale the length of the siderial day is used *</span> <a name="l00148"></a>00148 <span class="comment">! * as basic unit *</span> <a name="l00149"></a>00149 <span class="comment">! * The parameters are initialized for Earth settings. They *</span> <a name="l00150"></a>00150 <span class="comment">! * may be modified by the namelist file <puma_namelist> *</span> <a name="l00151"></a>00151 <span class="comment">! * *</span> <a name="l00152"></a>00152 <span class="comment">! * The scales are derived internal quantities *</span> <a name="l00153"></a>00153 <span class="comment">! **************************************************************</span> <a name="l00154"></a>00154 <span class="keywordtype">real</span> :: sid_day = SID_DAY_EARTH <span class="comment">! Length of sideral day [sec] on Earth</span> <a name="l00155"></a><a class="code" href="classpumamod.html#a0c307462fbf87e3081b2a385e18d2aed">00155</a> <span class="keywordtype">real</span> :: plarad = PLARAD_EARTH <span class="comment">! Planetary radius [m] on Earth</span> <a name="l00156"></a><a class="code" href="classpumamod.html#ae3f731196cc45fe58378593cedcbb674">00156</a> <span class="keywordtype">real</span> :: gascon = GASCON_EARTH <span class="comment">! Dry air gas consant [J/K kg] on Earth </span> <a name="l00157"></a><a class="code" href="classpumamod.html#a3d53197ec6d14527904d37910baf20ba">00157</a> <span class="keywordtype">real</span> :: akap = AKAP_EARTH <span class="comment">! Kappa [] on Earth</span> <a name="l00158"></a><a class="code" href="classpumamod.html#a16fd3c35a535517745304e4e978dad36">00158</a> <span class="keywordtype">real</span> :: alr = ALR_EARTH <span class="comment">! average lapse rate [K/km] on Earth</span> <a name="l00159"></a><a class="code" href="classpumamod.html#afab1546c76a48d45df0296c921674b29">00159</a> <span class="keywordtype">real</span> :: ga = GA_EARTH <span class="comment">! Gravity [m/sec*sec] on Earth</span> <a name="l00160"></a><a class="code" href="classpumamod.html#aecc1e882fcb2823bd6f2bc1448c1953d">00160</a> <span class="keywordtype">real</span> :: psurf = PSURF_EARTH <span class="comment">! Mean surface pressure for EARTH [Pa] </span> <a name="l00161"></a>00161 <a name="l00162"></a><a class="code" href="classpumamod.html#ac1247b3015d439d0c9f1b6b7ff94722b">00162</a> <span class="keywordtype">real</span> :: ww = WW_EARTH <span class="comment">! reciprocal of time scale [1/sec] (Omega)</span> <a name="l00163"></a><a class="code" href="classpumamod.html#a565ac5e5bafeaa6e81c64ce72e63ccf1">00163</a> <span class="keywordtype">real</span> :: cv = CV_EARTH <span class="comment">! velocity scale [m/sec] on Earth</span> <a name="l00164"></a><a class="code" href="classpumamod.html#a7a6d067e0dfb359595d82114a0362ff2">00164</a> <span class="keywordtype">real</span> :: ct = CT_EARTH <span class="comment">! temperature scale [K] on Earth </span> <a name="l00165"></a>00165 <a name="l00166"></a>00166 <span class="comment">! **************************</span> <a name="l00167"></a>00167 <span class="comment">! * Global Integer Scalars *</span> <a name="l00168"></a>00168 <span class="comment">! **************************</span> <a name="l00169"></a>00169 <a name="l00170"></a><a class="code" href="classpumamod.html#ac3cfb3fcdded6ec157594b899e3ea6f8">00170</a> <span class="keywordtype">logical</span> :: lrestart = .false. <span class="comment">! Existing "puma_restart" sets to .true.</span> <a name="l00171"></a><a class="code" href="classpumamod.html#aea52fae2a0b29f7669124cb727b07a5f">00171</a> <span class="keywordtype">logical</span> :: lselect = .false. <span class="comment">! true: disable some zonal waves</span> <a name="l00172"></a><a class="code" href="classpumamod.html#ae1611527d39b509b932ec189dd6885c3">00172</a> <span class="keywordtype">logical</span> :: lspecsel = .false. <span class="comment">! true: disable some spectral modes</span> <a name="l00173"></a>00173 <a name="l00174"></a><a class="code" href="classpumamod.html#a7b22b37e933bb9e2b91022f17891b322">00174</a> <span class="keywordtype">integer</span> :: model = PUMA <a name="l00175"></a>00175 <a name="l00176"></a>00176 <span class="keywordtype">integer</span> :: kick = 1 <span class="comment">! kick > 0 initializes eddy generation</span> <a name="l00177"></a>00177 <span class="keywordtype">integer</span> :: nafter = 0 <span class="comment">! write data interval 0: controlled by nwpd</span> <a name="l00178"></a>00178 <span class="keywordtype">integer</span> :: nwpd = 1 <span class="comment">! number of writes per day</span> <a name="l00179"></a>00179 <span class="keywordtype">integer</span> :: ncoeff = 0 <span class="comment">! number of modes to print</span> <a name="l00180"></a>00180 <span class="keywordtype">integer</span> :: ndel = 6 <span class="comment">! ndel</span> <a name="l00181"></a>00181 <span class="keywordtype">integer</span> :: ndiag = 12 <span class="comment">! write diagnostics interval</span> <a name="l00182"></a>00182 <span class="keywordtype">integer</span> :: ngui = 0 <span class="comment">! activate Graphical User Interface</span> <a name="l00183"></a>00183 <span class="keywordtype">integer</span> :: nkits = 3 <span class="comment">! number of initial timesteps</span> <a name="l00184"></a>00184 <span class="keywordtype">integer</span> :: nlevt = 9 <span class="comment">! tropospheric levels (set_vertical_grid)</span> <a name="l00185"></a>00185 <span class="keywordtype">integer</span> :: noutput = 1 <span class="comment">! global switch for output on (1) or off (0)</span> <a name="l00186"></a><a class="code" href="classpumamod.html#ae565fd4c9d0d1e8f563b457690df60e1">00186</a> <span class="keywordtype">integer</span> :: nwspini = 1 <span class="comment">! write sp_init after initialization</span> <a name="l00187"></a>00187 <span class="keywordtype">integer</span> :: nrun = 0 <span class="comment">! if (nstop == 0) nstop = nstep + nrun</span> <a name="l00188"></a><a class="code" href="classpumamod.html#a44f4e89edb1112fb56a0acd8fe2de68c">00188</a> <span class="keywordtype">integer</span> :: nstep1 = 0 <span class="comment">! start step (for cpu statistics)</span> <a name="l00189"></a>00189 <span class="keywordtype">integer</span> :: nstep = -1 <span class="comment">! current timestep step 0: 01-Jan-0001 00:00</span> <a name="l00190"></a>00190 <span class="keywordtype">integer</span> :: nstop = 0 <span class="comment">! finishing timestep</span> <a name="l00191"></a>00191 <span class="keywordtype">integer</span> :: ntspd = 0 <span class="comment">! number of timesteps per day 0 = auto</span> <a name="l00192"></a>00192 <span class="keywordtype">integer</span> :: mpstep = 0 <span class="comment">! minutes per step 0 = automatic</span> <a name="l00193"></a>00193 <span class="keywordtype">integer</span> :: ncu = 0 <span class="comment">! check unit (debug output)</span> <a name="l00194"></a><a class="code" href="classpumamod.html#aeed68a00c7949544bc4fef6fb12750e7">00194</a> <span class="keywordtype">integer</span> :: nwrioro = 1 <span class="comment">! controls output of orography</span> <a name="l00195"></a><a class="code" href="classpumamod.html#ac8490b47e54184cb4a1cea076d0a30a3">00195</a> <span class="keywordtype">integer</span> :: nextout = 0 <span class="comment">! 1: extended output (entropy production)</span> <a name="l00196"></a><a class="code" href="classpumamod.html#a8f8ac2af640bb3457498cf2ca2cf382a">00196</a> <span class="keywordtype">integer</span> :: nruido = 0 <span class="comment">! 1: global constant, temporal noise</span> <a name="l00197"></a>00197 <span class="comment">! 2: spatio-temporal noise</span> <a name="l00198"></a>00198 <span class="comment">! 3: spatio-temporal equator symmetric</span> <a name="l00199"></a><a class="code" href="classpumamod.html#af9d1e5f558a9b0151f81e27c4ea6c361">00199</a> <span class="keywordtype">integer</span> :: nseedlen = 0 <span class="comment">! length of random seed (set by lib call)</span> <a name="l00200"></a><a class="code" href="classpumamod.html#a5deccef8dbe1e1e9bfb869f67d8a16f1">00200</a> <span class="keywordtype">integer</span> :: nmonths = 0 <span class="comment">! Simulation time (1 month = 30 days)</span> <a name="l00201"></a><a class="code" href="classpumamod.html#a6bebc837456862a7db9c50bcd686e1e6">00201</a> <span class="keywordtype">integer</span> :: nyears = 1 <span class="comment">! simulation time (1 year = 360 days)</span> <a name="l00202"></a>00202 <span class="keywordtype">integer</span> :: nsponge = 0 <span class="comment">! 1: Create sponge layer</span> <a name="l00203"></a>00203 <span class="keywordtype">integer</span> :: nhelsua = 0 <span class="comment">! 1: Set up Held & Suarez T_R field</span> <a name="l00204"></a>00204 <span class="comment">! instead of original PUMA T_R field</span> <a name="l00205"></a>00205 <span class="comment">! 2: Set up Held & Suarez T_R field</span> <a name="l00206"></a>00206 <span class="comment">! instead of original PUMA T_R field</span> <a name="l00207"></a>00207 <span class="comment">! AND use latitudinally varying</span> <a name="l00208"></a>00208 <span class="comment">! heating timescale in PUMA (H&Z(94)),</span> <a name="l00209"></a>00209 <span class="comment">! irrelevant for PumaPreProcessor (ppp)</span> <a name="l00210"></a>00210 <span class="comment">! 3: Use latitudinally varying</span> <a name="l00211"></a>00211 <span class="comment">! heating timescale in PUMA (H&Z(94)),</span> <a name="l00212"></a>00212 <span class="comment">! irrelevant for PumaPreProcessor (ppp)</span> <a name="l00213"></a><a class="code" href="classpumamod.html#a996f9145950ee7b3955819b122de4957">00213</a> <span class="keywordtype">integer</span> :: ndiagp = 0 <span class="comment">! 0/1 switch for grid point diabatic heating </span> <a name="l00214"></a><a class="code" href="classpumamod.html#a4ad70fab2e818be277ec41afde36c5d2">00214</a> <span class="keywordtype">integer</span> :: nconv = 0 <span class="comment">! 0/1 switch for convecive heating</span> <a name="l00215"></a>00215 <span class="keywordtype">integer</span> :: nvg = 0 <span class="comment">! type of vertical grid</span> <a name="l00216"></a>00216 <span class="comment">! 0 = linear</span> <a name="l00217"></a>00217 <span class="comment">! 1 = Scinocca & Haynes</span> <a name="l00218"></a>00218 <span class="comment">! 2 = Polvani & Kushner</span> <a name="l00219"></a><a class="code" href="classpumamod.html#a0423d8412d0d82630764dd724fbe763a">00219</a> <span class="keywordtype">integer</span> :: nenergy = 0 <span class="comment">! energy diagnostics (on/off 1/0)</span> <a name="l00220"></a><a class="code" href="classpumamod.html#a6ebc03f03149556f450c2c2c927189f2">00220</a> <span class="keywordtype">integer</span> :: nentropy= 0 <span class="comment">! entropy diagnostics (on/off 1/0)</span> <a name="l00221"></a><a class="code" href="classpumamod.html#a8e7c1d42543d35f7caba5ebd36dcfd54">00221</a> <span class="keywordtype">integer</span> :: ndheat = 0 <span class="comment">! energy recycling (on/off 1/0)</span> <a name="l00222"></a>00222 <a name="l00223"></a><a class="code" href="classpumamod.html#a5e7e19a6f3a971a303fc7efc2676e5f1">00223</a> <span class="keywordtype">integer</span> :: nradcv = 0 <span class="comment">! use two restoration fields</span> <a name="l00224"></a>00224 <a name="l00225"></a>00225 <a name="l00226"></a>00226 <a name="l00227"></a>00227 <span class="comment">! ***********************</span> <a name="l00228"></a>00228 <span class="comment">! * Global Real Scalars *</span> <a name="l00229"></a>00229 <span class="comment">! ***********************</span> <a name="l00230"></a>00230 <a name="l00231"></a><a class="code" href="classpumamod.html#a976863e22669d1d80cb62a3af35e3d4d">00231</a> <span class="keywordtype">real</span> :: alpha = 1.0 <span class="comment">! Williams filter factor</span> <a name="l00232"></a>00232 <span class="keywordtype">real</span> :: alrs = 0.0 <span class="comment">! stratospheric lapse rate [K/m]</span> <a name="l00233"></a>00233 <span class="keywordtype">real</span> :: delt <span class="comment">! 2 pi / ntspd timestep interval</span> <a name="l00234"></a>00234 <span class="keywordtype">real</span> :: delt2 <span class="comment">! 2 * delt</span> <a name="l00235"></a>00235 <span class="keywordtype">real</span> :: dtep = 60.0 <span class="comment">! delta T equator <-> pole [K]</span> <a name="l00236"></a>00236 <span class="keywordtype">real</span> :: dtns = -70.0 <span class="comment">! delta T north <-> south [K]</span> <a name="l00237"></a>00237 <span class="keywordtype">real</span> :: dtrop = 12000.0 <span class="comment">! Tropopause height [m]</span> <a name="l00238"></a>00238 <span class="keywordtype">real</span> :: dttrp = 2.0 <span class="comment">! Tropopause smoothing [K]</span> <a name="l00239"></a>00239 <span class="keywordtype">real</span> :: dtzz = 10.0 <span class="comment">! delta(Theta)/H additional lapserate in</span> <a name="l00240"></a>00240 <span class="comment">! Held & Suarez T_R field</span> <a name="l00241"></a>00241 <span class="keywordtype">real</span> :: orofac = 1.0 <span class="comment">! factor to scale the orograpy</span> <a name="l00242"></a>00242 <span class="keywordtype">real</span> :: plavor = EZ <span class="comment">! planetary vorticity</span> <a name="l00243"></a><a class="code" href="classpumamod.html#ac68939034981424cca40dd948549d1a0">00243</a> <span class="keywordtype">real</span> :: psmean = PSURF_EARTH <span class="comment">! Mean of Ps on Earth</span> <a name="l00244"></a>00244 <span class="keywordtype">real</span> :: rotspd = 1.0 <span class="comment">! rotation speed 1.0 = normal Earth rotation</span> <a name="l00245"></a>00245 <span class="keywordtype">real</span> :: sigmax = 6.0e-7 <span class="comment">! sigma for top half level</span> <a name="l00246"></a>00246 <span class="keywordtype">real</span> :: tdiss = 0.25 <span class="comment">! diffusion time scale [days]</span> <a name="l00247"></a>00247 <span class="keywordtype">real</span> :: tac = 360.0 <span class="comment">! length of annual cycle [days] (0 = no cycle)</span> <a name="l00248"></a>00248 <span class="keywordtype">real</span> :: pac = 0.0 <span class="comment">! phase of the annual cycle [days]</span> <a name="l00249"></a>00249 <span class="keywordtype">real</span> :: tgr = 288.0 <span class="comment">! Ground Temperature in mean profile [K]</span> <a name="l00250"></a><a class="code" href="classpumamod.html#a529184e9404faf138c07e7f28afee2e1">00250</a> <span class="keywordtype">real</span> :: dvdiff = 0.0 <span class="comment">! vertical diffusion coefficient [m2/s]</span> <a name="l00251"></a>00251 <span class="comment">! ! dvdiff =0. means no vertical diffusion</span> <a name="l00252"></a><a class="code" href="classpumamod.html#a4fc16343d9407e3714e301309177a08a">00252</a> <span class="keywordtype">real</span> :: disp = 0.0 <span class="comment">! noise dispersion</span> <a name="l00253"></a>00253 <span class="keywordtype">real</span> :: tauta = 40.0 <span class="comment">! heating timescale far from surface</span> <a name="l00254"></a>00254 <span class="keywordtype">real</span> :: tauts = 4.0 <span class="comment">! heating timescale close to surface</span> <a name="l00255"></a><a class="code" href="classpumamod.html#a594702993f401d2641f71890a8f9f6f5">00255</a> <span class="keywordtype">real</span> :: pspon = 50. <span class="comment">! apply sponge layer where p < pspon</span> <a name="l00256"></a>00256 <span class="comment">! ! pressure [Pa]</span> <a name="l00257"></a><a class="code" href="classpumamod.html#ad1a6236311cdfb3949ec1b1c262b59ac">00257</a> <span class="keywordtype">real</span> :: sponk = 0.5 <span class="comment">! max. damping coefficient for sponge layer,</span> <a name="l00258"></a>00258 <span class="comment">! ! unit: [1/day]</span> <a name="l00259"></a>00259 <a name="l00260"></a>00260 <span class="comment">! **************************</span> <a name="l00261"></a>00261 <span class="comment">! * Global Spectral Arrays *</span> <a name="l00262"></a>00262 <span class="comment">! **************************</span> <a name="l00263"></a>00263 <a name="l00264"></a><a class="code" href="classpumamod.html#a607c73cd3e6556d8dfa4337bb71bad61">00264</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sd(:,:) <span class="comment">! Spectral Divergence</span> <a name="l00265"></a><a class="code" href="classpumamod.html#a4ec415d0ab8671b481436b79bc708c4d">00265</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdd(:,:) <span class="comment">! Difference between instances</span> <a name="l00266"></a><a class="code" href="classpumamod.html#a9e5f2e6b01b35c141b673be058d6ba52">00266</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: st(:,:) <span class="comment">! Spectral Temperature</span> <a name="l00267"></a><a class="code" href="classpumamod.html#ac4bf8bb0f46d1d2f91f95e10be02a738">00267</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: std(:,:) <span class="comment">! Difference between instances</span> <a name="l00268"></a><a class="code" href="classpumamod.html#aad136f237f5ca5d94b6f0e0e742864df">00268</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: st1(:,:) <span class="comment">! Spectral Temperature at t-1 (for NEXTOUT == 1)</span> <a name="l00269"></a><a class="code" href="classpumamod.html#a69fc3701590281746d17dcb2f80c1c03">00269</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: st2(:,:) <span class="comment">! Spectral Temperature at t-2 (for NEXTOUT == 1)</span> <a name="l00270"></a><a class="code" href="classpumamod.html#a6da929d3d47a0b47afc30657bf43cb74">00270</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sz(:,:) <span class="comment">! Spectral Vorticity</span> <a name="l00271"></a><a class="code" href="classpumamod.html#a2de620590b09238085f6a8c4810c4392">00271</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szd(:,:) <span class="comment">! Difference between instances</span> <a name="l00272"></a><a class="code" href="classpumamod.html#a62dbb101d0fe728fa2231fa3482ee7b1">00272</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sp(:) <span class="comment">! Spectral Pressure (ln Ps)</span> <a name="l00273"></a><a class="code" href="classpumamod.html#a99ec3c13cdd619b700160372a330f531">00273</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spd(:) <span class="comment">! Difference between instances</span> <a name="l00274"></a><a class="code" href="classpumamod.html#a02a75a47225d636193b203a0d7ccc4ee">00274</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sq(:,:) <span class="comment">! For compatibility with PlaSim</span> <a name="l00275"></a><a class="code" href="classpumamod.html#a8509c5063893002e614541f3f546db2f">00275</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sp1(:) <span class="comment">! Spectral Pressure at t-1 (for NEXTOUT == 1)</span> <a name="l00276"></a><a class="code" href="classpumamod.html#ac0a89b4b892f00ce4069b1adc76ac1ad">00276</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sp2(:) <span class="comment">! Spectral Pressure at t-2 (for NEXTOUT == 1)</span> <a name="l00277"></a><a class="code" href="classpumamod.html#ab0c826a52384cc9195a2244e7003cab8">00277</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: so(:) <span class="comment">! Spectral Orography</span> <a name="l00278"></a>00278 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sr1(:,:) <span class="comment">! Spectral Restoration Temperature</span> <a name="l00279"></a>00279 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sr2(:,:) <span class="comment">! Spectral Restoration Temperature</span> <a name="l00280"></a>00280 <a name="l00281"></a><a class="code" href="classpumamod.html#aa56f906a0a8233f5a59a2dd2375d7bfe">00281</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdp(:,:) <span class="comment">! Spectral Divergence Partial</span> <a name="l00282"></a><a class="code" href="classpumamod.html#aad8ec9e8e440a8a077624b05430d1d65">00282</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stp(:,:) <span class="comment">! Spectral Temperature Partial</span> <a name="l00283"></a><a class="code" href="classpumamod.html#a1d691f7ffd430d06377c953ac7b1615a">00283</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szp(:,:) <span class="comment">! Spectral Vorticity Partial</span> <a name="l00284"></a><a class="code" href="classpumamod.html#a8c0d3d0d8eaeee34966b2ed8cdab6880">00284</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spp(:) <span class="comment">! Spectral Pressure Partial</span> <a name="l00285"></a><a class="code" href="classpumamod.html#ad94d9ab7dd97c7f24ccfca4e9c1dcadd">00285</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sop(:) <span class="comment">! Spectral Orography Partial</span> <a name="l00286"></a><a class="code" href="classpumamod.html#a610ade488da8477514d377f4d3113078">00286</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: srp1(:,:)<span class="comment">! Spectral Restoration Partial</span> <a name="l00287"></a><a class="code" href="classpumamod.html#aedc7ade1364d2e510fe5a9e17d2ee551">00287</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: srp2(:,:)<span class="comment">! Spectral Restoration Partial</span> <a name="l00288"></a>00288 <a name="l00289"></a><a class="code" href="classpumamod.html#a6469b0773780c7e85cc8fe80dab7360c">00289</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdt(:,:) <span class="comment">! Spectral Divergence Tendency</span> <a name="l00290"></a><a class="code" href="classpumamod.html#a38a8cfb3cd3b1ccf0fd5b7283e0949be">00290</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stt(:,:) <span class="comment">! Spectral Temperature Tendency</span> <a name="l00291"></a><a class="code" href="classpumamod.html#a9414c9820ee505006ea2ef90a1e4786c">00291</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szt(:,:) <span class="comment">! Spectral Vorticity Tendency</span> <a name="l00292"></a><a class="code" href="classpumamod.html#a86dd88d1dc1d0d21eeb13c11905d7b66">00292</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spt(:) <span class="comment">! Spectral Pressure Tendency</span> <a name="l00293"></a>00293 <a name="l00294"></a><a class="code" href="classpumamod.html#a4285b7b3267876729285e16aca07035e">00294</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sdm(:,:) <span class="comment">! Spectral Divergence Minus</span> <a name="l00295"></a><a class="code" href="classpumamod.html#a636c3a27cc6a7aa8f63fd4d322406517">00295</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: stm(:,:) <span class="comment">! Spectral Temperature Minus</span> <a name="l00296"></a><a class="code" href="classpumamod.html#a7961c979cb0a5cb3cfb7cce5a9d16d6b">00296</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: szm(:,:) <span class="comment">! Spectral Vorticity Minus</span> <a name="l00297"></a><a class="code" href="classpumamod.html#a2bc3d91e2e9c16048446dbd12448ed2d">00297</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spm(:) <span class="comment">! Spectral Pressure Minus</span> <a name="l00298"></a>00298 <a name="l00299"></a><a class="code" href="classpumamod.html#ae752a8854b0014c33704f7390b78687d">00299</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sak(:) <span class="comment">! Hyper diffusion</span> <a name="l00300"></a><a class="code" href="classpumamod.html#a98103b850b9c24c95bac646961ae0209">00300</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: srcn(:) <span class="comment">! 1.0 / (n * (n+1))</span> <a name="l00301"></a><a class="code" href="classpumamod.html#aaf3b11d526905c319b065f60804ba566">00301</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: span(:) <span class="comment">! Pressure for diagnostics</span> <a name="l00302"></a>00302 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: spnorm(:)<span class="comment">! Factors for output normalization</span> <a name="l00303"></a>00303 <a name="l00304"></a><a class="code" href="classpumamod.html#a7902698a1673a4c65dd8e7443a7fcc6f">00304</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nindex(:) <span class="comment">! Holds wavenumber</span> <a name="l00305"></a><a class="code" href="classpumamod.html#a8a778542c0d1ac00f0d4ccffe08f7190">00305</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nscatsp(:) <span class="comment">! Used for reduce_scatter op</span> <a name="l00306"></a><a class="code" href="classpumamod.html#a14bc87e591fb027289ef3d9eb40b8a70">00306</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nselzw(:) <span class="comment">! Enable/disable selected zonal waves</span> <a name="l00307"></a><a class="code" href="classpumamod.html#a4f4aaa4c774bb1500caa0de7ca16bbe8">00307</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: nselsp(:) <span class="comment">! Enable/disable slected spectral modes</span> <a name="l00308"></a>00308 <a name="l00309"></a>00309 <span class="comment">! ***************************</span> <a name="l00310"></a>00310 <span class="comment">! * Global Gridpoint Arrays *</span> <a name="l00311"></a>00311 <span class="comment">! ***************************</span> <a name="l00312"></a>00312 <a name="l00313"></a><a class="code" href="classpumamod.html#a50103ebf2d2ba2366f2eca07abaabeb4">00313</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gd(:,:) <span class="comment">! Divergence</span> <a name="l00314"></a><a class="code" href="classpumamod.html#a3001f3699640a16cd7f91c6aa528af16">00314</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gt(:,:) <span class="comment">! Temperature</span> <a name="l00315"></a><a class="code" href="classpumamod.html#af24b389b45d2a20b68ea5bfc7cc48d17">00315</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gz(:,:) <span class="comment">! Vorticity</span> <a name="l00316"></a><a class="code" href="classpumamod.html#aaed48b35d778e5c3095fcd1083bbe804">00316</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gu(:,:) <span class="comment">! u * cos(phi)</span> <a name="l00317"></a><a class="code" href="classpumamod.html#a88b0140b2435578aa69cb4ac9781b91c">00317</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gv(:,:) <span class="comment">! v * sin(phi)</span> <a name="l00318"></a><a class="code" href="classpumamod.html#a6626db807402c61328ae36fddbeec5f1">00318</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gp(:) <span class="comment">! Ln(Ps)</span> <a name="l00319"></a><a class="code" href="classpumamod.html#a562c8285b90afd93ee2add1099a55e0f">00319</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gq(:,:) <span class="comment">! For compatibilty with PlaSim</span> <a name="l00320"></a><a class="code" href="classpumamod.html#aee702bf92e2a4578e4ff0adbdafcaadb">00320</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gfu(:,:) <span class="comment">! Term Fu in Primitive Equations</span> <a name="l00321"></a><a class="code" href="classpumamod.html#a3398d85c059c2cbe3948907b12a9058e">00321</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gfv(:,:) <span class="comment">! Term Fv in Primitive Equations</span> <a name="l00322"></a><a class="code" href="classpumamod.html#a54c30e8bd1e5b308c4111eaac995f578">00322</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gut(:,:) <span class="comment">! Term u * T</span> <a name="l00323"></a><a class="code" href="classpumamod.html#a1b9d24404ad1e089ee401e7c00ec79f0">00323</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gvt(:,:) <span class="comment">! Term v * T</span> <a name="l00324"></a><a class="code" href="classpumamod.html#a9c3f9d77d6c9acc5e900cb8fce8f8ac3">00324</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gke(:,:) <span class="comment">! Kinetic energy u * u + v * v</span> <a name="l00325"></a><a class="code" href="classpumamod.html#add5a9e2d129fa1c8bfe199f84263c9f7">00325</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gpj(:) <span class="comment">! d(Ln(Ps)) / d(mu)</span> <a name="l00326"></a><a class="code" href="classpumamod.html#a1102b7714ee109056cd4b64bb9ba96e4">00326</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: rcsq(:) <span class="comment">! 1 / cos2(phi)</span> <a name="l00327"></a><a class="code" href="classpumamod.html#a631f8bc1450b1c083f26a35cab8d87cc">00327</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: ruido(:,:,:)<span class="comment">! noise (nlon,nlat,nlev)</span> <a name="l00328"></a><a class="code" href="classpumamod.html#a839f7aa31c37072113405a43e334292e">00328</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: ruidop(:,:) <span class="comment">! noise partial (nhor,nlev)</span> <a name="l00329"></a><a class="code" href="classpumamod.html#a697a2f43424ec02c33ad0e069f60edd2">00329</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtdamp(:,:) <span class="comment">! 3D reciprocal damping times [1/sec] </span> <a name="l00330"></a>00330 <span class="comment">! for relaxation in grid point space </span> <a name="l00331"></a>00331 <span class="comment">! for radiative restoration temperature </span> <a name="l00332"></a>00332 <span class="comment">! (e.g. for Held&Suarez)</span> <a name="l00333"></a><a class="code" href="classpumamod.html#a550fb7dbedcb399eeee029f09e0261c7">00333</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr1(:,:) <span class="comment">! constant radiative restoration time scale</span> <a name="l00334"></a><a class="code" href="classpumamod.html#acb504294dc512bdee020e63fcc43c51c">00334</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr2(:,:) <span class="comment">! variable radiative restoration time scale</span> <a name="l00335"></a><a class="code" href="classpumamod.html#ab154b81faaea8224202d205d5377ecb5">00335</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gtdampc(:,:)<span class="comment">! the same as gtdamp, but for convective </span> <a name="l00336"></a>00336 <span class="comment">! restoration temperature</span> <a name="l00337"></a><a class="code" href="classpumamod.html#a3ad097353e5e4017c75dd08d77f374f3">00337</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr1c(:,:) <span class="comment">! constant convective restoration time scale</span> <a name="l00338"></a><a class="code" href="classpumamod.html#a0063c8f28d68f19195b2154874bb4605">00338</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: gr2c(:,:) <span class="comment">! variable convective restoration time scale</span> <a name="l00339"></a>00339 <a name="l00340"></a>00340 <span class="comment">! *********************</span> <a name="l00341"></a>00341 <span class="comment">! * Diagnostic Arrays *</span> <a name="l00342"></a>00342 <span class="comment">! *********************</span> <a name="l00343"></a>00343 <a name="l00344"></a><a class="code" href="classpumamod.html#a8cd6f320c3166f241ade820dc3eadb39">00344</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: ndil(:) <span class="comment">! Set diagnostics level</span> <a name="l00345"></a>00345 <a name="l00346"></a><a class="code" href="classpumamod.html#a9dbdc63a5f305db50a26a47cc34d00c7">00346</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: csu(:,:) <span class="comment">! Cross section u [m/s]</span> <a name="l00347"></a><a class="code" href="classpumamod.html#a3ab8cd6714b1bbb4233200b9acba2904">00347</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: csv(:,:) <span class="comment">! Cross section v [m/s]</span> <a name="l00348"></a><a class="code" href="classpumamod.html#aec021878423837a34bb3de710083412f">00348</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: cst(:,:) <span class="comment">! Cross section T [Celsius]</span> <a name="l00349"></a>00349 <a name="l00350"></a><a class="code" href="classpumamod.html#aeea321b5684fff3240d0367b970bde23">00350</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: denergy(:,:) <span class="comment">! energy diagnostics</span> <a name="l00351"></a><a class="code" href="classpumamod.html#a22d2a10d8b9f03d90130b1ccef2ec7c9">00351</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: dentropy(:,:) <span class="comment">! entropy diagnostics</span> <a name="l00352"></a>00352 <a name="l00353"></a>00353 <span class="comment">! *******************</span> <a name="l00354"></a>00354 <span class="comment">! * Latitude Arrays *</span> <a name="l00355"></a>00355 <span class="comment">! *******************</span> <a name="l00356"></a>00356 <a name="l00357"></a>00357 <span class="keywordtype">character (3)</span>,<span class="keywordtype">allocatable</span> :: chlat(:) <span class="comment">! label for latitudes</span> <a name="l00358"></a>00358 <span class="keywordtype">real (kind=8)</span>,<span class="keywordtype">allocatable</span> :: sid(:) <span class="comment">! sin(phi)</span> <a name="l00359"></a>00359 <span class="keywordtype">real (kind=8)</span>,<span class="keywordtype">allocatable</span> :: gwd(:) <span class="comment">! Gaussian weight (phi)</span> <a name="l00360"></a><a class="code" href="classpumamod.html#a4577fee5af720d3d5cee446b6bd36d0c">00360</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: csq(:) <span class="comment">! cos2(phi)</span> <a name="l00361"></a><a class="code" href="classpumamod.html#a121f56c4792fab7bbc57da6a356ba13f">00361</a> <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: rcs(:) <span class="comment">! 1/cos(phi)</span> <a name="l00362"></a>00362 <a name="l00363"></a>00363 <span class="comment">! ****************</span> <a name="l00364"></a>00364 <span class="comment">! * Level Arrays *</span> <a name="l00365"></a>00365 <span class="comment">! ****************</span> <a name="l00366"></a>00366 <a name="l00367"></a><a class="code" href="classpumamod.html#aa0e5d4127d9cbc662e69de401ab0878f">00367</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: t0(:) <span class="comment">! reference temperature</span> <a name="l00368"></a>00368 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: t0d(:) <span class="comment">! vertical t0 gradient</span> <a name="l00369"></a><a class="code" href="classpumamod.html#aa37496e277d03000616cdb2e5b22d7c0">00369</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: taur(:) <span class="comment">! tau R [days]</span> <a name="l00370"></a><a class="code" href="classpumamod.html#aaddf02e0bb890f2c703effae4cf26a68">00370</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: tauf(:) <span class="comment">! tau F [days]</span> <a name="l00371"></a><a class="code" href="classpumamod.html#a4c165b031088a68ae36d654a5763aef8">00371</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: damp(:) <span class="comment">! 1.0 / (2 Pi * taur)</span> <a name="l00372"></a><a class="code" href="classpumamod.html#a859085f4ee94ade9cc560157a833370e">00372</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: fric(:) <span class="comment">! 1.0 / (2 Pi * tauf )</span> <a name="l00373"></a>00373 <a name="l00374"></a><a class="code" href="classpumamod.html#abc2d5c00d5e5856e8cbc8ed5bee74d11">00374</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: bm1(:,:,:) <a name="l00375"></a>00375 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: dsigma(:) <a name="l00376"></a>00376 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: rdsig(:) <a name="l00377"></a>00377 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sigma(:) <span class="comment">! full level sigma</span> <a name="l00378"></a><a class="code" href="classpumamod.html#aef4b93fe13f4ff77ca4ad9b9b5245918">00378</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: sigmh(:) <span class="comment">! half level sigma</span> <a name="l00379"></a>00379 <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: tkp(:) <a name="l00380"></a><a class="code" href="classpumamod.html#a273a105c71e26860f1f83ca28020bbda">00380</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: c(:,:) <a name="l00381"></a><a class="code" href="classpumamod.html#a0d93d94e3ecf78ee4c82020b9e1ee95f">00381</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: xlphi(:,:) <span class="comment">! matrix Lphi (g)</span> <a name="l00382"></a><a class="code" href="classpumamod.html#a2f42df0a3ac789b2cb6e996a00f16fb4">00382</a> <span class="keywordtype">real</span>, <span class="keywordtype">allocatable</span> :: xlt(:,:) <span class="comment">! matrix LT (tau)</span> <a name="l00383"></a>00383 <a name="l00384"></a>00384 <span class="comment">! ******************</span> <a name="l00385"></a>00385 <span class="comment">! * Parallel Stuff *</span> <a name="l00386"></a>00386 <span class="comment">! ******************</span> <a name="l00387"></a>00387 <a name="l00388"></a><a class="code" href="classpumamod.html#af617e09ab068329347fe45e390e46923">00388</a> <span class="keywordtype">integer</span> :: myworld = 0 <span class="comment">! MPI variable</span> <a name="l00389"></a><a class="code" href="classpumamod.html#a34212fc920287542d5b665298e229090">00389</a> <span class="keywordtype">integer</span> :: mpinfo = 0 <span class="comment">! MPI variable</span> <a name="l00390"></a><a class="code" href="classpumamod.html#abe37e4023fe000a8d7a8f39be8dd8354">00390</a> <span class="keywordtype">integer</span> :: mypid = 0 <span class="comment">! My Process Id</span> <a name="l00391"></a><a class="code" href="classpumamod.html#ab552a94bc8d5d3e4a56303ac4249b894">00391</a> <span class="keywordtype">real</span> :: tmstart = 0.0 <span class="comment">! CPU time at start</span> <a name="l00392"></a><a class="code" href="classpumamod.html#a6b2cc93bbb820f9aa438282188e75eef">00392</a> <span class="keywordtype">real</span> :: tmstop = 0.0 <span class="comment">! CPU time at stop</span> <a name="l00393"></a><a class="code" href="classpumamod.html#a0961a19034b2c5becab0fe77c8e767b6">00393</a> <span class="keywordtype">character(80)</span>, <span class="keywordtype">allocatable</span> :: ympname(:) <span class="comment">! Processor name</span> <a name="l00394"></a>00394 <a name="l00395"></a>00395 <a name="l00396"></a>00396 <span class="comment">! **********************</span> <a name="l00397"></a>00397 <span class="comment">! * Multirun variables *</span> <a name="l00398"></a>00398 <span class="comment">! **********************</span> <a name="l00399"></a>00399 <a name="l00400"></a><a class="code" href="classpumamod.html#afdffea792867b992f5d1d117bea912e9">00400</a> <span class="keywordtype">integer</span> :: mrworld = 0 <span class="comment">! MPI communication</span> <a name="l00401"></a><a class="code" href="classpumamod.html#a52d0e34b3a5be19fc3b8d0f11cae3cd2">00401</a> <span class="keywordtype">integer</span> :: mrinfo = 0 <span class="comment">! MPI info</span> <a name="l00402"></a><a class="code" href="classpumamod.html#a7243d78ff49021834f74c4f372747e25">00402</a> <span class="keywordtype">integer</span> :: mrpid = -1 <span class="comment">! MPI instance id</span> <a name="l00403"></a><a class="code" href="classpumamod.html#aca86db6e1c10c1b9517477ce5edbe883">00403</a> <span class="keywordtype">integer</span> :: mrnum = 0 <span class="comment">! MPI number of instances</span> <a name="l00404"></a><a class="code" href="classpumamod.html#af045ac8932ed34ae0d921a49d9696202">00404</a> <span class="keywordtype">integer</span> :: mintru = 0 <span class="comment">! Lowest resolution of all instances</span> <a name="l00405"></a><a class="code" href="classpumamod.html#adefb6afc38014b7c141a67f0036bb9fd">00405</a> <span class="keywordtype">integer</span> :: mrdim = 0 <span class="comment">! Exchange dimension (min. NRSP)</span> <a name="l00406"></a>00406 <span class="keywordtype">integer</span> :: nsync = 0 <span class="comment">! Synchronization on or off</span> <a name="l00407"></a><a class="code" href="classpumamod.html#a6f3661b2cfef35aad460858a54bac179">00407</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: mrtru(:) <span class="comment">! Truncations of members</span> <a name="l00408"></a>00408 <a name="l00409"></a>00409 <span class="keywordtype">real</span> :: syncstr = 0.0 <span class="comment">! Coupling strength (0 .. 1)</span> <a name="l00410"></a><a class="code" href="classpumamod.html#a24c3f399235c4ea5f2d8e1f867f8776d">00410</a> <span class="keywordtype">real</span> :: synctime = 0.0 <span class="comment">! Coupling time [days]</span> <a name="l00411"></a>00411 <a name="l00412"></a>00412 <span class="comment">! ******************************************</span> <a name="l00413"></a>00413 <span class="comment">! * GUI (Graphical User Interface for X11) *</span> <a name="l00414"></a>00414 <span class="comment">! ******************************************</span> <a name="l00415"></a>00415 <a name="l00416"></a>00416 parameter (NPARCS = 10) <span class="comment">! Number of GUI parameters</span> <a name="l00417"></a>00417 <span class="keywordtype">integer</span> :: nguidbg = 0 <span class="comment">! Flag for GUI debug output</span> <a name="l00418"></a><a class="code" href="classpumamod.html#a55d8354fd0488524eb882076f145db4c">00418</a> <span class="keywordtype">integer</span> :: nshutdown = 0 <span class="comment">! Flag for shutdown request</span> <a name="l00419"></a><a class="code" href="classpumamod.html#ae562873ebeeb138df379c847e7e01ee4">00419</a> <span class="keywordtype">integer</span> :: ndatim(6) = -1 <span class="comment">! Date & time array</span> <a name="l00420"></a><a class="code" href="classpumamod.html#ae2c4727393fa343e9b1bc8a3c74aaadc">00420</a> <span class="keywordtype">real(kind=4)</span> :: parc(NPARCS) <span class="comment">! Values of GUI parameters</span> <a name="l00421"></a><a class="code" href="classpumamod.html#ade587d2c84caf94c7f54e8d358d42455">00421</a> <span class="keywordtype">real(kind=4)</span> :: crap(NPARCS) <span class="comment">! Backup of parc(NPARCS)</span> <a name="l00422"></a><a class="code" href="classpumamod.html#ad6ef8c9bbafbe30d455ecbedd0091142">00422</a> <span class="keywordtype">logical</span> :: ldtep = .FALSE. <span class="comment">! DTEP changed by GUI</span> <a name="l00423"></a><a class="code" href="classpumamod.html#ad987421134978995be7290187c82fda2">00423</a> <span class="keywordtype">logical</span> :: ldtns = .FALSE. <span class="comment">! DTNS changed by GUI</span> <a name="l00424"></a><a class="code" href="classpumamod.html#a903a55d5d849abb77aa4ccb8534add13">00424</a> <span class="keywordtype">character(len=32)</span> :: yplanet = <span class="stringliteral">"Earth"</span> <a name="l00425"></a>00425 <a name="l00426"></a>00426 <span class="comment">! ***************</span> <a name="l00427"></a>00427 <span class="comment">! * Random seed *</span> <a name="l00428"></a>00428 <span class="comment">! ***************</span> <a name="l00429"></a>00429 <a name="l00430"></a><a class="code" href="classpumamod.html#a79c75848ef94fd2ff5e362ea59c98cbe">00430</a> <span class="keywordtype">integer</span> :: seed(8) = 0 <span class="comment">! settable in namelist</span> <a name="l00431"></a><a class="code" href="classpumamod.html#a1909f4521ecd22aa8e00db6e17c10ad9">00431</a> <span class="keywordtype">integer</span>, <span class="keywordtype">allocatable</span> :: meed(:) <span class="comment">! machine dependent seed</span> <a name="l00432"></a><a class="code" href="classpumamod.html#a936da81a07a9bfa83bea326d29f5a5d9">00432</a> <span class="keywordtype">real</span> :: ganext = 0.0<span class="comment">! y part of gaussian noise</span> <a name="l00433"></a>00433 <a name="l00434"></a>00434 <span class="keyword">end module pumamod</span> <a name="l00435"></a>00435 <a name="l00436"></a>00436 <span class="comment">!***************!</span> <a name="l00437"></a>00437 <span class="comment">! MODULE RADMOD !</span> <a name="l00438"></a>00438 <span class="comment">!***************!</span> <a name="l00439"></a>00439 <a name="l00440"></a><a class="code" href="classradmod.html">00440</a> <span class="keyword">module</span> <a class="code" href="classradmod.html">radmod</a> <span class="comment">! Dummy declaration for compatibility</span> <a name="l00441"></a>00441 use <span class="keywordflow">pumamod</span> <span class="comment">! with PLASIM (needed in guimod)</span> <a name="l00442"></a>00442 <span class="keyword">end module radmod</span> <a name="l00443"></a>00443 <a name="l00444"></a>00444 <a name="l00445"></a>00445 <span class="comment">! ***************** !</span> <a name="l00446"></a>00446 <span class="comment">! * MODULE PPPMOD * !</span> <a name="l00447"></a>00447 <span class="comment">! ***************** !</span> <a name="l00448"></a>00448 <a name="l00449"></a><a class="code" href="classprepmod.html">00449</a> <span class="keyword">module</span> <a class="code" href="classprepmod.html">prepmod</a> <a name="l00450"></a><a class="code" href="classprepmod.html#af7c26e3eb6ac74ce7f869f994f3f9096">00450</a> <span class="keywordtype">integer</span> :: num_ppp = 0 <a name="l00451"></a><a class="code" href="classprepmod.html#ab9f52241ed0e8b24728713f99adbef26">00451</a> <span class="keywordtype">integer</span> :: nlat_ppp = 0 <a name="l00452"></a><a class="code" href="classprepmod.html#ab4424b6e9966133154f2c7521b4f20c7">00452</a> <span class="keywordtype">integer</span> :: nlev_ppp = 0 <a name="l00453"></a>00453 <a name="l00454"></a><a class="code" href="structprepmod_1_1ppp__type.html">00454</a> <span class="keyword">type</span> <a class="code" href="structprepmod_1_1ppp__type.html">ppp_type</a> <a name="l00455"></a><a class="code" href="structprepmod_1_1ppp__type.html#ab9ad26f6cbb64570cc4171b5bb1ad15e">00455</a> <span class="keywordtype">character (80)</span> :: name <span class="comment">! name of variable or array</span> <a name="l00456"></a><a class="code" href="structprepmod_1_1ppp__type.html#a50ade2f5ae307f4416d1c41fc74ea2f0">00456</a> <span class="keywordtype">logical</span> :: isint <span class="comment">! .true. for integer</span> <a name="l00457"></a><a class="code" href="structprepmod_1_1ppp__type.html#ad89d33651c91bc5a6594a9522916f4c7">00457</a> <span class="keywordtype">integer</span> :: n <span class="comment">! length of vector (1 for scalar)</span> <a name="l00458"></a><a class="code" href="structprepmod_1_1ppp__type.html#a4e5bc8c49dff8e4b1dff9722c55e3b43">00458</a> <span class="keywordtype">integer</span>, <span class="keywordtype">pointer</span> :: pint <span class="comment">! pointer to integer value or array</span> <a name="l00459"></a><a class="code" href="structprepmod_1_1ppp__type.html#a98966af6cabcf5a13a3ef4fab52de965">00459</a> <span class="keywordtype">real</span> , <span class="keywordtype">pointer</span> :: preal <span class="comment">! pointer to real value or array</span> <a name="l00460"></a>00460 <span class="keyword">end type ppp_type</span> <a name="l00461"></a>00461 <a name="l00462"></a><a class="code" href="classprepmod.html#afa7847e6f1a2a1e05e5318e9ec47ad51">00462</a> <span class="keywordtype">type(ppp_type)</span> :: ppp_tab(30) <a name="l00463"></a>00463 <a name="l00464"></a>00464 <span class="keyword">interface</span> <a name="l00465"></a><a class="code" href="interfaceprepmod_1_1ppp__def__int.html#af7c4b83a645bb166b51a24e0844c8c0e">00465</a> <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(pname,nvar,ndim) <a name="l00466"></a>00466 <span class="keywordtype">character (*)</span> :: pname <a name="l00467"></a>00467 <span class="keywordtype">integer</span>, <span class="keywordtype">target</span> :: nvar <a name="l00468"></a>00468 <span class="keywordtype">integer</span> :: ndim <a name="l00469"></a>00469 <span class="keyword"> end subroutine ppp_def_int</span> <a name="l00470"></a><a class="code" href="interfaceprepmod_1_1ppp__def__real.html#a9a526e7c4c29459fbd3f636f64f85b1f">00470</a> <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__real.html">ppp_def_real</a>(pname,rvar,ndim) <a name="l00471"></a>00471 <span class="keywordtype">character (*)</span> :: pname <a name="l00472"></a>00472 <span class="keywordtype">real</span> , <span class="keywordtype">target</span> :: rvar(*) <a name="l00473"></a>00473 <span class="keywordtype">integer</span> :: ndim <a name="l00474"></a>00474 <span class="keyword"> end subroutine ppp_def_real</span> <a name="l00475"></a>00475 <span class="keyword">end interface</span> <a name="l00476"></a>00476 <a name="l00477"></a>00477 <span class="keyword">end module prepmod</span> <a name="l00478"></a>00478 <a name="l00479"></a>00479 <a name="l00480"></a>00480 <span class="comment">! *********************</span> <a name="l00481"></a>00481 <span class="comment">! * PROGRAM PUMA_MAIN *</span> <a name="l00482"></a>00482 <span class="comment">! *********************</span> <a name="l00483"></a>00483 <a name="l00484"></a><a class="code" href="puma_8f90.html#ab9b07e4288c177e089731e7560c18ac1">00484</a> <span class="keyword">program</span> <a class="code" href="puma_8f90.html#ab9b07e4288c177e089731e7560c18ac1">puma_main</a> <a name="l00485"></a>00485 use <span class="keywordflow">pumamod</span> <a name="l00486"></a>00486 <a name="l00487"></a>00487 <span class="comment">! ***********</span> <a name="l00488"></a>00488 <span class="comment">! * History *</span> <a name="l00489"></a>00489 <span class="comment">! ***********</span> <a name="l00490"></a>00490 <a name="l00491"></a>00491 <span class="comment">! 1972 - W. Bourke:</span> <a name="l00492"></a>00492 <span class="comment">! An efficient one-level primitive equation spectral model</span> <a name="l00493"></a>00493 <span class="comment">! Mon. Weath. Rev., 100, pp. 683-689</span> <a name="l00494"></a>00494 <a name="l00495"></a>00495 <span class="comment">! 1975 - B.J. Hoskins and A.J. Simmons: </span> <a name="l00496"></a>00496 <span class="comment">! A multi-layer spectral model and the semi-implicit method</span> <a name="l00497"></a>00497 <span class="comment">! Qart. J. R. Met. Soc., 101, pp. 637-655</span> <a name="l00498"></a>00498 <a name="l00499"></a>00499 <span class="comment">! 1993 - I.N. James and J.P. Dodd:</span> <a name="l00500"></a>00500 <span class="comment">! A Simplified Global Circulation Model</span> <a name="l00501"></a>00501 <span class="comment">! Users' Manual, Dept. of Meteorology, University of Reading</span> <a name="l00502"></a>00502 <a name="l00503"></a>00503 <span class="comment">! 1998 - Klaus Fraedrich, Edilbert Kirk, Frank Lunkeit</span> <a name="l00504"></a>00504 <span class="comment">! Portable University Model of the Atmosphere</span> <a name="l00505"></a>00505 <span class="comment">! DKRZ Technical Report No. 16</span> <a name="l00506"></a>00506 <a name="l00507"></a>00507 <span class="comment">! 2009 - PUMA Version 16.0</span> <a name="l00508"></a>00508 <span class="comment">! http://www.mi.uni-hamburg.de/puma</span> <a name="l00509"></a>00509 <a name="l00510"></a>00510 <span class="comment">! ******************</span> <a name="l00511"></a>00511 <span class="comment">! * Recent Changes *</span> <a name="l00512"></a>00512 <span class="comment">! ******************</span> <a name="l00513"></a>00513 <a name="l00514"></a>00514 <span class="comment">! 10-Jun-2002 - Puma Workshop - Documentation of subroutine SPECTRAL</span> <a name="l00515"></a>00515 <span class="comment">! 04-Jul-2002 - Frank Lunkeit - Annual cycle</span> <a name="l00516"></a>00516 <span class="comment">! 08-Jul-2002 - Edilbert Kirk - Factor for rotation speed</span> <a name="l00517"></a>00517 <span class="comment">! 25-Sep-2002 - Puma Workshop - Documentation of subroutine CALCGP</span> <a name="l00518"></a>00518 <span class="comment">! 11-Nov-2002 - Edilbert Kirk - Add Orography to output file</span> <a name="l00519"></a>00519 <span class="comment">! 26-Feb-2003 - Edilbert Kirk - Read preprocessed initial file</span> <a name="l00520"></a>00520 <span class="comment">! 07-Sep-2004 - Edilbert Kirk - Graphical User Interface</span> <a name="l00521"></a>00521 <span class="comment">! 23-Aug-2006 - Torben Kunz - Held & Suarez forcing</span> <a name="l00522"></a>00522 <span class="comment">! 23-Aug-2006 - Torben Kunz - new spacing schemes of sigma levels</span> <a name="l00523"></a>00523 <span class="comment">! 23-Aug-2006 - Edilbert Kirk - individual selection of zonal waves</span> <a name="l00524"></a>00524 <span class="comment">! 23-Aug-2006 - Edilbert Kirk - optimized Legendre trasnformation module</span> <a name="l00525"></a>00525 <span class="comment">! 19-Feb-2007 - Edilbert Kirk - new flexible restart I/O</span> <a name="l00526"></a>00526 <span class="comment">! 15-Sep-2009 - Edilbert Kirk - static arrays replaced by allocatable</span> <a name="l00527"></a>00527 <span class="comment">! 15-Sep-2009 - Frank Lunkeit - diagnostics for entropy production</span> <a name="l00528"></a>00528 <span class="comment">! 27-Sep-2010 - Edilbert Kirk - cleaned up ruido routines</span> <a name="l00529"></a>00529 <a name="l00530"></a>00530 call <a class="code" href="mpimod_8f90.html#a41bbd9334a3d0412c73399d699bbb237">mpstart</a> <a name="l00531"></a>00531 call <a class="code" href="puma_8f90.html#a37eac16619683a2be841fc68b9281299">setfilenames</a> <a name="l00532"></a>00532 call <a class="code" href="puma_8f90.html#ab7757291a70ca39d0c7a7e8db515c058">opendiag</a> <a name="l00533"></a>00533 call <a class="code" href="puma_8f90.html#a811c67568d6f12806d6b6f86813d2bc4">read_resolution</a> <a name="l00534"></a>00534 call <a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">resolution</a> <a name="l00535"></a>00535 <span class="keyword">if</span> (mrnum == 2) <span class="keyword">then</span> <a name="l00536"></a>00536 call <a class="code" href="mpimod_8f90.html#acb4a2403b5f65a70e7e5ff01ea4577f7">mrdimensions</a> <a name="l00537"></a>00537 <span class="keyword">endif</span> <a name="l00538"></a>00538 call <a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">allocate_arrays</a> <a name="l00539"></a>00539 call <a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">prolog</a> <a name="l00540"></a>00540 call <a class="code" href="puma_8f90.html#af02944c9cc5103c31e4ed9b779e7cc79">master</a> <a name="l00541"></a>00541 call <a class="code" href="puma_8f90.html#a35d7c22447dc50ab86832b4615994d32">epilog</a> <a name="l00542"></a>00542 call <a class="code" href="guimod_8f90.html#ad58ecd458338fd5891f0838eda94bb0c">guistop</a> <a name="l00543"></a>00543 call <a class="code" href="mpimod_8f90.html#ac80e83b9bc0a4b459fed5f3b79cfafa0">mpstop</a> <a name="l00544"></a>00544 stop <a name="l00545"></a>00545 <span class="keyword">end program puma_main</span> <a name="l00546"></a>00546 <a name="l00547"></a>00547 <a name="l00548"></a>00548 <span class="comment">! ***************************</span> <a name="l00549"></a>00549 <span class="comment">! * SUBROUTINE SETFILENAMES *</span> <a name="l00550"></a>00550 <span class="comment">! ***************************</span> <a name="l00551"></a>00551 <a name="l00552"></a><a class="code" href="puma_8f90.html#a37eac16619683a2be841fc68b9281299">00552</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a37eac16619683a2be841fc68b9281299">setfilenames</a> <a name="l00553"></a>00553 use <span class="keywordflow">pumamod</span> <a name="l00554"></a>00554 <a name="l00555"></a>00555 <span class="keywordtype">character (3)</span> :: mrext <a name="l00556"></a>00556 <a name="l00557"></a>00557 <span class="keyword">if</span> (mrpid < 0) return <span class="comment">! no multirun</span> <a name="l00558"></a>00558 <a name="l00559"></a>00559 <span class="keyword">write</span>(mrext,<span class="stringliteral">'("_",i2.2)'</span>) mrpid <a name="l00560"></a>00560 <a name="l00561"></a>00561 puma_namelist = trim(puma_namelist ) // mrext <a name="l00562"></a>00562 puma_output = trim(puma_output ) // mrext <a name="l00563"></a>00563 puma_diag = trim(puma_diag ) // mrext <a name="l00564"></a>00564 puma_restart = trim(puma_restart ) // mrext <a name="l00565"></a>00565 puma_status = trim(puma_status ) // mrext <a name="l00566"></a>00566 efficiency_dat = trim(efficiency_dat ) // mrext <a name="l00567"></a>00567 ppp_puma_txt = trim(ppp_puma_txt ) // mrext <a name="l00568"></a>00568 puma_sp_init = trim(puma_sp_init ) // mrext <a name="l00569"></a>00569 <a name="l00570"></a>00570 return <a name="l00571"></a>00571 <span class="keyword">end</span> <a name="l00572"></a>00572 <a name="l00573"></a>00573 <a name="l00574"></a>00574 <span class="comment">! ***********************</span> <a name="l00575"></a>00575 <span class="comment">! * SUBROUTINE OPENDIAG *</span> <a name="l00576"></a>00576 <span class="comment">! ***********************</span> <a name="l00577"></a>00577 <a name="l00578"></a><a class="code" href="puma_8f90.html#ab7757291a70ca39d0c7a7e8db515c058">00578</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ab7757291a70ca39d0c7a7e8db515c058">opendiag</a> <a name="l00579"></a>00579 use <span class="keywordflow">pumamod</span> <a name="l00580"></a>00580 <a name="l00581"></a>00581 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00582"></a>00582 <span class="keyword">open</span>(nud,file=puma_diag) <a name="l00583"></a>00583 <span class="keyword">endif</span> <a name="l00584"></a>00584 <a name="l00585"></a>00585 return <a name="l00586"></a>00586 <span class="keyword">end</span> <a name="l00587"></a>00587 <a name="l00588"></a>00588 <a name="l00589"></a>00589 <span class="comment">! ******************************</span> <a name="l00590"></a>00590 <span class="comment">! * SUBROUTINE ALLOCATE_ARRAYS *</span> <a name="l00591"></a>00591 <span class="comment">! ******************************</span> <a name="l00592"></a>00592 <a name="l00593"></a><a class="code" href="puma_8f90.html#a486bae2289e6e28e652b41555030d3e6">00593</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a486bae2289e6e28e652b41555030d3e6">allocate_arrays</a> <a name="l00594"></a>00594 use <span class="keywordflow">pumamod</span> <a name="l00595"></a>00595 <a name="l00596"></a>00596 <span class="keyword">allocate</span>(sd(nesp,nlev)) ; sd(:,:) = 0.0 <span class="comment">! Spectral Divergence</span> <a name="l00597"></a>00597 <span class="keyword">allocate</span>(st(nesp,nlev)) ; st(:,:) = 0.0 <span class="comment">! Spectral Temperature</span> <a name="l00598"></a>00598 <span class="keyword">allocate</span>(sz(nesp,nlev)) ; sz(:,:) = 0.0 <span class="comment">! Spectral Vorticity</span> <a name="l00599"></a>00599 <span class="keyword">allocate</span>(sp(nesp)) ; sp(:) = 0.0 <span class="comment">! Spectral Pressure (ln Ps)</span> <a name="l00600"></a>00600 <span class="keyword">allocate</span>(so(nesp)) ; so(:) = 0.0 <span class="comment">! Spectral Orography</span> <a name="l00601"></a>00601 <span class="keyword">allocate</span>(sr1(nesp,nlev)) ; sr1(:,:) = 0.0 <span class="comment">! Spectral Restoration Temperature</span> <a name="l00602"></a>00602 <span class="keyword">allocate</span>(sr2(nesp,nlev)) ; sr2(:,:) = 0.0 <span class="comment">! Spectral Restoration Temperature</span> <a name="l00603"></a>00603 <span class="keyword">allocate</span>(sdp(nspp,nlev)) ; sdp(:,:) = 0.0 <span class="comment">! Spectral Divergence Partial</span> <a name="l00604"></a>00604 <span class="keyword">allocate</span>(stp(nspp,nlev)) ; stp(:,:) = 0.0 <span class="comment">! Spectral Temperature Partial</span> <a name="l00605"></a>00605 <span class="keyword">allocate</span>(szp(nspp,nlev)) ; szp(:,:) = 0.0 <span class="comment">! Spectral Vorticity Partial</span> <a name="l00606"></a>00606 <span class="keyword">allocate</span>(spp(nspp)) ; spp(:) = 0.0 <span class="comment">! Spectral Pressure Partial</span> <a name="l00607"></a>00607 <span class="keyword">allocate</span>(sop(nspp)) ; sop(:) = 0.0 <span class="comment">! Spectral Orography Partial</span> <a name="l00608"></a>00608 <span class="keyword">allocate</span>(srp1(nspp,nlev)) ; srp1(:,:)= 0.0 <span class="comment">! Spectral Restoration Partial</span> <a name="l00609"></a>00609 <span class="keyword">allocate</span>(srp2(nspp,nlev)) ; srp2(:,:)= 0.0 <span class="comment">! Spectral Restoration Partial</span> <a name="l00610"></a>00610 <span class="keyword">allocate</span>(sdt(nspp,nlev)) ; sdt(:,:) = 0.0 <span class="comment">! Spectral Divergence Tendency</span> <a name="l00611"></a>00611 <span class="keyword">allocate</span>(stt(nspp,nlev)) ; stt(:,:) = 0.0 <span class="comment">! Spectral Temperature Tendency</span> <a name="l00612"></a>00612 <span class="keyword">allocate</span>(szt(nspp,nlev)) ; szt(:,:) = 0.0 <span class="comment">! Spectral Vorticity Tendency</span> <a name="l00613"></a>00613 <span class="keyword">allocate</span>(spt(nspp)) ; spt(:) = 0.0 <span class="comment">! Spectral Pressure Tendency</span> <a name="l00614"></a>00614 <span class="keyword">allocate</span>(sdm(nspp,nlev)) ; sdm(:,:) = 0.0 <span class="comment">! Spectral Divergence Minus</span> <a name="l00615"></a>00615 <span class="keyword">allocate</span>(stm(nspp,nlev)) ; stm(:,:) = 0.0 <span class="comment">! Spectral Temperature Minus</span> <a name="l00616"></a>00616 <span class="keyword">allocate</span>(szm(nspp,nlev)) ; szm(:,:) = 0.0 <span class="comment">! Spectral Vorticity Minus</span> <a name="l00617"></a>00617 <span class="keyword">allocate</span>(spm(nspp)) ; spm(:) = 0.0 <span class="comment">! Spectral Pressure Minus</span> <a name="l00618"></a>00618 <span class="keyword">allocate</span>(sak(nesp)) ; sak(:) = 0.0 <span class="comment">! Hyper diffusion</span> <a name="l00619"></a>00619 <span class="keyword">allocate</span>(srcn(nesp)) ; srcn(:) = 0.0 <span class="comment">! 1.0 / (n * (n+1))</span> <a name="l00620"></a>00620 <span class="keyword">allocate</span>(span(nesp)) ; span(:) = 0.0 <span class="comment">! Pressure for diagnostics</span> <a name="l00621"></a>00621 <span class="keyword">allocate</span>(spnorm(nesp)) ; spnorm(:)= 0.0 <span class="comment">! Factors for output normalization</span> <a name="l00622"></a>00622 <a name="l00623"></a>00623 <span class="keyword">allocate</span>(nindex(nesp)) ; nindex(:) = ntru <span class="comment">! Holds wavenumber</span> <a name="l00624"></a>00624 <span class="keyword">allocate</span>(nscatsp(npro)) ; nscatsp(:) = nspp <span class="comment">! Used for reduce_scatter op</span> <a name="l00625"></a>00625 <span class="keyword">allocate</span>(nselzw(0:ntru)) ; nselzw(:) = 1 <span class="comment">! Enable selected zonal waves</span> <a name="l00626"></a>00626 <span class="keyword">allocate</span>(nselsp(ncsp)) ; nselsp(:) = 1 <span class="comment">! Enable slected spectral modes</span> <a name="l00627"></a>00627 <a name="l00628"></a>00628 <span class="keyword">allocate</span>(gd(nhor,nlev)) ; gd(:,:) = 0.0 <span class="comment">! Divergence</span> <a name="l00629"></a>00629 <span class="keyword">allocate</span>(gt(nhor,nlev)) ; gt(:,:) = 0.0 <span class="comment">! Temperature</span> <a name="l00630"></a>00630 <span class="keyword">allocate</span>(gz(nhor,nlev)) ; gz(:,:) = 0.0 <span class="comment">! Vorticity</span> <a name="l00631"></a>00631 <span class="keyword">allocate</span>(gu(nhor,nlev)) ; gu(:,:) = 0.0 <span class="comment">! u * cos(phi)</span> <a name="l00632"></a>00632 <span class="keyword">allocate</span>(gv(nhor,nlev)) ; gv(:,:) = 0.0 <span class="comment">! v * sin(phi)</span> <a name="l00633"></a>00633 <span class="keyword">allocate</span>(gp(nhor)) ; gp(:) = 0.0 <span class="comment">! Ln(Ps)</span> <a name="l00634"></a>00634 <span class="keyword">allocate</span>(gfu(nhor,nlev)) ; gfu(:,:) = 0.0 <span class="comment">! Term Fu in Primitive Equations</span> <a name="l00635"></a>00635 <span class="keyword">allocate</span>(gfv(nhor,nlev)) ; gfv(:,:) = 0.0 <span class="comment">! Term Fv in Primitive Equations</span> <a name="l00636"></a>00636 <span class="keyword">allocate</span>(gut(nhor,nlev)) ; gut(:,:) = 0.0 <span class="comment">! Term u * T</span> <a name="l00637"></a>00637 <span class="keyword">allocate</span>(gvt(nhor,nlev)) ; gvt(:,:) = 0.0 <span class="comment">! Term v * T</span> <a name="l00638"></a>00638 <span class="keyword">allocate</span>(gke(nhor,nlev)) ; gke(:,:) = 0.0 <span class="comment">! Kinetic energy u * u + v * v</span> <a name="l00639"></a>00639 <span class="keyword">allocate</span>(gpj(nhor)) ; gpj(:) = 0.0 <span class="comment">! d(Ln(Ps)) / d(mu)</span> <a name="l00640"></a>00640 <a name="l00641"></a>00641 <a name="l00642"></a>00642 <span class="keyword">allocate</span>(rcsq(nhor)) ; rcsq(:) = 0.0 <span class="comment">! 1 / cos2(phi)</span> <a name="l00643"></a>00643 <a name="l00644"></a>00644 <span class="keyword">allocate</span>(ndil(nlev)) ; ndil(:) = 0 <a name="l00645"></a>00645 <span class="keyword">allocate</span>(csu(nlat,nlev)) ; csu(:,:) = 0.0 <a name="l00646"></a>00646 <span class="keyword">allocate</span>(csv(nlat,nlev)) ; csv(:,:) = 0.0 <a name="l00647"></a>00647 <span class="keyword">allocate</span>(cst(nlat,nlev)) ; cst(:,:) = 0.0 <a name="l00648"></a>00648 <a name="l00649"></a>00649 <span class="keyword">allocate</span>(chlat(nlat)) ; chlat(:) = <span class="stringliteral">' '</span> <a name="l00650"></a>00650 <span class="keyword">allocate</span>(sid(nlat)) ; sid(:) = 0.0 <span class="comment">! sin(phi)</span> <a name="l00651"></a>00651 <span class="keyword">allocate</span>(gwd(nlat)) ; gwd(:) = 0.0 <span class="comment">! Gaussian weight (phi)</span> <a name="l00652"></a>00652 <span class="keyword">allocate</span>(csq(nlat)) ; csq(:) = 0.0 <span class="comment">! cos2(phi)</span> <a name="l00653"></a>00653 <span class="keyword">allocate</span>(rcs(nlat)) ; rcs(:) = 0.0 <span class="comment">! 1/cos(phi)</span> <a name="l00654"></a>00654 <a name="l00655"></a>00655 <span class="keyword">allocate</span>(t0(nlev)) ; t0(:) = 250.0 <span class="comment">! reference temperature</span> <a name="l00656"></a>00656 <span class="keyword">allocate</span>(t0d(nlev)) ; t0d(:) = 0.0 <span class="comment">! vertical t0 gradient</span> <a name="l00657"></a>00657 <span class="keyword">allocate</span>(taur(nlev)) ; taur(:) = 0.0 <span class="comment">! tau R [days]</span> <a name="l00658"></a>00658 <span class="keyword">allocate</span>(tauf(nlev)) ; tauf(:) = 0.0 <span class="comment">! tau F [days]</span> <a name="l00659"></a>00659 <span class="keyword">allocate</span>(damp(nlev)) ; damp(:) = 0.0 <span class="comment">! 1.0 / (2 Pi * taur)</span> <a name="l00660"></a>00660 <span class="keyword">allocate</span>(fric(nlev)) ; fric(:) = 0.0 <span class="comment">! 1.0 / (2 Pi * tauf )</span> <a name="l00661"></a>00661 <span class="keyword">allocate</span>(dsigma(nlev)) ; dsigma(:) = 0.0 <a name="l00662"></a>00662 <span class="keyword">allocate</span>(rdsig(nlev)) ; rdsig(:) = 0.0 <a name="l00663"></a>00663 <span class="keyword">allocate</span>(sigma(nlev)) ; sigma(:) = 0.0 <a name="l00664"></a>00664 <span class="keyword">allocate</span>(sigmh(nlev)) ; sigmh(:) = 0.0 <a name="l00665"></a>00665 <span class="keyword">allocate</span>(tkp(nlev)) ; tkp(:) = 0.0 <a name="l00666"></a>00666 <span class="keyword">allocate</span>(c(nlev,nlev)) ; c(:,:) = 0.0 <a name="l00667"></a>00667 <span class="keyword">allocate</span>(xlphi(nlev,nlev)) ; xlphi(:,:) = 0.0 <span class="comment">! matrix Lphi (g)</span> <a name="l00668"></a>00668 <span class="keyword">allocate</span>(xlt(nlev,nlev)) ; xlt(:,:) = 0.0 <span class="comment">! matrix LT (tau)</span> <a name="l00669"></a>00669 <span class="keyword">allocate</span>(bm1(nlev,nlev,0:NTRU)) ; bm1(:,:,:) = 0.0 <a name="l00670"></a>00670 <a name="l00671"></a>00671 <span class="keyword">if</span> (mrnum == 2) <span class="keyword">then</span> <a name="l00672"></a>00672 <span class="keyword">allocate</span>(sdd(nesp,nlev)) ; sdd(:,:) = 0.0 <a name="l00673"></a>00673 <span class="keyword">allocate</span>(std(nesp,nlev)) ; std(:,:) = 0.0 <a name="l00674"></a>00674 <span class="keyword">allocate</span>(szd(nesp,nlev)) ; szd(:,:) = 0.0 <a name="l00675"></a>00675 <span class="keyword">allocate</span>(spd(nesp )) ; spd(: ) = 0.0 <a name="l00676"></a>00676 <span class="keyword">endif</span> <a name="l00677"></a>00677 <a name="l00678"></a>00678 return <a name="l00679"></a>00679 <span class="keyword">end subroutine allocate_arrays</span> <a name="l00680"></a>00680 <a name="l00681"></a>00681 <a name="l00682"></a>00682 <span class="comment">! =================</span> <a name="l00683"></a>00683 <span class="comment">! SUBROUTINE PROLOG</span> <a name="l00684"></a>00684 <span class="comment">! =================</span> <a name="l00685"></a>00685 <a name="l00686"></a><a class="code" href="puma_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">00686</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#afde378004f20ed8741a7e9bcd82cbfe4">prolog</a> <a name="l00687"></a>00687 use <span class="keywordflow">pumamod</span> <a name="l00688"></a>00688 <a name="l00689"></a>00689 <span class="keywordtype">character( 8)</span> :: cpuma = <span class="stringliteral">'PUMA-II '</span> <a name="l00690"></a>00690 <span class="keywordtype">character(80)</span> :: pumaversion = <span class="stringliteral">'16.0 (27-Sep-2010)'</span> <a name="l00691"></a>00691 <span class="keywordtype">real</span> :: zsig(nlon*nlat) <a name="l00692"></a>00692 <a name="l00693"></a>00693 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00694"></a>00694 call cpu_time(tmstart) <a name="l00695"></a>00695 <span class="keyword">write</span>(nud,<span class="stringliteral">'(/," ****************************************************")'</span>) <a name="l00696"></a>00696 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" * PUMA ",a43," *")'</span>) trim(pumaversion) <a name="l00697"></a>00697 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" ****************************************************")'</span>) <a name="l00698"></a>00698 <span class="keyword">if</span> (mrnum == 0) <span class="keyword">then</span> <a name="l00699"></a>00699 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" * NTRU =",i4," NLEV =",i4," NLON = ",i4," NLAT =",i4," *")'</span>) & <a name="l00700"></a>00700 NTRU,NLEV,NLON,NLAT <a name="l00701"></a>00701 <span class="keyword">else</span> <a name="l00702"></a>00702 <span class="keyword">do</span> jpid = 1 , mrnum <a name="l00703"></a>00703 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" * PID =",i4," NTRU =",i4," NLEV = ",i4," *")'</span>) & <a name="l00704"></a>00704 jpid-1,mrtru(jpid),NLEV <a name="l00705"></a>00705 <span class="keyword">enddo</span> <a name="l00706"></a>00706 <span class="keyword">endif</span> <a name="l00707"></a>00707 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" ****************************************************")'</span>) <a name="l00708"></a>00708 <span class="keyword">if</span> (NPRO > 1) <span class="keyword">then</span> <a name="l00709"></a>00709 <span class="keyword">write</span>(nud,<span class="stringliteral">'(/," ****************************************************")'</span>) <a name="l00710"></a>00710 <span class="keyword">do</span> jpro = 1 , NPRO <a name="l00711"></a>00711 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" * CPU",i4,1x,a40," *")'</span>) jpro-1,ympname(jpro) <a name="l00712"></a>00712 <span class="keyword">enddo</span> <a name="l00713"></a>00713 <span class="keyword">write</span>(nud,<span class="stringliteral">'(" ****************************************************")'</span>) <a name="l00714"></a>00714 <span class="keyword">endif</span> <a name="l00715"></a>00715 call <a class="code" href="restartmod_8f90.html#a1afb89bd2af13e06ddcbeeb393eeb191">restart_ini</a>(lrestart,puma_restart) <a name="l00716"></a>00716 call <a class="code" href="gaussmod_8f90.html#a841a2f8e9025371eddc985235e1831ab">inigau</a>(NLAT,sid,gwd) <a name="l00717"></a>00717 call <a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">inilat</a> <a name="l00718"></a>00718 call <a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">legpri</a> <a name="l00719"></a>00719 call <a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">readnl</a> <a name="l00720"></a>00720 call <a class="code" href="puma_8f90.html#a859f80933ca252bcc87f27d3996fea05">ppp_interface</a> <a name="l00721"></a>00721 call <a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">initpm</a> <a name="l00722"></a>00722 call <a class="code" href="puma_8f90.html#a96b9223819624937b18b4e5b29e95a91">initsi</a> <a name="l00723"></a>00723 call <a class="code" href="legsym_8f90.html#ae810767bcafdac840ab48c420efcb49a">altlat</a>(csq,NLAT) <span class="comment">! csq -> alternating grid</span> <a name="l00724"></a>00724 <span class="keyword">if</span> (ngui > 0) call <a class="code" href="guimod_8f90.html#a77235ccfbc718d5f8b1edc4be08aed03">guistart</a> <a name="l00725"></a>00725 <span class="keyword">if</span> (nrun == 0 .and. nstop > 0) nrun = nstop-<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> <a name="l00726"></a>00726 <span class="keyword">if</span> (nrun == 0) nrun = ntspd * (nyears * 360 + nmonths * 30) <a name="l00727"></a>00727 call <a class="code" href="puma_8f90.html#acbd8e7fdd2e1f60dbca741a700fb292a">initrandom</a> <span class="comment">! set random seed</span> <a name="l00728"></a>00728 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span> <a name="l00729"></a>00729 <a name="l00730"></a>00730 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nruido) <a name="l00731"></a>00731 call <a class="code" href="puma_8f90.html#aea6c13c68157972ea21768a5ea43e154">initruido</a> <span class="comment">! allocate ruido arrays</span> <a name="l00732"></a>00732 <a name="l00733"></a>00733 <a name="l00734"></a>00734 <span class="keyword">if</span> (nshutdown > 0) return <span class="comment">! If something went wrong in the init routines</span> <a name="l00735"></a>00735 <a name="l00736"></a>00736 <span class="comment">! ***********************</span> <a name="l00737"></a>00737 <span class="comment">! * broadcast & scatter *</span> <a name="l00738"></a>00738 <span class="comment">! ***********************</span> <a name="l00739"></a>00739 <a name="l00740"></a>00740 call <a class="code" href="mpimod_8f90.html#a3d2a5d231fd9527bcbc1fde327326922">mpscdn</a>(sid,NHPP) <span class="comment">! real (kind=8)</span> <a name="l00741"></a>00741 call <a class="code" href="mpimod_8f90.html#a3d2a5d231fd9527bcbc1fde327326922">mpscdn</a>(gwd,NHPP) <span class="comment">! real (kind=8)</span> <a name="l00742"></a>00742 call <a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(csq,NLPP) <a name="l00743"></a>00743 <a name="l00744"></a>00744 <span class="keyword">do</span> jlat = 1 , NLPP <a name="l00745"></a>00745 rcsq(1+(jlat-1)*NLON:jlat*NLON) = 1.0 / csq(jlat) <a name="l00746"></a>00746 <span class="keyword">enddo</span> <a name="l00747"></a>00747 <a name="l00748"></a>00748 <span class="comment">! broadcast integer</span> <a name="l00749"></a>00749 <a name="l00750"></a>00750 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(kick ) <span class="comment">! add noise for kick > 0</span> <a name="l00751"></a>00751 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nafter ) <span class="comment">! write data interval [steps]</span> <a name="l00752"></a>00752 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nwpd ) <span class="comment">! write data interval [writes per day]</span> <a name="l00753"></a>00753 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ncoeff ) <span class="comment">! number of modes to print</span> <a name="l00754"></a>00754 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndel ) <span class="comment">! ndel</span> <a name="l00755"></a>00755 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(noutput ) <span class="comment">! global output switch</span> <a name="l00756"></a>00756 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndiag ) <span class="comment">! write diagnostics interval</span> <a name="l00757"></a>00757 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ngui ) <span class="comment">! GUI on (1) or off (0)</span> <a name="l00758"></a>00758 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nkits ) <span class="comment">! number of initial timesteps</span> <a name="l00759"></a>00759 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nlevt ) <span class="comment">! tropospheric levels</span> <a name="l00760"></a>00760 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nrun ) <span class="comment">! if (nstop == 0) nstop = nstep + nrun</span> <a name="l00761"></a>00761 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> ) <span class="comment">! current timestep</span> <a name="l00762"></a>00762 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nstop ) <span class="comment">! finishing timestep</span> <a name="l00763"></a>00763 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ntspd ) <span class="comment">! number of timesteps per day</span> <a name="l00764"></a>00764 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(mpstep ) <span class="comment">! minutes per step</span> <a name="l00765"></a>00765 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nyears ) <span class="comment">! simulation time</span> <a name="l00766"></a>00766 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nmonths ) <span class="comment">! simulation time</span> <a name="l00767"></a>00767 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nextout ) <span class="comment">! write extended output</span> <a name="l00768"></a>00768 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nsponge) <span class="comment">! Switch for sponge layer</span> <a name="l00769"></a>00769 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nhelsua) <span class="comment">! Held & Suarez forcing</span> <a name="l00770"></a>00770 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndiagp) <span class="comment">! 0/1 switch for new grid point diabatic heating</span> <a name="l00771"></a>00771 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nconv) <span class="comment">! 0/1 switch for convective heating</span> <a name="l00772"></a>00772 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nvg ) <span class="comment">! Type of vertical grid</span> <a name="l00773"></a>00773 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nenergy) <span class="comment">! energy diagnostics</span> <a name="l00774"></a>00774 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nentropy) <span class="comment">! entropy diagnostics</span> <a name="l00775"></a>00775 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ndheat) <span class="comment">! energy recycling</span> <a name="l00776"></a>00776 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nradcv) <span class="comment">! use two restoration fields</span> <a name="l00777"></a>00777 <a name="l00778"></a>00778 <span class="comment">! broadcast logical</span> <a name="l00779"></a>00779 <a name="l00780"></a>00780 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lrestart) <span class="comment">! true: read restart file, false: initial run</span> <a name="l00781"></a>00781 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lselect ) <span class="comment">! true: disable some zonal waves</span> <a name="l00782"></a>00782 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lspecsel) <span class="comment">! true: disable some spectral modes</span> <a name="l00783"></a>00783 <a name="l00784"></a>00784 <span class="comment">! broadcast real</span> <a name="l00785"></a>00785 <a name="l00786"></a>00786 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(ww ) <a name="l00787"></a>00787 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(v_scl ) <a name="l00788"></a>00788 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(ct ) <a name="l00789"></a>00789 <a name="l00790"></a>00790 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(sid_day ) <a name="l00791"></a>00791 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(plarad ) <a name="l00792"></a>00792 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(gascon ) <a name="l00793"></a>00793 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(akap ) <a name="l00794"></a>00794 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(alr ) <a name="l00795"></a>00795 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(ga ) <a name="l00796"></a>00796 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(psurf ) <a name="l00797"></a>00797 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(alpha ) <span class="comment">! Williams factor for time filter</span> <a name="l00798"></a>00798 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtep ) <span class="comment">! equator-pole temperature difference</span> <a name="l00799"></a>00799 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtns ) <a name="l00800"></a>00800 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtrop ) <a name="l00801"></a>00801 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dttrp ) <a name="l00802"></a>00802 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tdiss ) <a name="l00803"></a>00803 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tac ) <a name="l00804"></a>00804 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(pac ) <a name="l00805"></a>00805 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(plavor ) <a name="l00806"></a>00806 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(rotspd ) <a name="l00807"></a>00807 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(sigmax ) <span class="comment">! sigma of top half level</span> <a name="l00808"></a>00808 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tgr ) <a name="l00809"></a>00809 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dvdiff ) <a name="l00810"></a>00810 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(disp ) <a name="l00811"></a>00811 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tauta ) <a name="l00812"></a>00812 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(tauts ) <a name="l00813"></a>00813 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(pspon ) <a name="l00814"></a>00814 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(sponk ) <a name="l00815"></a>00815 <a name="l00816"></a>00816 <span class="comment">! broadcast integer arrays</span> <a name="l00817"></a>00817 <a name="l00818"></a>00818 call <a class="code" href="mpimod_8f90.html#a85cfae5acde5c37604edf690e9c2f7cf">mpbcin</a>(ndil ,NLEV) <a name="l00819"></a>00819 call <a class="code" href="mpimod_8f90.html#a85cfae5acde5c37604edf690e9c2f7cf">mpbcin</a>(nselzw,NTP1) <a name="l00820"></a>00820 <a name="l00821"></a>00821 <span class="comment">! broadcast real arrays</span> <a name="l00822"></a>00822 <a name="l00823"></a>00823 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(damp ,NLEV) <a name="l00824"></a>00824 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(dsigma,NLEV) <a name="l00825"></a>00825 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(fric ,NLEV) <a name="l00826"></a>00826 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(rdsig ,NLEV) <a name="l00827"></a>00827 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(taur ,NLEV) <a name="l00828"></a>00828 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sigma ,NLEV) <a name="l00829"></a>00829 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sigmh ,NLEV) <a name="l00830"></a>00830 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(t0 ,NLEV) <a name="l00831"></a>00831 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(t0d ,NLEV) <a name="l00832"></a>00832 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(tauf ,NLEV) <a name="l00833"></a>00833 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(tkp ,NLEV) <a name="l00834"></a>00834 <a name="l00835"></a>00835 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(c ,NLSQ) <a name="l00836"></a>00836 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(xlphi ,NLSQ) <a name="l00837"></a>00837 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(xlt ,NLSQ) <a name="l00838"></a>00838 <a name="l00839"></a>00839 <span class="comment">! scatter integer arrays</span> <a name="l00840"></a>00840 <a name="l00841"></a>00841 call <a class="code" href="mpimod_8f90.html#a8338d8609afcefbb1faa41f353c10ef9">mpscin</a>(nindex,NSPP) <a name="l00842"></a>00842 call <a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(srcn ,NSPP) <a name="l00843"></a>00843 call <a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(sak ,NSPP) <a name="l00844"></a>00844 <a name="l00845"></a>00845 call <a class="code" href="legsym_8f90.html#a86bc436e65d6c4ddde72bb3cce7dc8c8">legini</a>(nlat,nlpp,nesp,nlev,plavor,sid,gwd) <a name="l00846"></a>00846 <a name="l00847"></a>00847 <span class="keyword">if</span> (lrestart) <span class="keyword">then</span> <a name="l00848"></a>00848 call <a class="code" href="puma_8f90.html#aa07fedd638dbdd8e1799b83d34eb35e3">read_atmos_restart</a> <a name="l00849"></a>00849 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00850"></a>00850 <span class="keyword">if</span> (kick > 10) call <a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kick-10) <a name="l00851"></a>00851 <span class="keyword">endif</span> <a name="l00852"></a>00852 <span class="keyword">else</span> <a name="l00853"></a>00853 call <a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">initfd</a> <a name="l00854"></a>00854 <span class="keyword">endif</span> <a name="l00855"></a>00855 <a name="l00856"></a>00856 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00857"></a>00857 call <a class="code" href="puma_8f90.html#a9a888c599145a63cdd108dffa553b509">printseed</a> <span class="comment">! either namelist, clock initialized or from restart file</span> <a name="l00858"></a>00858 <span class="keyword">endif</span> <a name="l00859"></a>00859 <a name="l00860"></a>00860 <span class="comment">! broadcast spectral arrays</span> <a name="l00861"></a>00861 <a name="l00862"></a>00862 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sp,NESP) <a name="l00863"></a>00863 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sd,NESP*NLEV) <a name="l00864"></a>00864 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(st,NESP*NLEV) <a name="l00865"></a>00865 call <a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(sz,NESP*NLEV) <a name="l00866"></a>00866 <a name="l00867"></a>00867 <span class="comment">! scatter spectral arrays</span> <a name="l00868"></a>00868 <a name="l00869"></a>00869 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sd,sdp,NLEV) <a name="l00870"></a>00870 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(st,stp,NLEV) <a name="l00871"></a>00871 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sz,szp,NLEV) <a name="l00872"></a>00872 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sr1,srp1,NLEV) <a name="l00873"></a>00873 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sr2,srp2,NLEV) <a name="l00874"></a>00874 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sp,spp,1) <a name="l00875"></a>00875 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(so,sop,1) <a name="l00876"></a>00876 <a name="l00877"></a>00877 <span class="comment">! scatter gridpoint arrays</span> <a name="l00878"></a>00878 <a name="l00879"></a>00879 <span class="keyword">if</span> (nruido > 0) call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(ruido,ruidop,NLEV) <a name="l00880"></a>00880 <a name="l00881"></a>00881 <span class="comment">!</span> <a name="l00882"></a>00882 <span class="comment">! initialize energy and entropy diagnostics</span> <a name="l00883"></a>00883 <span class="comment">!</span> <a name="l00884"></a>00884 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l00885"></a>00885 <span class="keyword">allocate</span>(denergy(NHOR,9)) <a name="l00886"></a>00886 denergy(:,:)=0. <a name="l00887"></a>00887 <span class="keyword">endif</span> <a name="l00888"></a>00888 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l00889"></a>00889 <span class="keyword">allocate</span>(dentropy(NHOR,9)) <a name="l00890"></a>00890 dentropy(:,:)=0. <a name="l00891"></a>00891 <span class="keyword">endif</span> <a name="l00892"></a>00892 <span class="keyword">if</span>(ndheat > 1 .and. mypid == NROOT) <span class="keyword">then</span> <a name="l00893"></a>00893 <span class="keyword">open</span>(9,file=efficiency_dat,form=<span class="stringliteral">'formatted'</span>) <a name="l00894"></a>00894 <span class="keyword">endif</span> <a name="l00895"></a>00895 <span class="comment">!</span> <a name="l00896"></a>00896 <span class="comment">! write first service record containing sigma coordinates</span> <a name="l00897"></a>00897 <span class="comment">!</span> <a name="l00898"></a>00898 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00899"></a>00899 <span class="keyword">if</span> (noutput > 0) <span class="keyword">then</span> <a name="l00900"></a>00900 istep = <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> <a name="l00901"></a>00901 <span class="keyword">if</span> (istep > 0) istep = istep + nafter <span class="comment">! next write after restart</span> <a name="l00902"></a>00902 <span class="keyword">open</span>(40,file=puma_output,form=<span class="stringliteral">'unformatted'</span>) <a name="l00903"></a>00903 call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(istep,imin,ihour,iday,imonth,iyear) <a name="l00904"></a>00904 zsig(1:nlev) = sigmh(:) <a name="l00905"></a>00905 zsig(nlev+1:) = 0.0 <a name="l00906"></a>00906 <span class="keyword">write</span>(40) 333,0,iyear*10000+imonth*100+iday,0,nlon,nlat,nlev,ntru <a name="l00907"></a>00907 <span class="keyword">write</span>(40) zsig <a name="l00908"></a>00908 <span class="keyword">endif</span> <span class="comment">! (noutput > 0)</span> <a name="l00909"></a>00909 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span> <a name="l00910"></a>00910 return <a name="l00911"></a>00911 <span class="keyword">end subroutine prolog</span> <a name="l00912"></a>00912 <a name="l00913"></a>00913 <a name="l00914"></a>00914 <span class="comment">!===================!</span> <a name="l00915"></a>00915 <span class="comment">! SUBROUTINE MASTER !</span> <a name="l00916"></a>00916 <span class="comment">!================== !</span> <a name="l00917"></a>00917 <a name="l00918"></a><a class="code" href="puma_8f90.html#af02944c9cc5103c31e4ed9b779e7cc79">00918</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#af02944c9cc5103c31e4ed9b779e7cc79">master</a> <a name="l00919"></a>00919 use <span class="keywordflow">pumamod</span> <a name="l00920"></a>00920 <a name="l00921"></a>00921 <span class="keyword">if</span> (nshutdown > 0) return <span class="comment">! if something went wrong in prolog already</span> <a name="l00922"></a>00922 <a name="l00923"></a>00923 <span class="comment">! ***************************</span> <a name="l00924"></a>00924 <span class="comment">! * short initial timesteps *</span> <a name="l00925"></a>00925 <span class="comment">! ***************************</span> <a name="l00926"></a>00926 <a name="l00927"></a>00927 ikits = nkits <a name="l00928"></a>00928 <span class="keyword">do</span> jkits = 1 , ikits <a name="l00929"></a>00929 delt = (TWOPI/ntspd) / (2**nkits) <a name="l00930"></a>00930 delt2 = delt + delt <a name="l00931"></a>00931 call <a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a> <a name="l00932"></a>00932 call <a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">makebm</a> <a name="l00933"></a>00933 call <a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">spectral</a> <a name="l00934"></a>00934 nkits = nkits - 1 <a name="l00935"></a>00935 <span class="keyword">enddo</span> <a name="l00936"></a>00936 <a name="l00937"></a>00937 delt = TWOPI/ntspd <a name="l00938"></a>00938 delt2 = delt + delt <a name="l00939"></a>00939 call <a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">makebm</a> <a name="l00940"></a>00940 <a name="l00941"></a>00941 nstep1 = <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> <span class="comment">! remember 1.st timestep</span> <a name="l00942"></a>00942 <a name="l00943"></a>00943 <span class="keyword">do</span> jstep = 1 , nrun <a name="l00944"></a>00944 <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> = <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> + 1 <a name="l00945"></a>00945 call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(5),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(4),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(3),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(2),<a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(1)) <a name="l00946"></a>00946 <a name="l00947"></a>00947 <span class="comment">! ************************************************************</span> <a name="l00948"></a>00948 <span class="comment">! * calculation of non-linear quantities in grid point space *</span> <a name="l00949"></a>00949 <span class="comment">! ************************************************************</span> <a name="l00950"></a>00950 <a name="l00951"></a>00951 call <a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a> <a name="l00952"></a>00952 <a name="l00953"></a>00953 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00954"></a>00954 <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nafter) == 0 .and. noutput > 0) call <a class="code" href="puma_8f90.html#a0352cc6bbeedace31c54d9afba847ad6">outsp</a> <a name="l00955"></a>00955 <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag ) == 0 .or. ngui > 0) call <a class="code" href="puma_8f90.html#ad0981694b4fc7644f20d9ad785deba27">diag</a> <a name="l00956"></a>00956 <span class="keyword">if</span> (ncu > 0) call <a class="code" href="puma_8f90.html#ab608e12bdff55ab600a9d975673c5a53">checkunit</a> <a name="l00957"></a>00957 <span class="keyword">endif</span> <a name="l00958"></a>00958 <span class="keyword">if</span> (ngui > 0) call <a class="code" href="guimod_8f90.html#a71eb8e326967dca8aad8bc84d9f8ad72">guistep_puma</a> <a name="l00959"></a>00959 <a name="l00960"></a>00960 <span class="comment">! ******************************</span> <a name="l00961"></a>00961 <span class="comment">! * adiabatic part of timestep *</span> <a name="l00962"></a>00962 <span class="comment">! ******************************</span> <a name="l00963"></a>00963 <a name="l00964"></a>00964 call <a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">spectral</a> <a name="l00965"></a>00965 <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nafter) == 0 .and. noutput > 0) call <a class="code" href="puma_8f90.html#a1f5ebb3d7ab8cc007a6ed2d81b858f03">outgp</a> <a name="l00966"></a>00966 <span class="keyword">if</span> (nshutdown > 0) return <a name="l00967"></a>00967 <span class="keyword">enddo</span> <a name="l00968"></a>00968 return <a name="l00969"></a>00969 <span class="keyword">end subroutine master</span> <a name="l00970"></a>00970 <a name="l00971"></a>00971 <a name="l00972"></a>00972 <span class="comment">! =================</span> <a name="l00973"></a>00973 <span class="comment">! SUBROUTINE EPILOG</span> <a name="l00974"></a>00974 <span class="comment">! =================</span> <a name="l00975"></a>00975 <a name="l00976"></a><a class="code" href="puma_8f90.html#a35d7c22447dc50ab86832b4615994d32">00976</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a35d7c22447dc50ab86832b4615994d32">epilog</a> <a name="l00977"></a>00977 use <span class="keywordflow">pumamod</span> <a name="l00978"></a>00978 <span class="keywordtype">real (kind=8)</span> :: zut,zst <a name="l00979"></a>00979 <span class="keywordtype">integer (kind=8)</span> :: imem,ipr,ipf,isw,idr,idw <a name="l00980"></a>00980 <a name="l00981"></a>00981 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">close</span>(40) <span class="comment">! close output file</span> <a name="l00982"></a>00982 <a name="l00983"></a>00983 <span class="comment">! write restart file</span> <a name="l00984"></a>00984 <a name="l00985"></a>00985 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l00986"></a>00986 call <a class="code" href="restartmod_8f90.html#affb1e8d0fa727d359e1292ada8ba0f2b">restart_prepare</a>(puma_status) <a name="l00987"></a>00987 sp(1) = psmean <span class="comment">! save psmean</span> <a name="l00988"></a>00988 call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">'nstep'</span> ,<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> ) <a name="l00989"></a>00989 call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">'nlat'</span> ,NLAT ) <a name="l00990"></a>00990 call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">'nlon'</span> ,NLON ) <a name="l00991"></a>00991 call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">'nlev'</span> ,NLEV ) <a name="l00992"></a>00992 call <a class="code" href="restartmod_8f90.html#a16bdaf2753fbc691f99b0837e5de11db">put_restart_integer</a>(<span class="stringliteral">'nrsp'</span> ,NRSP ) <a name="l00993"></a>00993 <a name="l00994"></a>00994 <span class="comment">! Save current random number generator seed</span> <a name="l00995"></a>00995 <a name="l00996"></a>00996 call random_seed(get=meed) <a name="l00997"></a>00997 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'seed'</span>,meed,nseedlen,1,1) <a name="l00998"></a>00998 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'ganext'</span>,ganext,1,1,1) <a name="l00999"></a>00999 <a name="l01000"></a>01000 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'sz'</span> ,sz ,NRSP,NESP,NLEV) <a name="l01001"></a>01001 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'sd'</span> ,sd ,NRSP,NESP,NLEV) <a name="l01002"></a>01002 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'st'</span> ,st ,NRSP,NESP,NLEV) <a name="l01003"></a>01003 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'sr1'</span>,sr1,NRSP,NESP,NLEV) <a name="l01004"></a>01004 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'sr2'</span>,sr2,NRSP,NESP,NLEV) <a name="l01005"></a>01005 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'sp'</span> ,sp ,NRSP,NESP, 1) <a name="l01006"></a>01006 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'so'</span> ,so ,NRSP,NESP, 1) <a name="l01007"></a>01007 <span class="keyword">if</span> (nruido > 0) <span class="keyword">then</span> <a name="l01008"></a>01008 call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(<span class="stringliteral">'ruido'</span>,ruido,nugp,nugp,nlev) <a name="l01009"></a>01009 <span class="keyword">endif</span> <a name="l01010"></a>01010 <span class="keyword">endif</span> <a name="l01011"></a>01011 <a name="l01012"></a>01012 call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">'szm'</span>,szm,NSPP,NLEV) <a name="l01013"></a>01013 call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">'sdm'</span>,sdm,NSPP,NLEV) <a name="l01014"></a>01014 call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">'stm'</span>,stm,NSPP,NLEV) <a name="l01015"></a>01015 call <a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(<span class="stringliteral">'spm'</span>,spm,NSPP, 1) <a name="l01016"></a>01016 <a name="l01017"></a>01017 <span class="comment">! write gridpoint arrays</span> <a name="l01018"></a>01018 <a name="l01019"></a>01019 <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr1)) <span class="keyword">then</span> <a name="l01020"></a>01020 call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">'gr1'</span>,gr1,nhor,nlev) <a name="l01021"></a>01021 <span class="keyword">endif</span> <a name="l01022"></a>01022 <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr2)) <span class="keyword">then</span> <a name="l01023"></a>01023 call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">'gr2'</span>,gr2,nhor,nlev) <a name="l01024"></a>01024 <span class="keyword">endif</span> <a name="l01025"></a>01025 <span class="keyword">if</span> (<span class="keyword">allocated</span>(gtdamp)) <span class="keyword">then</span> <a name="l01026"></a>01026 call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">'gtdamp'</span>,gtdamp,nhor,nlev) <a name="l01027"></a>01027 <span class="keyword">endif</span> <a name="l01028"></a>01028 <a name="l01029"></a>01029 <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr1c)) <span class="keyword">then</span> <a name="l01030"></a>01030 call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">'gr1c'</span>,gr1c,nhor,nlev) <a name="l01031"></a>01031 <span class="keyword">endif</span> <a name="l01032"></a>01032 <span class="keyword">if</span> (<span class="keyword">allocated</span>(gr2c)) <span class="keyword">then</span> <a name="l01033"></a>01033 call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">'gr2c'</span>,gr2c,nhor,nlev) <a name="l01034"></a>01034 <span class="keyword">endif</span> <a name="l01035"></a>01035 <span class="keyword">if</span> (<span class="keyword">allocated</span>(gtdampc)) <span class="keyword">then</span> <a name="l01036"></a>01036 call <a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(<span class="stringliteral">'gtdampc'</span>,gtdampc,nhor,nlev) <a name="l01037"></a>01037 <span class="keyword">endif</span> <a name="l01038"></a>01038 <a name="l01039"></a>01039 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01040"></a>01040 <span class="comment">! Get resource stats from function resources in file pumax.c</span> <a name="l01041"></a>01041 ires = <a class="code" href="pumax_8c.html#a7e885dd959a1c4e56017782911c1f796">nresources</a>(zut,zst,imem,ipr,ipf,isw,idr,idw) <a name="l01042"></a>01042 call cpu_time(tmstop) <a name="l01043"></a>01043 tmrun = tmstop - tmstart <a name="l01044"></a>01044 <span class="keyword">if</span> (<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> > nstep1) <span class="keyword">then</span> <a name="l01045"></a>01045 zspy = tmrun * 360.0 * <span class="keywordtype">real(ntspd)</span> / (nstep - nstep1) <span class="comment">! sec / siy</span> <a name="l01046"></a>01046 zypd = (24.0 * 3600.0 / zspy) <span class="comment">! siy / day</span> <a name="l01047"></a>01047 <span class="keyword">write</span>(nud,<span class="stringliteral">'(/,"****************************************")'</span>) <a name="l01048"></a>01048 <span class="keyword">if</span> (zut > 0.0) & <a name="l01049"></a>01049 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* User time : ", f10.3," sec *")'</span>) zut <a name="l01050"></a>01050 <span class="keyword">if</span> (zst > 0.0) & <a name="l01051"></a>01051 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* System time : ", f10.3," sec *")'</span>) zst <a name="l01052"></a>01052 <span class="keyword">if</span> (zut + zst > 0.0) tmrun = zut + zst <a name="l01053"></a>01053 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Total CPU time : ", f10.3," sec *")'</span>) tmrun <a name="l01054"></a>01054 <span class="keyword">if</span> (imem > 0) & <a name="l01055"></a>01055 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Memory usage : ", f10.3," MB *")'</span>) imem * 0.000001 <a name="l01056"></a>01056 <span class="keyword">if</span> (ipr > 0) & <a name="l01057"></a>01057 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Page reclaims : ", i6," pages *")'</span>) ipr <a name="l01058"></a>01058 <span class="keyword">if</span> (ipf > 0) & <a name="l01059"></a>01059 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Page faults : ", i6," pages *")'</span>) ipf <a name="l01060"></a>01060 <span class="keyword">if</span> (isw > 0) & <a name="l01061"></a>01061 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Page swaps : ", i6," pages *")'</span>) isw <a name="l01062"></a>01062 <span class="keyword">if</span> (idr > 0) & <a name="l01063"></a>01063 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Disk read : ", i6," blocks *")'</span>) idr <a name="l01064"></a>01064 <span class="keyword">if</span> (idw > 0) & <a name="l01065"></a>01065 <span class="keyword">write</span>(nud, <span class="stringliteral">'("* Disk write : ", i6," blocks *")'</span>) idw <a name="l01066"></a>01066 <span class="keyword">write</span>(nud,<span class="stringliteral">'("****************************************")'</span>) <a name="l01067"></a>01067 <span class="keyword">if</span> (zspy < 600.0) <span class="keyword">then</span> <a name="l01068"></a>01068 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* Seconds per sim year: ",i6,9x,"*")'</span>) nint(zspy) <a name="l01069"></a>01069 <span class="keyword">else</span> <span class="keyword">if</span> (zspy < 900000.0) <span class="keyword">then</span> <a name="l01070"></a>01070 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* Minutes per sim year ",i6,9x,"*")'</span>) nint(zspy/60.0) <a name="l01071"></a>01071 <span class="keyword">else</span> <a name="l01072"></a>01072 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* Days per sim year: ",i6,5x,"*")'</span>) nint(zspy/86400.0) <a name="l01073"></a>01073 <span class="keyword">endif</span> <a name="l01074"></a>01074 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* Sim years per day :",i7,9x,"*")'</span>) nint(zypd) <a name="l01075"></a>01075 <span class="keyword">write</span>(nud,<span class="stringliteral">'("****************************************")'</span>) <a name="l01076"></a>01076 <span class="keyword">endif</span> <a name="l01077"></a>01077 <span class="keyword">endif</span> <a name="l01078"></a>01078 <a name="l01079"></a>01079 return <a name="l01080"></a>01080 <span class="keyword"> end subroutine epilog</span> <a name="l01081"></a>01081 <a name="l01082"></a>01082 <span class="comment">! =============================</span> <a name="l01083"></a>01083 <span class="comment">! SUBROUTINE READ_ATMOS_RESTART</span> <a name="l01084"></a>01084 <span class="comment">! =============================</span> <a name="l01085"></a>01085 <a name="l01086"></a><a class="code" href="puma_8f90.html#aa07fedd638dbdd8e1799b83d34eb35e3">01086</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aa07fedd638dbdd8e1799b83d34eb35e3">read_atmos_restart</a> <a name="l01087"></a>01087 use <span class="keywordflow">pumamod</span> <a name="l01088"></a>01088 <a name="l01089"></a>01089 <span class="keywordtype">integer</span> :: k = 0 <a name="l01090"></a>01090 <a name="l01091"></a>01091 <span class="comment">! read scalars and full spectral arrays</span> <a name="l01092"></a>01092 <a name="l01093"></a>01093 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01094"></a>01094 call <a class="code" href="restartmod_8f90.html#a31b0dacd7c45db47ddaedb4d402b44ba">get_restart_integer</a>(<span class="stringliteral">'nstep'</span>,<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>) <a name="l01095"></a>01095 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'seed'</span>,meed,nseedlen,1,1) <a name="l01096"></a>01096 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'ganext'</span>,ganext,1,1,1) <a name="l01097"></a>01097 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'sz'</span> ,sz ,NRSP,NESP,NLEV) <a name="l01098"></a>01098 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'sd'</span> ,sd ,NRSP,NESP,NLEV) <a name="l01099"></a>01099 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'st'</span> ,st ,NRSP,NESP,NLEV) <a name="l01100"></a>01100 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'sr1'</span>,sr1,NRSP,NESP,NLEV) <a name="l01101"></a>01101 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'sr2'</span>,sr2,NRSP,NESP,NLEV) <a name="l01102"></a>01102 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'sp'</span> ,sp ,NRSP,NESP, 1) <a name="l01103"></a>01103 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'so'</span> ,so ,NRSP,NESP, 1) <a name="l01104"></a>01104 <span class="keyword">if</span> (nruido > 0) <span class="keyword">then</span> <a name="l01105"></a>01105 call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(<span class="stringliteral">'ruido'</span>,ruido,nugp,nugp,nlev) <a name="l01106"></a>01106 <span class="keyword">endif</span> <a name="l01107"></a>01107 psmean = sp(1) <a name="l01108"></a>01108 sp(1) = 0.0 <a name="l01109"></a>01109 call random_seed(put=meed) <a name="l01110"></a>01110 <span class="keyword">endif</span> <a name="l01111"></a>01111 <a name="l01112"></a>01112 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>) <span class="comment">! broadcast current timestep</span> <a name="l01113"></a>01113 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(psmean) <span class="comment">! broadcast mean surface pressure</span> <a name="l01114"></a>01114 <a name="l01115"></a>01115 <span class="comment">! read and scatter spectral arrays</span> <a name="l01116"></a>01116 <a name="l01117"></a>01117 call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">'szm'</span>,szm,NSPP,NLEV) <a name="l01118"></a>01118 call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">'sdm'</span>,sdm,NSPP,NLEV) <a name="l01119"></a>01119 call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">'stm'</span>,stm,NSPP,NLEV) <a name="l01120"></a>01120 call <a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(<span class="stringliteral">'spm'</span>,spm,NSPP, 1) <a name="l01121"></a>01121 <a name="l01122"></a>01122 <span class="comment">! allocate, read and scatter gridpoint arrays</span> <a name="l01123"></a>01123 <a name="l01124"></a>01124 <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">'gr1'</span>,ktmp) <a name="l01125"></a>01125 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp) <a name="l01126"></a>01126 <span class="keyword">if</span> (ktmp > 0) <span class="keyword">then</span> <a name="l01127"></a>01127 <span class="keyword">allocate</span>(gr1(nhor,nlev)) <a name="l01128"></a>01128 call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">'gr1'</span>,gr1,nhor,nlev) <a name="l01129"></a>01129 <span class="keyword">endif</span> <a name="l01130"></a>01130 <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">'gr2'</span>,ktmp) <a name="l01131"></a>01131 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp) <a name="l01132"></a>01132 <span class="keyword">if</span> (ktmp > 0) <span class="keyword">then</span> <a name="l01133"></a>01133 <span class="keyword">allocate</span>(gr2(nhor,nlev)) <a name="l01134"></a>01134 call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">'gr2'</span>,gr2,nhor,nlev) <a name="l01135"></a>01135 <span class="keyword">endif</span> <a name="l01136"></a>01136 <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">'gtdamp'</span>,ktmp) <a name="l01137"></a>01137 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp) <a name="l01138"></a>01138 <span class="keyword">if</span> (ktmp > 0) <span class="keyword">then</span> <a name="l01139"></a>01139 <span class="keyword">allocate</span>(gtdamp(nhor,nlev)) <a name="l01140"></a>01140 call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">'gtdamp'</span>,gtdamp,nhor,nlev) <a name="l01141"></a>01141 <span class="keyword">endif</span> <a name="l01142"></a>01142 <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">'gr1c'</span>,ktmp) <a name="l01143"></a>01143 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp) <a name="l01144"></a>01144 <span class="keyword">if</span> (ktmp > 0) <span class="keyword">then</span> <a name="l01145"></a>01145 <span class="keyword">allocate</span>(gr1c(nhor,nlev)) <a name="l01146"></a>01146 call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">'gr1c'</span>,gr1c,nhor,nlev) <a name="l01147"></a>01147 <span class="keyword">endif</span> <a name="l01148"></a>01148 <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">'gr2c'</span>,ktmp) <a name="l01149"></a>01149 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp) <a name="l01150"></a>01150 <span class="keyword">if</span> (ktmp > 0) <span class="keyword">then</span> <a name="l01151"></a>01151 <span class="keyword">allocate</span>(gr2c(nhor,nlev)) <a name="l01152"></a>01152 call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">'gr2c'</span>,gr2c,nhor,nlev) <a name="l01153"></a>01153 <span class="keyword">endif</span> <a name="l01154"></a>01154 <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a715f93e4ee50830196f64c403c7bdeed">varseek</a>(<span class="stringliteral">'gtdampc'</span>,ktmp) <a name="l01155"></a>01155 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(ktmp) <a name="l01156"></a>01156 <span class="keyword">if</span> (ktmp > 0) <span class="keyword">then</span> <a name="l01157"></a>01157 <span class="keyword">allocate</span>(gtdampc(nhor,nlev)) <a name="l01158"></a>01158 call <a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(<span class="stringliteral">'gtdampc'</span>,gtdampc,nhor,nlev) <a name="l01159"></a>01159 <span class="keyword">endif</span> <a name="l01160"></a>01160 <a name="l01161"></a>01161 return <a name="l01162"></a>01162 <span class="keyword"> end subroutine read_atmos_restart</span> <a name="l01163"></a>01163 <a name="l01164"></a>01164 <span class="comment">! =================</span> <a name="l01165"></a>01165 <span class="comment">! SUBROUTINE INITFD</span> <a name="l01166"></a>01166 <span class="comment">! =================</span> <a name="l01167"></a>01167 <a name="l01168"></a><a class="code" href="puma_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">01168</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a51f5938296dd343ce807dbb6d1a16e49">initfd</a> <a name="l01169"></a>01169 use <span class="keywordflow">pumamod</span> <a name="l01170"></a>01170 <a name="l01171"></a>01171 <span class="keyword">if</span> (nkits < 1) nkits = 1 <a name="l01172"></a>01172 <a name="l01173"></a>01173 <span class="comment">! Look for start data and read them if there</span> <a name="l01174"></a>01174 <a name="l01175"></a>01175 call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(129,so, 1,iread1) <a name="l01176"></a>01176 call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(134,sp, 1,iread2) <a name="l01177"></a>01177 call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(121,sr1,NLEV,iread3) <a name="l01178"></a>01178 call <a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(122,sr2,NLEV,iread4) <a name="l01179"></a>01179 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(123,NLEV,iread123) <a name="l01180"></a>01180 <span class="keyword">if</span> (mypid == NROOT .and. iread123 == 0) <span class="keyword">then</span> <a name="l01181"></a>01181 <span class="keyword">if</span> (nhelsua > 1) <span class="keyword">then</span> <a name="l01182"></a>01182 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR no *_surf_0123.sra file for Held&Suarez"</span> <a name="l01183"></a>01183 stop <a name="l01184"></a>01184 <span class="keyword">endif</span> <a name="l01185"></a>01185 <span class="keyword">endif</span> <a name="l01186"></a>01186 <a name="l01187"></a>01187 <span class="keyword">if</span> (ndiagp > 0) <span class="keyword">then</span> <a name="l01188"></a>01188 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(121,NLEV,iread121) <a name="l01189"></a>01189 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(122,NLEV,iread122) <a name="l01190"></a>01190 <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(gtdamp)) <span class="keyword">then</span> <a name="l01191"></a>01191 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(123,NLEV,iread123) <a name="l01192"></a>01192 <span class="keyword">endif</span> <a name="l01193"></a>01193 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01194"></a>01194 <span class="keyword">if</span> (iread121==0 .or. iread122==0 .or. iread123==0) <span class="keyword">then</span> <a name="l01195"></a>01195 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR not all fields (121,122,123) for grid point heating found"</span> <a name="l01196"></a>01196 stop <a name="l01197"></a>01197 <span class="keyword">endif</span> <a name="l01198"></a>01198 <span class="keyword">endif</span> <a name="l01199"></a>01199 <span class="keyword">endif</span> <a name="l01200"></a>01200 <a name="l01201"></a>01201 <span class="keyword">if</span> (nconv > 0) <span class="keyword">then</span> <a name="l01202"></a>01202 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(124,NLEV,iread124) <a name="l01203"></a>01203 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(125,NLEV,iread125) <a name="l01204"></a>01204 call <a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(126,NLEV,iread126) <a name="l01205"></a>01205 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01206"></a>01206 <span class="keyword">if</span> (iread124==0 .or. iread125==0 .or. iread126==0) <span class="keyword">then</span> <a name="l01207"></a>01207 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR not all fields (124,125,126) for convective heating found"</span> <a name="l01208"></a>01208 stop <a name="l01209"></a>01209 <span class="keyword">endif</span> <a name="l01210"></a>01210 <span class="keyword">endif</span> <a name="l01211"></a>01211 <span class="keyword">endif</span> <a name="l01212"></a>01212 <a name="l01213"></a>01213 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01214"></a>01214 <span class="keyword">if</span> (iread1==0 .or. iread2==0 .or. iread3==0 .or. iread4==0) <span class="keyword">then</span> <a name="l01215"></a>01215 call <a class="code" href="puma_8f90.html#a4a662c6d6619fc6405eb110f62653dc0">setzt</a> <span class="comment">! setup for aqua-planet</span> <a name="l01216"></a>01216 <span class="keyword">else</span> <a name="l01217"></a>01217 psmean = psurf * exp(spnorm(1) * sp(1)) <a name="l01218"></a>01218 sp(1) = 0.0 <a name="l01219"></a>01219 so(:) = so(:) / (cv * cv) <span class="comment">! descale from [m2/s2]</span> <a name="l01220"></a>01220 sr1(:,:) = sr1(:,:) / ct <span class="comment">! descale from [K]</span> <a name="l01221"></a>01221 sr2(:,:) = sr2(:,:) / ct <span class="comment">! descale from [K]</span> <a name="l01222"></a>01222 sr1(1,:) = sr1(1,:) - t0(:) * sqrt(2.0) <span class="comment">! subtract profile</span> <a name="l01223"></a>01223 <span class="keyword">write</span>(nud,<span class="stringliteral">'(a,f8.2,a)'</span>) <span class="stringliteral">' Mean of Ps = '</span>,0.01*psmean, <span class="stringliteral">'[hPa]'</span> <a name="l01224"></a>01224 <span class="keyword">endif</span> <a name="l01225"></a>01225 <span class="keyword">endif</span> <a name="l01226"></a>01226 <a name="l01227"></a>01227 <span class="comment">! Add initial noise if wanted</span> <a name="l01228"></a>01228 <a name="l01229"></a>01229 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01230"></a>01230 call <a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">printprofile</a> <a name="l01231"></a>01231 <span class="keyword">if</span> (kick > 10) <span class="keyword">then</span> <a name="l01232"></a>01232 call <a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kick-10) <a name="l01233"></a>01233 <span class="keyword">else</span> <a name="l01234"></a>01234 call <a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kick) <a name="l01235"></a>01235 <span class="keyword">endif</span> <a name="l01236"></a>01236 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span> <a name="l01237"></a>01237 <a name="l01238"></a>01238 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sp,spm,1) <a name="l01239"></a>01239 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01240"></a>01240 st(1,:) = sr1(1,:) <a name="l01241"></a>01241 stm(1,:) = sr1(1,:) <a name="l01242"></a>01242 sz(3,:) = plavor <a name="l01243"></a>01243 szm(3,:) = plavor <a name="l01244"></a>01244 <span class="keyword">endif</span> <a name="l01245"></a>01245 return <a name="l01246"></a>01246 <span class="keyword"> end</span> <a name="l01247"></a>01247 <a name="l01248"></a>01248 <a name="l01249"></a>01249 <span class="comment">! ==========================</span> <a name="l01250"></a>01250 <span class="comment">! SUBROUTINE READ_RESOLUTION</span> <a name="l01251"></a>01251 <span class="comment">! ==========================</span> <a name="l01252"></a>01252 <a name="l01253"></a><a class="code" href="puma_8f90.html#a811c67568d6f12806d6b6f86813d2bc4">01253</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a811c67568d6f12806d6b6f86813d2bc4">read_resolution</a> <a name="l01254"></a>01254 use <span class="keywordflow">pumamod</span> <a name="l01255"></a>01255 <a name="l01256"></a>01256 <span class="keywordtype">character (80)</span> :: ylat <a name="l01257"></a>01257 <span class="keywordtype">character (80)</span> :: ylev <a name="l01258"></a>01258 <a name="l01259"></a>01259 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01260"></a>01260 call get_command_argument(1,ylat) <a name="l01261"></a>01261 call get_command_argument(2,ylev) <a name="l01262"></a>01262 <span class="keyword">read</span>(ylat,*) nlat <a name="l01263"></a>01263 <span class="keyword">read</span>(ylev,*) nlev <a name="l01264"></a>01264 <span class="keyword">endif</span> <a name="l01265"></a>01265 <a name="l01266"></a>01266 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nlat) <a name="l01267"></a>01267 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nlev) <a name="l01268"></a>01268 return <a name="l01269"></a>01269 <span class="keyword"> end</span> <a name="l01270"></a>01270 <a name="l01271"></a>01271 <a name="l01272"></a>01272 <span class="comment">! =====================</span> <a name="l01273"></a>01273 <span class="comment">! SUBROUTINE RESOLUTION</span> <a name="l01274"></a>01274 <span class="comment">! =====================</span> <a name="l01275"></a>01275 <a name="l01276"></a><a class="code" href="puma_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">01276</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a0952e51b37b6196b4f5d85a5cb93c75b">resolution</a> <a name="l01277"></a>01277 use <span class="keywordflow">pumamod</span> <a name="l01278"></a>01278 <a name="l01279"></a>01279 nlem = nlev - 1 <a name="l01280"></a>01280 nlep = nlev + 1 <a name="l01281"></a>01281 nlsq = nlev * nlev <a name="l01282"></a>01282 <a name="l01283"></a>01283 nlon = nlat + nlat <span class="comment">! Longitudes</span> <a name="l01284"></a>01284 nlah = nlat / 2 <a name="l01285"></a>01285 nlpp = nlat / npro <a name="l01286"></a>01286 nhpp = nlah / npro <a name="l01287"></a>01287 nhor = nlon * nlpp <a name="l01288"></a>01288 nugp = nlon * nlat <a name="l01289"></a>01289 npgp = nugp / 2 <a name="l01290"></a>01290 <a name="l01291"></a>01291 ntru = (nlon - 1) / 3 <a name="l01292"></a>01292 ntp1 = ntru + 1 <a name="l01293"></a>01293 nzom = ntp1 + ntp1 <a name="l01294"></a>01294 nrsp = (ntru + 1) * (ntru + 2) <a name="l01295"></a>01295 ncsp = nrsp / 2 <a name="l01296"></a>01296 nspp = (nrsp + npro - 1) / npro <a name="l01297"></a>01297 nesp = nspp * npro <a name="l01298"></a>01298 <a name="l01299"></a>01299 return <a name="l01300"></a>01300 <span class="keyword"> end</span> <a name="l01301"></a>01301 <a name="l01302"></a>01302 <a name="l01303"></a>01303 <span class="comment">! =================</span> <a name="l01304"></a>01304 <span class="comment">! SUBROUTINE READNL</span> <a name="l01305"></a>01305 <span class="comment">! =================</span> <a name="l01306"></a>01306 <a name="l01307"></a><a class="code" href="puma_8f90.html#a8a75958ca9ba25aeec49db140b483871">01307</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a8a75958ca9ba25aeec49db140b483871">readnl</a> <a name="l01308"></a>01308 use <span class="keywordflow">pumamod</span> <a name="l01309"></a>01309 <a name="l01310"></a>01310 <span class="comment">! This workaround is necessaray, because allocatable arrays are</span> <a name="l01311"></a>01311 <span class="comment">! not allowed in namelists for FORTRAN versions < F2003</span> <a name="l01312"></a>01312 <a name="l01313"></a>01313 <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXLEV = 100 <a name="l01314"></a>01314 <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXSELZW = 42 <a name="l01315"></a>01315 <span class="keywordtype">integer</span>, <span class="keywordtype">parameter</span> :: MAXSELSP = ((MAXSELZW+1) * (MAXSELZW+2)) / 2 <a name="l01316"></a>01316 <span class="keywordtype">integer</span> :: nselect(0:MAXSELZW) = 1 <span class="comment">! NSELECT can be used up tp T42</span> <a name="l01317"></a>01317 <span class="keywordtype">integer</span> :: nspecsel(MAXSELSP) = 1 <span class="comment">! Default setting: all modes active</span> <a name="l01318"></a>01318 <span class="keywordtype">integer</span> :: ndl(MAXLEV) = 0 <span class="comment">! Diagnostics off</span> <a name="l01319"></a>01319 <span class="keywordtype">real</span> :: restim(MAXLEV) = 0.0 <span class="comment">! Tau R</span> <a name="l01320"></a>01320 <span class="keywordtype">real</span> :: sigmah(MAXLEV) = 0.0 <span class="comment">! Half level sigma</span> <a name="l01321"></a>01321 <span class="keywordtype">real</span> :: t0k(MAXLEV) = 250.0 <span class="comment">! Reference temperature</span> <a name="l01322"></a>01322 <span class="keywordtype">real</span> :: tfrc(MAXLEV) = 0.0 <span class="comment">! Tau F</span> <a name="l01323"></a>01323 <a name="l01324"></a>01324 namelist /inp/ & <a name="l01325"></a>01325 akap , alpha , alr , alrs , disp , dtep & <a name="l01326"></a>01326 , dtns , dtrop , dttrp , dtzz , dvdiff & <a name="l01327"></a>01327 , ga , gascon & <a name="l01328"></a>01328 , kick , mpstep , nafter , ncoeff , nconv , ncu & <a name="l01329"></a>01329 , ndel , ndheat , ndiag , ndiagp , ndl , nenergy & <a name="l01330"></a>01330 , nentropy, nextout , ngui , nguidbg , nhelsua , nkits & <a name="l01331"></a>01331 , nlevt , nmonths , noutput , nradcv , nruido , nrun & <a name="l01332"></a>01332 , nselect , nspecsel, nsponge , <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a> , nstop , nsync & <a name="l01333"></a>01333 , ntspd , nvg , nwpd , nwspini , nyears & <a name="l01334"></a>01334 , orofac , pac , plarad , pspon , psurf , restim & <a name="l01335"></a>01335 , rotspd , seed , sid_day , sigmah , sigmax , sponk & <a name="l01336"></a>01336 , syncstr , synctime, t0k & <a name="l01337"></a>01337 , tac , tauta , tauts , tdiss , tfrc , tgr <a name="l01338"></a>01338 <a name="l01339"></a>01339 <span class="keyword">open</span>(13,file=puma_namelist,iostat=ios) <a name="l01340"></a>01340 <span class="keyword">if</span> (ios == 0) <span class="keyword">then</span> <a name="l01341"></a>01341 <span class="keyword">read</span> (13,inp) <a name="l01342"></a>01342 <span class="keyword">close</span>(13) <a name="l01343"></a>01343 <span class="keyword">endif</span> <a name="l01344"></a>01344 <a name="l01345"></a>01345 <span class="comment">!--- modify basic scales according to namelist </span> <a name="l01346"></a>01346 ww = TWOPI/sid_day <span class="comment">! reciprocal of time scale 1/Omega</span> <a name="l01347"></a>01347 cv = plarad*ww <span class="comment">! velocity scale (velocity at the equator)</span> <a name="l01348"></a>01348 ct = cv*cv/gascon <span class="comment">! temperature scale from hydrostatic equation </span> <a name="l01349"></a>01349 <span class="keyword">if</span> (ntspd == 0) ntspd = (24 * nlat) / 32 <span class="comment">! automatic</span> <a name="l01350"></a>01350 <span class="keyword">if</span> (mpstep > 0) ntspd = 1440 / mpstep <a name="l01351"></a>01351 mpstep = 1440 / ntspd <a name="l01352"></a>01352 nafter = ntspd <span class="comment">! daily output</span> <a name="l01353"></a>01353 <span class="keyword">if</span> (nwpd > 0 .and. nwpd <= ntspd) <span class="keyword">then</span> <a name="l01354"></a>01354 nafter = ntspd / nwpd <a name="l01355"></a>01355 <span class="keyword">endif</span> <a name="l01356"></a>01356 <span class="keyword">if</span> (ndiag < 1) ndiag = ntspd * 10 <span class="comment">! every 10th. day</span> <a name="l01357"></a>01357 <a name="l01358"></a>01358 <span class="keyword">if</span> (synctime > 0.0) syncstr = 1.0 / (TWOPI * synctime) <a name="l01359"></a>01359 <a name="l01360"></a>01360 <span class="keyword">write</span>(nud,inp) <a name="l01361"></a>01361 <a name="l01362"></a>01362 itru = ntru <a name="l01363"></a>01363 <span class="keyword">if</span> (itru > MAXSELZW) itru = MAXSELZW <a name="l01364"></a>01364 icsp = ncsp <a name="l01365"></a>01365 <span class="keyword">if</span> (icsp > MAXSELSP) icsp = MAXSELSP <a name="l01366"></a>01366 ilev = nlev <a name="l01367"></a>01367 <span class="keyword">if</span> (ilev > MAXLEV) ilev = MAXLEV <a name="l01368"></a>01368 <a name="l01369"></a>01369 nselzw(0:itru) = nselect(0:itru) <span class="comment">! Copy values to allocated array</span> <a name="l01370"></a>01370 nselsp(1:icsp) = nspecsel(1:icsp) <a name="l01371"></a>01371 ndil(1:ilev) = ndl(1:ilev) <a name="l01372"></a>01372 taur(1:ilev) = restim(1:ilev) <a name="l01373"></a>01373 tauf(1:ilev) = tfrc(1:ilev) <a name="l01374"></a>01374 sigmh(1:ilev) = sigmah(1:ilev) <a name="l01375"></a>01375 t0(1:ilev) = t0k(1:ilev) <a name="l01376"></a>01376 <a name="l01377"></a>01377 return <a name="l01378"></a>01378 <span class="keyword"> end</span> <a name="l01379"></a>01379 <a name="l01380"></a>01380 <a name="l01381"></a>01381 <span class="comment">! ======================</span> <a name="l01382"></a>01382 <span class="comment">! SUBROUTINE PPP_DEF_INT</span> <a name="l01383"></a>01383 <span class="comment">! ======================</span> <a name="l01384"></a>01384 <a name="l01385"></a><a class="code" href="puma_8f90.html#ad3f0e22c057591beabda5d99c3f40c4c">01385</a> <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(pname,nvar,ndim) <a name="l01386"></a>01386 use <span class="keywordflow">prepmod</span> <a name="l01387"></a>01387 <a name="l01388"></a>01388 <span class="keywordtype">character (*)</span> :: pname <a name="l01389"></a>01389 <span class="keywordtype">integer</span>,<span class="keywordtype">target</span> :: nvar <a name="l01390"></a>01390 <a name="l01391"></a>01391 num_ppp = num_ppp + 1 <a name="l01392"></a>01392 ppp_tab(num_ppp)%name = <span class="stringliteral">'['</span> // trim(pname) // <span class="stringliteral">']'</span> <a name="l01393"></a>01393 ppp_tab(num_ppp)%isint = .true. <a name="l01394"></a>01394 ppp_tab(num_ppp)%n = ndim <a name="l01395"></a>01395 ppp_tab(num_ppp)%pint => nvar <a name="l01396"></a>01396 ppp_tab(num_ppp)%preal => null() <a name="l01397"></a>01397 return <a name="l01398"></a>01398 <span class="keyword"> end subroutine ppp_def_int</span> <a name="l01399"></a>01399 <a name="l01400"></a>01400 <a name="l01401"></a>01401 <span class="comment">! =======================</span> <a name="l01402"></a>01402 <span class="comment">! SUBROUTINE PPP_DEF_REAL</span> <a name="l01403"></a>01403 <span class="comment">! =======================</span> <a name="l01404"></a>01404 <a name="l01405"></a><a class="code" href="puma_8f90.html#a3e4cf6a68be16437f50762bf77e52370">01405</a> <span class="keyword">subroutine </span><a class="code" href="interfaceprepmod_1_1ppp__def__real.html">ppp_def_real</a>(pname,rvar,ndim) <a name="l01406"></a>01406 use <span class="keywordflow">prepmod</span> <a name="l01407"></a>01407 <span class="keywordtype">character (*)</span> :: pname <a name="l01408"></a>01408 <span class="keywordtype">real</span> ,<span class="keywordtype">target</span> :: rvar <a name="l01409"></a>01409 <a name="l01410"></a>01410 num_ppp = num_ppp + 1 <a name="l01411"></a>01411 ppp_tab(num_ppp)%name = <span class="stringliteral">'['</span> // trim(pname) // <span class="stringliteral">']'</span> <a name="l01412"></a>01412 ppp_tab(num_ppp)%isint = .false. <a name="l01413"></a>01413 ppp_tab(num_ppp)%n = ndim <a name="l01414"></a>01414 ppp_tab(num_ppp)%pint => null() <a name="l01415"></a>01415 ppp_tab(num_ppp)%preal => rvar <a name="l01416"></a>01416 return <a name="l01417"></a>01417 <span class="keyword"> end subroutine ppp_def_real</span> <a name="l01418"></a>01418 <a name="l01419"></a>01419 <a name="l01420"></a><a class="code" href="puma_8f90.html#a4c83f2cca37be70c03946309fc4e2a52">01420</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a4c83f2cca37be70c03946309fc4e2a52">ppp_read_i</a>(a,ndim,nread) <a name="l01421"></a>01421 <span class="keywordtype">integer</span> :: a(ndim) <a name="l01422"></a>01422 <span class="keywordtype">integer</span> :: n <a name="l01423"></a>01423 <a name="l01424"></a>01424 nread = 0 <a name="l01425"></a>01425 <span class="keyword">read</span> (15,*) n <a name="l01426"></a>01426 <span class="keyword">if</span> (n < 1 .or. n > ndim) return <a name="l01427"></a>01427 <span class="keyword">read</span> (15,*) a(1:n) <a name="l01428"></a>01428 nread = n <a name="l01429"></a>01429 return <a name="l01430"></a>01430 <span class="keyword"> end</span> <a name="l01431"></a>01431 <a name="l01432"></a>01432 <a name="l01433"></a><a class="code" href="puma_8f90.html#a1e7bdf5ee1faa40d34b6cc93ebc3acc3">01433</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a1e7bdf5ee1faa40d34b6cc93ebc3acc3">ppp_read_r</a>(a,ndim,nread) <a name="l01434"></a>01434 <span class="keywordtype">real</span> :: a(ndim) <a name="l01435"></a>01435 <span class="keywordtype">integer</span> :: n <a name="l01436"></a>01436 <a name="l01437"></a>01437 nread = 0 <a name="l01438"></a>01438 <span class="keyword">read</span> (15,*) n <a name="l01439"></a>01439 <span class="keyword">if</span> (n < 1 .or. n > ndim) return <a name="l01440"></a>01440 <span class="keyword">read</span> (15,*) a(1:n) <a name="l01441"></a>01441 nread = n <a name="l01442"></a>01442 return <a name="l01443"></a>01443 <span class="keyword"> end</span> <a name="l01444"></a>01444 <a name="l01445"></a>01445 <a name="l01446"></a>01446 <span class="comment">! ========================</span> <a name="l01447"></a>01447 <span class="comment">! SUBROUTINE PPP_INTERFACE</span> <a name="l01448"></a>01448 <span class="comment">! ========================</span> <a name="l01449"></a>01449 <a name="l01450"></a><a class="code" href="puma_8f90.html#a859f80933ca252bcc87f27d3996fea05">01450</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a859f80933ca252bcc87f27d3996fea05">ppp_interface</a> <a name="l01451"></a>01451 use <span class="keywordflow">pumamod</span> <a name="l01452"></a>01452 use <span class="keywordflow">prepmod</span> <a name="l01453"></a>01453 <span class="keywordtype">logical</span> :: lexist <a name="l01454"></a>01454 <span class="keywordtype">integer</span> :: iostat <a name="l01455"></a>01455 <span class="keywordtype">integer</span> :: n <a name="l01456"></a>01456 <span class="keywordtype">integer</span> :: ivar <a name="l01457"></a>01457 <span class="keywordtype">character (80)</span> :: yname <a name="l01458"></a>01458 <a name="l01459"></a>01459 <span class="keyword">inquire</span>(file=ppp_puma_txt,exist=lexist) <a name="l01460"></a>01460 <span class="keyword">if</span> (.not. lexist) return <a name="l01461"></a>01461 <a name="l01462"></a>01462 call <a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(<span class="stringliteral">'NLAT'</span>,nlat_ppp,1) <a name="l01463"></a>01463 call <a class="code" href="interfaceprepmod_1_1ppp__def__int.html">ppp_def_int</a>(<span class="stringliteral">'NLEV'</span>,nlev_ppp,1) <a name="l01464"></a>01464 <a name="l01465"></a>01465 call <a class="code" href="interfaceprepmod_1_1ppp__def__real.html">ppp_def_real</a>(<span class="stringliteral">'SIGMH'</span>,sigmh,nlev) <a name="l01466"></a>01466 <a name="l01467"></a>01467 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*******************************"</span> <a name="l01468"></a>01468 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"* Reading file <"</span>,trim(ppp_puma_txt),<span class="stringliteral">"> *"</span> <a name="l01469"></a>01469 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*******************************"</span> <a name="l01470"></a>01470 <span class="keyword">open</span> (15,file=ppp_puma_txt) <a name="l01471"></a>01471 <span class="keyword">read</span> (15,<span class="stringliteral">'(A)'</span>,iostat=iostat) yname <a name="l01472"></a>01472 <span class="keyword">do</span> <span class="keyword">while</span> (trim(yname) /= <span class="stringliteral">'[END]'</span> .and. iostat == 0) <a name="l01473"></a>01473 <span class="keyword">do</span> j = 1 , num_ppp <a name="l01474"></a>01474 <span class="keyword">if</span> (trim(yname) == ppp_tab(j)%name) <span class="keyword">then</span> <a name="l01475"></a>01475 <span class="keyword">if</span> (ppp_tab(j)%isint) <span class="keyword">then</span> <a name="l01476"></a>01476 call <a class="code" href="puma_8f90.html#a4c83f2cca37be70c03946309fc4e2a52">ppp_read_i</a>(ppp_tab(j)%pint,ppp_tab(j)%n,iread) <a name="l01477"></a>01477 <span class="keyword">if</span> (iread == 0) <span class="keyword">then</span> <a name="l01478"></a>01478 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR reading "</span>,trim(yname),<span class="stringliteral">" from "</span>,trim(ppp_puma_txt) <a name="l01479"></a>01479 stop <a name="l01480"></a>01480 <span class="keyword">else</span> <span class="keyword">if</span> (iread == 1) <span class="keyword">then</span> <a name="l01481"></a>01481 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* ",A," = ",I10," *")'</span>) yname(1:15),ppp_tab(j)%pint <a name="l01482"></a>01482 <span class="keyword">else</span> <a name="l01483"></a>01483 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* ",A," :",I5," items *")'</span>) yname(1:15),iread <a name="l01484"></a>01484 <span class="keyword">endif</span> <a name="l01485"></a>01485 <span class="keyword">else</span> <a name="l01486"></a>01486 call <a class="code" href="puma_8f90.html#a1e7bdf5ee1faa40d34b6cc93ebc3acc3">ppp_read_r</a>(ppp_tab(j)%preal,ppp_tab(j)%n,iread) <a name="l01487"></a>01487 <span class="keyword">if</span> (iread == 0) <span class="keyword">then</span> <a name="l01488"></a>01488 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR reading "</span>,trim(yname),<span class="stringliteral">" from "</span>,trim(ppp_puma_txt) <a name="l01489"></a>01489 stop <a name="l01490"></a>01490 <span class="keyword">else</span> <span class="keyword">if</span> (iread == 1) <span class="keyword">then</span> <a name="l01491"></a>01491 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* ",A," = ",G10.4," *")'</span>) yname(1:15),ppp_tab(j)%preal <a name="l01492"></a>01492 <span class="keyword">else</span> <a name="l01493"></a>01493 <span class="keyword">write</span>(nud,<span class="stringliteral">'("* ",A," :",I5," items *")'</span>) yname(1:15),iread <a name="l01494"></a>01494 <span class="keyword">endif</span> <a name="l01495"></a>01495 <span class="keyword">endif</span> <a name="l01496"></a>01496 exit <a name="l01497"></a>01497 <span class="keyword">endif</span> <a name="l01498"></a>01498 <span class="keyword">enddo</span> <a name="l01499"></a>01499 <span class="keyword">read</span> (15,<span class="stringliteral">'(A)'</span>,iostat=iostat) yname <a name="l01500"></a>01500 <span class="keyword">enddo</span> <a name="l01501"></a>01501 <span class="keyword">if</span> (nlat_ppp /= 0 .and. nlat_ppp /= nlat) <span class="keyword">then</span> <a name="l01502"></a>01502 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR *** ERROR *** ERROR *** ERROR ***"</span> <a name="l01503"></a>01503 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"# of latitudes mismatch in preprocessor PPP and PUMA"</span> <a name="l01504"></a>01504 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"NLAT in PPP : "</span>,nlat_ppp,<span class="stringliteral">" <"</span>,trim(ppp_puma_txt),<span class="stringliteral">">"</span> <a name="l01505"></a>01505 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"NLAT in PUMA : "</span>,nlat <a name="l01506"></a>01506 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"Aborting ..."</span> <a name="l01507"></a>01507 stop <a name="l01508"></a>01508 <span class="keyword">endif</span> <a name="l01509"></a>01509 <span class="keyword">if</span> (nlev_ppp /= 0 .and. nlev_ppp /= nlev) <span class="keyword">then</span> <a name="l01510"></a>01510 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*** ERROR *** ERROR *** ERROR *** ERROR ***"</span> <a name="l01511"></a>01511 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"# of levels mismatch in preprocessor PPP and PUMA"</span> <a name="l01512"></a>01512 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"NLEV in PPP : "</span>,nlev_ppp,<span class="stringliteral">" <"</span>,trim(ppp_puma_txt),<span class="stringliteral">">"</span> <a name="l01513"></a>01513 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"NLEV in PUMA : "</span>,nlev <a name="l01514"></a>01514 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"Aborting ..."</span> <a name="l01515"></a>01515 stop <a name="l01516"></a>01516 <span class="keyword">endif</span> <a name="l01517"></a>01517 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"*******************************"</span> <a name="l01518"></a>01518 <a name="l01519"></a>01519 return <a name="l01520"></a>01520 <span class="keyword"> end subroutine ppp_interface</span> <a name="l01521"></a>01521 <a name="l01522"></a>01522 <a name="l01523"></a>01523 <span class="comment">! =============================</span> <a name="l01524"></a>01524 <span class="comment">! SUBROUTINE SELECT_ZONAL_WAVES</span> <a name="l01525"></a>01525 <span class="comment">! =============================</span> <a name="l01526"></a>01526 <a name="l01527"></a><a class="code" href="puma_8f90.html#af1e6869836cefedb3f5cc8a574944d91">01527</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#af1e6869836cefedb3f5cc8a574944d91">select_zonal_waves</a> <a name="l01528"></a>01528 use <span class="keywordflow">pumamod</span> <a name="l01529"></a>01529 <a name="l01530"></a>01530 <span class="keyword">if</span> (sum(nselzw(:)) /= NTP1) <span class="keyword">then</span> <span class="comment">! some wavenumbers disabled</span> <a name="l01531"></a>01531 lselect = .true. <a name="l01532"></a>01532 <span class="keyword">endif</span> <a name="l01533"></a>01533 return <a name="l01534"></a>01534 <span class="keyword"> end</span> <a name="l01535"></a>01535 <a name="l01536"></a>01536 <span class="comment">! ================================</span> <a name="l01537"></a>01537 <span class="comment">! SUBROUTINE SELECT_SPECTRAL_MODES</span> <a name="l01538"></a>01538 <span class="comment">! ================================</span> <a name="l01539"></a>01539 <a name="l01540"></a><a class="code" href="puma_8f90.html#a01c0a9ea1eee2f86044600c5e81dbebd">01540</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a01c0a9ea1eee2f86044600c5e81dbebd">select_spectral_modes</a> <a name="l01541"></a>01541 use <span class="keywordflow">pumamod</span> <a name="l01542"></a>01542 <a name="l01543"></a>01543 <span class="keyword">if</span> (sum(nselsp(:)) /= NCSP) <span class="keyword">then</span> <span class="comment">! some modes disabled</span> <a name="l01544"></a>01544 lspecsel = .true. <a name="l01545"></a>01545 <span class="keyword">endif</span> <a name="l01546"></a>01546 return <a name="l01547"></a>01547 <span class="keyword"> end</span> <a name="l01548"></a>01548 <a name="l01549"></a>01549 <span class="comment">! =====================</span> <a name="l01550"></a>01550 <span class="comment">! * SET VERTICAL GRID *</span> <a name="l01551"></a>01551 <span class="comment">! =====================</span> <a name="l01552"></a>01552 <a name="l01553"></a><a class="code" href="puma_8f90.html#a00e3481744c3185f0f91d35c101f28e4">01553</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">set_vertical_grid</a> <a name="l01554"></a>01554 <a name="l01555"></a>01555 use <span class="keywordflow">pumamod</span> <a name="l01556"></a>01556 <a name="l01557"></a>01557 <span class="keyword">if</span> (sigmh(NLEV) /= 0.0) return <span class="comment">! Already read in from namelist INP</span> <a name="l01558"></a>01558 <a name="l01559"></a>01559 <span class="keyword">if</span> (nvg == 1) <span class="keyword">then</span> <span class="comment">! Scinocca & Haynes sigma levels</span> <a name="l01560"></a>01560 <a name="l01561"></a>01561 <span class="keyword">if</span> (nlevt >= NLEV) <span class="keyword">then</span> <span class="comment">! Security check for 'nlevt'</span> <a name="l01562"></a>01562 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'*** ERROR *** nlevt >= NLEV'</span> <a name="l01563"></a>01563 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Number of levels (NLEV): '</span>,NLEV <a name="l01564"></a>01564 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Number of tropospheric levels (nlevt): '</span>,nlevt <a name="l01565"></a>01565 <span class="keyword">endif</span> <a name="l01566"></a>01566 <a name="l01567"></a>01567 <span class="comment">! troposphere: linear spacing in sigma</span> <a name="l01568"></a>01568 <span class="comment">! stratosphere: linear spacing in log(sigma)</span> <a name="l01569"></a>01569 <span class="comment">! after (see their Appendix):</span> <a name="l01570"></a>01570 <span class="comment">! Scinocca, J. F. and P. H. Haynes (1998): Dynamical forcing of</span> <a name="l01571"></a>01571 <span class="comment">! stratospheric planetary waves by tropospheric baroclinic eddies.</span> <a name="l01572"></a>01572 <span class="comment">! J. Atmos. Sci., 55 (14), 2361-2392</span> <a name="l01573"></a>01573 <a name="l01574"></a>01574 <span class="comment">! Here, zsigtran is set to sigma at dtrop (tropopause height for</span> <a name="l01575"></a>01575 <span class="comment">! construction of restoration temperature field). If tgr=288.15K,</span> <a name="l01576"></a>01576 <span class="comment">! ALR=0.0065K/km and dtrop=11.km, then zsigtran=0.223 (=0.1 in</span> <a name="l01577"></a>01577 <span class="comment">! Scinocca and Haynes (1998)).</span> <a name="l01578"></a>01578 <span class="comment">! A smoothing of the transition between linear and logarithmic</span> <a name="l01579"></a>01579 <span class="comment">! spacing, as noted in Scinocca and Haynes (1998), is not yet</span> <a name="l01580"></a>01580 <span class="comment">! implemented.</span> <a name="l01581"></a>01581 <a name="l01582"></a>01582 zsigtran = (1. - alr * dtrop / tgr)**(ga/(gascon*alr)) <a name="l01583"></a>01583 zsigmin = 1. - (1. - zsigtran) / <span class="keywordtype">real</span>(nlevt) <a name="l01584"></a>01584 <a name="l01585"></a>01585 <span class="keyword">do</span> jlev=1,NLEV <a name="l01586"></a>01586 <span class="keyword">if</span> (jlev == 1) <span class="keyword">then</span> <a name="l01587"></a>01587 sigmh(jlev) = SIGMAX <a name="l01588"></a>01588 elseif (jlev > 1 .and. jlev < NLEV - nlevt) <span class="keyword">then</span> <a name="l01589"></a>01589 sigmh(jlev) = exp((log(SIGMAX) - log(zsigtran)) & <a name="l01590"></a>01590 & / <span class="keywordtype">real(NLEV - nlevt - 1)</span> * <span class="keywordtype">real(NLEV - nlevt - jlev)</span> <a name="l01591"></a>01591 + log(zsigtran)) <a name="l01592"></a>01592 elseif (jlev >= NLEV - nlevt .and. jlev < NLEV - 1) then <a name="l01593"></a>01593 sigmh(jlev) = (zsigtran - zsigmin) / <span class="keywordtype">real(nlevt - 1)</span> <a name="l01594"></a>01594 * real(NLEV - 1 - jlev) + zsigmin <a name="l01595"></a>01595 elseif (jlev == NLEV - 1) then <a name="l01596"></a>01596 sigmh(jlev) = zsigmin <a name="l01597"></a>01597 elseif (jlev == NLEV) <span class="keyword">then</span> <a name="l01598"></a>01598 sigmh(jlev) = 1. <a name="l01599"></a>01599 <span class="keyword">endif</span> <a name="l01600"></a>01600 <span class="keyword">enddo</span> <a name="l01601"></a>01601 return <span class="comment">! case nvg == 1 finished</span> <a name="l01602"></a>01602 <span class="keyword">else</span> <span class="keyword">if</span> (nvg == 2) <span class="keyword">then</span> <span class="comment">! Polvani & Kushner sigma levels</span> <a name="l01603"></a>01603 inl = int(<span class="keywordtype">real</span>(NLEV)/(1.0 - sigmax**(1.0/5.0))) <a name="l01604"></a>01604 <span class="keyword">do</span> jlev=1,NLEV <a name="l01605"></a>01605 sigmh(jlev) = (<span class="keywordtype">real(jlev + inl - NLEV)</span> / <span class="keywordtype">real</span>(inl))**5 <a name="l01606"></a>01606 <span class="keyword">enddo</span> <a name="l01607"></a>01607 return <a name="l01608"></a>01608 <a name="l01609"></a>01609 <span class="comment">! Default (nvg == 0) : equidistant sigma levels</span> <a name="l01610"></a>01610 <a name="l01611"></a>01611 <span class="keyword">else</span> <a name="l01612"></a>01612 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l01613"></a>01613 sigmh(jlev) = <span class="keywordtype">real(jlev)</span> / <span class="keywordtype">real</span>(NLEV) <a name="l01614"></a>01614 <span class="keyword">enddo</span> <a name="l01615"></a>01615 <span class="keyword">endif</span> <a name="l01616"></a>01616 <a name="l01617"></a>01617 return <a name="l01618"></a>01618 <span class="keyword"> end</span> <a name="l01619"></a>01619 <a name="l01620"></a>01620 <a name="l01621"></a>01621 <span class="comment">! =================</span> <a name="l01622"></a>01622 <span class="comment">! SUBROUTINE INITPM</span> <a name="l01623"></a>01623 <span class="comment">! =================</span> <a name="l01624"></a>01624 <a name="l01625"></a><a class="code" href="puma_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">01625</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a5087a1dafe7b39d03c6547fde711b55a">initpm</a> <a name="l01626"></a>01626 use <span class="keywordflow">pumamod</span> <a name="l01627"></a>01627 <a name="l01628"></a>01628 <span class="keywordtype">real (kind=8)</span> :: radea,zakk,zzakk <a name="l01629"></a>01629 <span class="keywordtype">real</span> :: zsigb <span class="comment">! sigma_b for Held & Suarez frictional</span> <a name="l01630"></a>01630 <span class="comment">! and heating timescales</span> <a name="l01631"></a>01631 <a name="l01632"></a>01632 radea = plarad <span class="comment">! Planet radius in high precision</span> <a name="l01633"></a>01633 plavor = EZ * rotspd <span class="comment">! Planetary vorticity</span> <a name="l01634"></a>01634 <a name="l01635"></a>01635 <span class="comment">! *************************************************************</span> <a name="l01636"></a>01636 <span class="comment">! * carries out all initialisation of model prior to running. *</span> <a name="l01637"></a>01637 <span class="comment">! * major sections identified with comments. *</span> <a name="l01638"></a>01638 <span class="comment">! * this s/r sets the model parameters and all resolution *</span> <a name="l01639"></a>01639 <span class="comment">! * dependent quantities. *</span> <a name="l01640"></a>01640 <span class="comment">! *************************************************************</span> <a name="l01641"></a>01641 <a name="l01642"></a>01642 <span class="keyword">if</span> (lrestart) nkits=0 <a name="l01643"></a>01643 <a name="l01644"></a>01644 <span class="comment">! ****************************************************</span> <a name="l01645"></a>01645 <span class="comment">! * Check for enabling / disabling zonal wavenumbers *</span> <a name="l01646"></a>01646 <span class="comment">! ****************************************************</span> <a name="l01647"></a>01647 <a name="l01648"></a>01648 call <a class="code" href="puma_8f90.html#af1e6869836cefedb3f5cc8a574944d91">select_zonal_waves</a> <a name="l01649"></a>01649 <span class="keyword">if</span> (npro == 1) call <a class="code" href="puma_8f90.html#a01c0a9ea1eee2f86044600c5e81dbebd">select_spectral_modes</a> <a name="l01650"></a>01650 <a name="l01651"></a>01651 <span class="comment">! *********************</span> <a name="l01652"></a>01652 <span class="comment">! * set vertical grid *</span> <a name="l01653"></a>01653 <span class="comment">! *********************</span> <a name="l01654"></a>01654 <a name="l01655"></a>01655 call <a class="code" href="ppp_8f90.html#a00e3481744c3185f0f91d35c101f28e4">set_vertical_grid</a> <a name="l01656"></a>01656 <a name="l01657"></a>01657 dsigma(1 ) = sigmh(1) <a name="l01658"></a>01658 dsigma(2:NLEV) = sigmh(2:NLEV) - sigmh(1:NLEM) <a name="l01659"></a>01659 <a name="l01660"></a>01660 rdsig(:) = 0.5 / dsigma(:) <a name="l01661"></a>01661 <a name="l01662"></a>01662 sigma(1 ) = 0.5 * sigmh(1) <a name="l01663"></a>01663 sigma(2:NLEV) = 0.5 * (sigmh(1:NLEM) + sigmh(2:NLEV)) <a name="l01664"></a>01664 <a name="l01665"></a>01665 <span class="comment">! Initialize profile of tau R if not set in namelist</span> <a name="l01666"></a>01666 <a name="l01667"></a>01667 <span class="keyword">if</span> (taur(NLEV) == 0.0) <span class="keyword">then</span> <a name="l01668"></a>01668 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l01669"></a>01669 taur(jlev) = 158.0 / PI * atan(1.0 - sigma(jlev)) <a name="l01670"></a>01670 <span class="keyword">if</span> (taur(jlev) > 30.0) taur(jlev) = 30.0 <a name="l01671"></a>01671 <span class="keyword">enddo</span> <a name="l01672"></a>01672 <span class="keyword">endif</span> <a name="l01673"></a>01673 <a name="l01674"></a>01674 <span class="comment">! Initialize profile of tau F if not set in namelist</span> <a name="l01675"></a>01675 <a name="l01676"></a>01676 <span class="keyword">if</span> (tauf(NLEV) == 0.0) <span class="keyword">then</span> <a name="l01677"></a>01677 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l01678"></a>01678 <span class="keyword">if</span> (sigma(jlev) > 0.8) <span class="keyword">then</span> <a name="l01679"></a>01679 tauf(jlev) = exp(10.0 * (1.0 - sigma(jlev))) / 2.718 <a name="l01680"></a>01680 <span class="keyword">endif</span> <a name="l01681"></a>01681 <span class="keyword">enddo</span> <a name="l01682"></a>01682 <span class="keyword">endif</span> <a name="l01683"></a>01683 <a name="l01684"></a>01684 <span class="comment">! Compute 1.0 / (2 Pi * tau) for efficient use in calculations</span> <a name="l01685"></a>01685 <span class="comment">! A day is 2 Pi in non dimensional units using omega as scaling</span> <a name="l01686"></a>01686 <a name="l01687"></a>01687 <span class="keyword">where</span> (taur(:) > 0.0) <a name="l01688"></a>01688 damp(:) = 1.0 / (TWOPI * taur(:)) <a name="l01689"></a>01689 endwhere <a name="l01690"></a>01690 <a name="l01691"></a>01691 <span class="keyword">where</span> (tauf(:) > 0.0) <a name="l01692"></a>01692 fric(:) = 1.0 / (TWOPI * tauf(:)) <a name="l01693"></a>01693 endwhere <a name="l01694"></a>01694 <a name="l01695"></a>01695 <span class="keyword">if</span> (nsponge == 1) call <a class="code" href="puma_8f90.html#a0c040011dabc1b712353c37a4d90cc68">sponge</a> <a name="l01696"></a>01696 <a name="l01697"></a>01697 <a name="l01698"></a>01698 <span class="comment">! annual cycle period and phase in timesteps</span> <a name="l01699"></a>01699 <a name="l01700"></a>01700 <span class="keyword">if</span> (tac > 0.0) tac = TWOPI / (ntspd * tac) <a name="l01701"></a>01701 pac = pac * ntspd <a name="l01702"></a>01702 <a name="l01703"></a>01703 <span class="comment">! compute internal diffusion parameter</span> <a name="l01704"></a>01704 <a name="l01705"></a>01705 jdelh = ndel/2 <a name="l01706"></a>01706 <span class="keyword">if</span> (tdiss > 0.0) <span class="keyword">then</span> <a name="l01707"></a>01707 zakk = ww*(radea**ndel)/(TWOPI*tdiss*((NTRU*(NTRU+1.))**jdelh)) <a name="l01708"></a>01708 <span class="keyword">else</span> <a name="l01709"></a>01709 zakk = 0.0 <a name="l01710"></a>01710 <span class="keyword">endif</span> <a name="l01711"></a>01711 zzakk = zakk / (ww*(radea**ndel)) <a name="l01712"></a>01712 <a name="l01713"></a>01713 <span class="comment">! set coefficients which depend on wavenumber</span> <a name="l01714"></a>01714 <a name="l01715"></a>01715 zrsq2 = 1.0 / sqrt(2.0) <a name="l01716"></a>01716 <a name="l01717"></a>01717 jr =-1 <a name="l01718"></a>01718 jw = 0 <a name="l01719"></a>01719 <span class="keyword">do</span> jm=0,NTRU <a name="l01720"></a>01720 <span class="keyword">do</span> jn=jm,NTRU <a name="l01721"></a>01721 jr=jr+2 <a name="l01722"></a>01722 ji=jr+1 <a name="l01723"></a>01723 jw=jw+1 <a name="l01724"></a>01724 nindex(jr)=jn <a name="l01725"></a>01725 nindex(ji)=jn <a name="l01726"></a>01726 spnorm(jr)=zrsq2 <a name="l01727"></a>01727 spnorm(ji)=zrsq2 <a name="l01728"></a>01728 zsq = jn * (jn+1) <a name="l01729"></a>01729 <span class="keyword">if</span> (jn > 0) <span class="keyword">then</span> <a name="l01730"></a>01730 srcn(jr) = 1.0 / zsq <a name="l01731"></a>01731 srcn(ji) = srcn(jr) <a name="l01732"></a>01732 <span class="keyword">endif</span> <a name="l01733"></a>01733 sak(jr) = -zzakk * zsq**jdelh <a name="l01734"></a>01734 sak(ji) = sak(jr) <a name="l01735"></a>01735 <span class="keyword">enddo</span> <a name="l01736"></a>01736 zrsq2=-zrsq2 <a name="l01737"></a>01737 <span class="keyword">enddo</span> <a name="l01738"></a>01738 <a name="l01739"></a>01739 <span class="comment">! finally make temperatures dimensionless</span> <a name="l01740"></a>01740 <a name="l01741"></a>01741 dtns = dtns / ct <a name="l01742"></a>01742 dtep = dtep / ct <a name="l01743"></a>01743 <span class="comment">! dttrp = dttrp / ct</span> <a name="l01744"></a>01744 t0(:) = t0(:) / ct <a name="l01745"></a>01745 <a name="l01746"></a>01746 <span class="comment">! print out</span> <a name="l01747"></a>01747 <a name="l01748"></a>01748 <span class="keyword">write</span>(nud,8120) <a name="l01749"></a>01749 <span class="keyword">write</span>(nud,8000) <a name="l01750"></a>01750 <span class="keyword">write</span>(nud,8010) NLEV <a name="l01751"></a>01751 <span class="keyword">write</span>(nud,8020) NTRU <a name="l01752"></a>01752 <span class="keyword">write</span>(nud,8030) NLAT <a name="l01753"></a>01753 <span class="keyword">write</span>(nud,8040) NLON <a name="l01754"></a>01754 <span class="keyword">if</span> (zakk == 0.0) <span class="keyword">then</span> <a name="l01755"></a>01755 <span class="keyword">write</span>(nud,8060) <a name="l01756"></a>01756 <span class="keyword">else</span> <a name="l01757"></a>01757 <span class="keyword">write</span>(nud,8070) ndel <a name="l01758"></a>01758 <span class="keyword">write</span>(nud,8080) <a name="l01759"></a>01759 <span class="keyword">write</span>(nud,8090) zakk,ndel <a name="l01760"></a>01760 <span class="keyword">write</span>(nud,8100) tdiss <a name="l01761"></a>01761 <span class="keyword">endif</span> <a name="l01762"></a>01762 <span class="keyword">write</span>(nud,8110) PNU <a name="l01763"></a>01763 <span class="keyword">write</span>(nud,8000) <a name="l01764"></a>01764 <span class="keyword">write</span>(nud,8120) <a name="l01765"></a>01765 return <a name="l01766"></a>01766 <a name="l01767"></a>01767 8000 format(<span class="stringliteral">'*****************************************************'</span>) <a name="l01768"></a>01768 8010 format(<span class="stringliteral">'* NLEV = '</span>,i6,<span class="stringliteral">' Number of levels *'</span>) <a name="l01769"></a>01769 8020 format(<span class="stringliteral">'* NTRU = '</span>,i6,<span class="stringliteral">' Triangular truncation *'</span>) <a name="l01770"></a>01770 8030 format(<span class="stringliteral">'* NLAT = '</span>,i6,<span class="stringliteral">' Number of latitudes *'</span>) <a name="l01771"></a>01771 8040 format(<span class="stringliteral">'* NLON = '</span>,i6,<span class="stringliteral">' Number of longitues *'</span>) <a name="l01772"></a>01772 8060 format(<span class="stringliteral">'* No lateral dissipation *'</span>) <a name="l01773"></a>01773 8070 format(<span class="stringliteral">'* ndel = '</span>,i6,<span class="stringliteral">' Lateral dissipation *'</span>) <a name="l01774"></a>01774 8080 format(<span class="stringliteral">'* on vorticity, divergence and temperature *'</span>) <a name="l01775"></a>01775 8090 format(<span class="stringliteral">'* with diffusion coefficient = '</span>,e13.4,<span class="stringliteral">' m**'</span>,i1,<span class="stringliteral">'/s *'</span>) <a name="l01776"></a>01776 8100 format(<span class="stringliteral">'* e-folding time for smallest scale is '</span>,f7.3,<span class="stringliteral">' days *'</span>) <a name="l01777"></a>01777 8110 format(<span class="stringliteral">'* Robert time filter with parameter PNU ='</span>,f8.3,<span class="stringliteral">' *'</span>) <a name="l01778"></a>01778 8120 format(/) <a name="l01779"></a>01779 <span class="keyword"> end</span> <a name="l01780"></a>01780 <a name="l01781"></a>01781 <a name="l01782"></a>01782 <span class="comment">! =================</span> <a name="l01783"></a>01783 <span class="comment">! SUBROUTINE MAKEBM</span> <a name="l01784"></a>01784 <span class="comment">! =================</span> <a name="l01785"></a>01785 <a name="l01786"></a><a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">01786</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aa2b3f98ff1c27bb557c695c15708ad1f">makebm</a> <a name="l01787"></a>01787 use <span class="keywordflow">pumamod</span> <a name="l01788"></a>01788 <a name="l01789"></a>01789 zdeltsq = delt * delt <a name="l01790"></a>01790 <a name="l01791"></a>01791 <span class="keyword">do</span> jlev1 = 1 , NLEV <a name="l01792"></a>01792 <span class="keyword">do</span> jlev2 = 1 , NLEV <a name="l01793"></a>01793 zaq = zdeltsq * (t0(jlev1) * dsigma(jlev2)& <a name="l01794"></a>01794 & + dot_product(xlphi(:,jlev1),xlt(jlev2,:))) <a name="l01795"></a>01795 bm1(jlev2,jlev1,1:NTRU) = zaq <a name="l01796"></a>01796 <span class="keyword">enddo</span> <a name="l01797"></a>01797 <span class="keyword">enddo</span> <a name="l01798"></a>01798 <a name="l01799"></a>01799 <span class="keyword">do</span> jn=1,NTRU <a name="l01800"></a>01800 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l01801"></a>01801 bm1(jlev,jlev,jn) = bm1(jlev,jlev,jn) + 1.0 / (jn*(jn+1)) <a name="l01802"></a>01802 <span class="keyword">enddo</span> <a name="l01803"></a>01803 call <a class="code" href="puma_8f90.html#ac5b1247975fc97ef45931e410766a417">minvers</a>(bm1(1,1,jn),NLEV) <a name="l01804"></a>01804 <span class="keyword">enddo</span> <a name="l01805"></a>01805 return <a name="l01806"></a>01806 <span class="keyword"> end</span> <a name="l01807"></a>01807 <a name="l01808"></a>01808 <span class="comment">! =================</span> <a name="l01809"></a>01809 <span class="comment">! SUBROUTINE INITSI</span> <a name="l01810"></a>01810 <span class="comment">! =================</span> <a name="l01811"></a>01811 <a name="l01812"></a><a class="code" href="puma_8f90.html#a96b9223819624937b18b4e5b29e95a91">01812</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a96b9223819624937b18b4e5b29e95a91">initsi</a> <a name="l01813"></a>01813 use <span class="keywordflow">pumamod</span> <a name="l01814"></a>01814 <a name="l01815"></a>01815 <span class="comment">! **********************************************</span> <a name="l01816"></a>01816 <span class="comment">! * Initialisation of the Semi Implicit scheme *</span> <a name="l01817"></a>01817 <span class="comment">! **********************************************</span> <a name="l01818"></a>01818 <a name="l01819"></a>01819 dimension zalp(NLEV),zh(NLEV) <a name="l01820"></a>01820 dimension ztautk(NLEV,NLEV) <a name="l01821"></a>01821 dimension ztaudt(NLEV,NLEV) <a name="l01822"></a>01822 <a name="l01823"></a>01823 tkp(:) = akap * t0(:) <a name="l01824"></a>01824 t0d(1:NLEM) = t0(2:NLEV) - t0(1:NLEM) <a name="l01825"></a>01825 <a name="l01826"></a>01826 zalp(2:NLEV) = log(sigmh(2:NLEV)) - log(sigmh(1:NLEM)) <a name="l01827"></a>01827 <a name="l01828"></a>01828 xlphi(:,:) = 0.0 <a name="l01829"></a>01829 xlphi(1,1) = 1.0 <a name="l01830"></a>01830 <span class="keyword">do</span> jlev = 2 , NLEV <a name="l01831"></a>01831 xlphi(jlev,jlev) = 1.0 - zalp(jlev)*sigmh(jlev-1)/dsigma(jlev) <a name="l01832"></a>01832 xlphi(jlev,1:jlev-1) = zalp(jlev) <a name="l01833"></a>01833 <span class="keyword">enddo</span> <a name="l01834"></a>01834 <a name="l01835"></a>01835 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l01836"></a>01836 c(jlev,:) = xlphi(:,jlev) * (dsigma(jlev) / dsigma(:)) <a name="l01837"></a>01837 <span class="keyword">enddo</span> <a name="l01838"></a>01838 <a name="l01839"></a>01839 <span class="comment">! *********************** tkp(i) = t0(i) * AKAP</span> <a name="l01840"></a>01840 <span class="comment">! * matrix xlt - part 1 *</span> <a name="l01841"></a>01841 <span class="comment">! ***********************</span> <a name="l01842"></a>01842 <a name="l01843"></a>01843 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l01844"></a>01844 ztautk(:,jlev) = tkp(jlev) * c(:,jlev) <a name="l01845"></a>01845 <span class="keyword">enddo</span> <a name="l01846"></a>01846 <a name="l01847"></a>01847 <span class="comment">! ********************* dsigma(i) = sigmh(i) - sigmh(i-1)</span> <a name="l01848"></a>01848 <span class="comment">! * matrix xlt part 2 * rdsig (i) = 0.5 / dsigma(i)</span> <a name="l01849"></a>01849 <span class="comment">! *********************</span> <a name="l01850"></a>01850 <a name="l01851"></a>01851 ztaudt(1,1) = 0.5 * t0d(1) * (sigmh(1) - 1.0) <a name="l01852"></a>01852 ztaudt(2:NLEV,1) = 0.5 * t0d(1) * dsigma(2:NLEV) <a name="l01853"></a>01853 <a name="l01854"></a>01854 <span class="keyword">do</span> j= 2 , NLEV <a name="l01855"></a>01855 <span class="keyword">do</span> i = 1 , j-1 <a name="l01856"></a>01856 ztaudt(i,j) = dsigma(i) * rdsig(j) & <a name="l01857"></a>01857 * (t0d(j-1) * (sigmh(j-1)-1.0) + t0d(j) * (sigmh(j)-1.0)) <a name="l01858"></a>01858 <span class="keyword">enddo</span> <a name="l01859"></a>01859 ztaudt(j,j) = 0.5 & <a name="l01860"></a>01860 * (t0d(j-1) * sigmh(j-1) + t0d(j) * (sigmh(j)-1.0)) <a name="l01861"></a>01861 <span class="keyword">do</span> i = j+1 , NLEV <a name="l01862"></a>01862 ztaudt(i,j) = dsigma(i) * rdsig(j) & <a name="l01863"></a>01863 * (t0d(j-1) * sigmh(j-1) + t0d(j) * sigmh(j) ) <a name="l01864"></a>01864 <span class="keyword">enddo</span> <a name="l01865"></a>01865 <span class="keyword">enddo</span> <a name="l01866"></a>01866 <a name="l01867"></a>01867 xlt(:,:) = ztautk(:,:) + ztaudt(:,:) <a name="l01868"></a>01868 <a name="l01869"></a>01869 <span class="comment">! xlt finished</span> <a name="l01870"></a>01870 <a name="l01871"></a>01871 zfctr=0.001*cv*cv/ga <a name="l01872"></a>01872 <span class="keyword">do</span> jlev=1,NLEV <a name="l01873"></a>01873 zh(jlev) = dot_product(xlphi(:,jlev),t0(:)) * zfctr <a name="l01874"></a>01874 <span class="keyword">enddo</span> <a name="l01875"></a>01875 <a name="l01876"></a>01876 <span class="comment">! **********************************</span> <a name="l01877"></a>01877 <span class="comment">! * write out vertical information *</span> <a name="l01878"></a>01878 <span class="comment">! **********************************</span> <a name="l01879"></a>01879 <a name="l01880"></a>01880 ilev = min(NLEV,5) <a name="l01881"></a>01881 <span class="keyword">write</span>(nud,9001) <a name="l01882"></a>01882 <span class="keyword">write</span>(nud,9002) <a name="l01883"></a>01883 <span class="keyword">write</span>(nud,9003) <a name="l01884"></a>01884 <span class="keyword">write</span>(nud,9002) <a name="l01885"></a>01885 <span class="keyword">do</span> jlev=1,NLEV <a name="l01886"></a>01886 <span class="keyword">write</span>(nud,9004) jlev,sigma(jlev),t0(jlev)*ct,zh(jlev) <a name="l01887"></a>01887 <span class="keyword">enddo</span> <a name="l01888"></a>01888 <span class="keyword">write</span>(nud,9002) <a name="l01889"></a>01889 <span class="keyword">write</span>(nud,9001) <a name="l01890"></a>01890 <a name="l01891"></a>01891 <span class="comment">! matrix c</span> <a name="l01892"></a>01892 <a name="l01893"></a>01893 <span class="keyword">write</span>(nud,9012) <a name="l01894"></a>01894 <span class="keyword">write</span>(nud,9013) <span class="stringliteral">'c'</span>,(jlev,jlev=1,ilev) <a name="l01895"></a>01895 <span class="keyword">write</span>(nud,9012) <a name="l01896"></a>01896 <span class="keyword">do</span> jlev=1,NLEV <a name="l01897"></a>01897 <span class="keyword">write</span>(nud,9014) jlev,(c(i,jlev),i=1,ilev) <a name="l01898"></a>01898 <span class="keyword">enddo</span> <a name="l01899"></a>01899 <span class="keyword">write</span>(nud,9012) <a name="l01900"></a>01900 <span class="keyword">write</span>(nud,9001) <a name="l01901"></a>01901 <a name="l01902"></a>01902 <span class="comment">! matrix xlphi</span> <a name="l01903"></a>01903 <a name="l01904"></a>01904 <span class="keyword">write</span>(nud,9012) <a name="l01905"></a>01905 <span class="keyword">write</span>(nud,9013) <span class="stringliteral">'xlphi'</span>,(jlev,jlev=1,ilev) <a name="l01906"></a>01906 <span class="keyword">write</span>(nud,9012) <a name="l01907"></a>01907 <span class="keyword">do</span> jlev=1,NLEV <a name="l01908"></a>01908 <span class="keyword">write</span>(nud,9014) jlev,(xlphi(i,jlev),i=1,ilev) <a name="l01909"></a>01909 <span class="keyword">enddo</span> <a name="l01910"></a>01910 <span class="keyword">write</span>(nud,9012) <a name="l01911"></a>01911 <span class="keyword">write</span>(nud,9001) <a name="l01912"></a>01912 return <a name="l01913"></a>01913 9001 format(/) <a name="l01914"></a>01914 9002 format(33(<span class="stringliteral">'*'</span>)) <a name="l01915"></a>01915 9003 format(<span class="stringliteral">'* Lv * Sigma Basic-T Height *'</span>) <a name="l01916"></a>01916 9004 format(<span class="stringliteral">'*'</span>,i3,<span class="stringliteral">' * '</span>,3f8.3,<span class="stringliteral">' *'</span>) <a name="l01917"></a>01917 9012 format(69(<span class="stringliteral">'*'</span>)) <a name="l01918"></a>01918 9013 format(<span class="stringliteral">'* Lv * '</span>,a5,i7,4i12,<span class="stringliteral">' *'</span>) <a name="l01919"></a>01919 9014 format(<span class="stringliteral">'*'</span>,i3,<span class="stringliteral">' * '</span>,5f12.8,<span class="stringliteral">' *'</span>) <a name="l01920"></a>01920 <span class="keyword"> end</span> <a name="l01921"></a>01921 <a name="l01922"></a>01922 <span class="comment">! =====================</span> <a name="l01923"></a>01923 <span class="comment">! SUBROUTINE INITRANDOM</span> <a name="l01924"></a>01924 <span class="comment">! =====================</span> <a name="l01925"></a>01925 <a name="l01926"></a><a class="code" href="puma_8f90.html#acbd8e7fdd2e1f60dbca741a700fb292a">01926</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#acbd8e7fdd2e1f60dbca741a700fb292a">initrandom</a> <a name="l01927"></a>01927 use <span class="keywordflow">pumamod</span> <a name="l01928"></a>01928 <span class="keywordtype">integer</span> :: i, clock <a name="l01929"></a>01929 <a name="l01930"></a>01930 <span class="comment">! Set random number generator seed</span> <a name="l01931"></a>01931 <a name="l01932"></a>01932 call random_seed(size=nseedlen) <a name="l01933"></a>01933 <span class="keyword">allocate</span>(meed(nseedlen)) <a name="l01934"></a>01934 <a name="l01935"></a>01935 <span class="comment">! Take seed from namelist parameter 'SEED' ?</span> <a name="l01936"></a>01936 <a name="l01937"></a>01937 <span class="keyword">if</span> (seed(1) /= 0) <span class="keyword">then</span> <a name="l01938"></a>01938 meed(:) = 0 <a name="l01939"></a>01939 i = nseedlen <a name="l01940"></a>01940 <span class="keyword">if</span> (i > 8) i = 8 <a name="l01941"></a>01941 meed(1:i) = seed(1:i) <a name="l01942"></a>01942 <span class="keyword">else</span> <a name="l01943"></a>01943 call system_clock(<a class="code" href="pumax_8c.html#ad43c3812e6d13e0518d9f8b8f463ffcf">count</a>=clock) <a name="l01944"></a>01944 meed(:) = clock + 37 * (/(i,i=1,nseedlen)/) <a name="l01945"></a>01945 <span class="keyword">endif</span> <a name="l01946"></a>01946 call random_seed(put=meed) <a name="l01947"></a>01947 return <a name="l01948"></a>01948 <span class="keyword"> end</span> <a name="l01949"></a>01949 <a name="l01950"></a>01950 <span class="comment">! ====================</span> <a name="l01951"></a>01951 <span class="comment">! SUBROUTINE PRINTSEED</span> <a name="l01952"></a>01952 <span class="comment">! ====================</span> <a name="l01953"></a>01953 <a name="l01954"></a><a class="code" href="puma_8f90.html#a9a888c599145a63cdd108dffa553b509">01954</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9a888c599145a63cdd108dffa553b509">printseed</a> <a name="l01955"></a>01955 use <span class="keywordflow">pumamod</span> <a name="l01956"></a>01956 <span class="keywordtype">integer</span> :: i <a name="l01957"></a>01957 <a name="l01958"></a>01958 <span class="keyword">write</span> (nud,9020) <a name="l01959"></a>01959 <span class="keyword">write</span> (nud,9010) <a name="l01960"></a>01960 <span class="keyword">do</span> i = 1 , nseedlen <a name="l01961"></a>01961 <span class="keyword">write</span> (nud,9000) i,meed(i) <a name="l01962"></a>01962 <span class="keyword">enddo</span> <a name="l01963"></a>01963 <span class="keyword">write</span> (nud,9010) <a name="l01964"></a>01964 <span class="keyword">write</span> (nud,9020) <a name="l01965"></a>01965 return <a name="l01966"></a>01966 9000 format(<span class="stringliteral">'* seed('</span>,i1,<span class="stringliteral">') = '</span>,i10,<span class="stringliteral">' *'</span>) <a name="l01967"></a>01967 9010 format(<span class="stringliteral">'************************'</span>) <a name="l01968"></a>01968 9020 format(/) <a name="l01969"></a>01969 <span class="keyword"> end</span> <a name="l01970"></a>01970 <a name="l01971"></a>01971 <span class="comment">! ====================</span> <a name="l01972"></a>01972 <span class="comment">! SUBROUTINE INITRUIDO</span> <a name="l01973"></a>01973 <span class="comment">! ====================</span> <a name="l01974"></a>01974 <a name="l01975"></a><a class="code" href="puma_8f90.html#aea6c13c68157972ea21768a5ea43e154">01975</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aea6c13c68157972ea21768a5ea43e154">initruido</a> <a name="l01976"></a>01976 use <span class="keywordflow">pumamod</span> <a name="l01977"></a>01977 <span class="keyword">if</span> (nruido > 0) <span class="keyword">then</span> <a name="l01978"></a>01978 <span class="keyword">allocate</span>(ruido(nlon,nlat,nlev)) <a name="l01979"></a>01979 <span class="keyword">allocate</span>(ruidop(nhor,nlev)) <a name="l01980"></a>01980 ruido = 77 <a name="l01981"></a>01981 ruidop = 88 <a name="l01982"></a>01982 <span class="keyword">endif</span> <a name="l01983"></a>01983 return <a name="l01984"></a>01984 <span class="keyword"> end</span> <a name="l01985"></a>01985 <a name="l01986"></a>01986 <span class="comment">! ====================</span> <a name="l01987"></a>01987 <span class="comment">! SUBROUTINE STEPRUIDO</span> <a name="l01988"></a>01988 <span class="comment">! ====================</span> <a name="l01989"></a>01989 <a name="l01990"></a><a class="code" href="puma_8f90.html#ab257e27330a3ab13c9c90ebd985ef60e">01990</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ab257e27330a3ab13c9c90ebd985ef60e">stepruido</a> <a name="l01991"></a>01991 use <span class="keywordflow">pumamod</span> <a name="l01992"></a>01992 <span class="keywordtype">real</span> :: zr <a name="l01993"></a>01993 <span class="keywordtype">integer</span> :: need(8) <a name="l01994"></a>01994 <a name="l01995"></a>01995 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l01996"></a>01996 <span class="keyword">if</span> (nruido == 1) <span class="keyword">then</span> <a name="l01997"></a>01997 zr = disp*<a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>() <a name="l01998"></a>01998 ruido(:,:,:) = zr <a name="l01999"></a>01999 elseif (nruido == 2) <span class="keyword">then</span> <a name="l02000"></a>02000 <span class="keyword">do</span> jlev=1,NLEV <a name="l02001"></a>02001 <span class="keyword">do</span> jlat=1,NLAT <a name="l02002"></a>02002 <span class="keyword">do</span> jlon=1,NLON <a name="l02003"></a>02003 ruido(jlon,jlat,jlev) = disp*<a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>() <a name="l02004"></a>02004 <span class="keyword">enddo</span> <a name="l02005"></a>02005 <span class="keyword">enddo</span> <a name="l02006"></a>02006 <span class="keyword">enddo</span> <a name="l02007"></a>02007 elseif (nruido == 3) <span class="keyword">then</span> <a name="l02008"></a>02008 <span class="keyword">do</span> jlev=1,NLEV <a name="l02009"></a>02009 <span class="keyword">do</span> jlat=1,NLAT,2 <a name="l02010"></a>02010 <span class="keyword">do</span> jlon=1,NLON <a name="l02011"></a>02011 ruido(jlon,jlat ,jlev) = disp*<a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>() <a name="l02012"></a>02012 ruido(jlon,jlat+1,jlev) = ruido(jlon,jlat,jlev) <a name="l02013"></a>02013 <span class="keyword">enddo</span> <a name="l02014"></a>02014 <span class="keyword">enddo</span> <a name="l02015"></a>02015 <span class="keyword">enddo</span> <a name="l02016"></a>02016 <span class="keyword">endif</span> <a name="l02017"></a>02017 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span> <a name="l02018"></a>02018 <a name="l02019"></a>02019 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(ruido,ruidop,NLEV) <a name="l02020"></a>02020 call random_seed(get=need) <a name="l02021"></a>02021 return <a name="l02022"></a>02022 <span class="keyword"> end</span> <a name="l02023"></a>02023 <a name="l02024"></a>02024 <span class="comment">! ==================</span> <a name="l02025"></a>02025 <span class="comment">! SUBROUTINE MINVERS</span> <a name="l02026"></a>02026 <span class="comment">! ==================</span> <a name="l02027"></a>02027 <a name="l02028"></a><a class="code" href="puma_8f90.html#ac5b1247975fc97ef45931e410766a417">02028</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ac5b1247975fc97ef45931e410766a417">minvers</a>(a,n) <a name="l02029"></a>02029 dimension a(n,n),b(n,n),indx(n) <a name="l02030"></a>02030 <a name="l02031"></a>02031 b = 0.0 <a name="l02032"></a>02032 <span class="keyword">do</span> j = 1 , n <a name="l02033"></a>02033 b(j,j) = 1.0 <a name="l02034"></a>02034 <span class="keyword">enddo</span> <a name="l02035"></a>02035 call <a class="code" href="puma_8f90.html#afa767a8d587c360ca92357e066b6bf22">ludcmp</a>(a,n,indx) <a name="l02036"></a>02036 <span class="keyword">do</span> j = 1 , n <a name="l02037"></a>02037 call <a class="code" href="puma_8f90.html#a13d49d9c008cbc01f37c0c31d2012ad4">lubksb</a>(a,n,indx,b(1,j)) <a name="l02038"></a>02038 <span class="keyword">enddo</span> <a name="l02039"></a>02039 a = b <a name="l02040"></a>02040 return <a name="l02041"></a>02041 <span class="keyword"> end</span> <a name="l02042"></a>02042 <a name="l02043"></a>02043 <span class="comment">! =================</span> <a name="l02044"></a>02044 <span class="comment">! SUBROUTINE LUBKSB</span> <a name="l02045"></a>02045 <span class="comment">! =================</span> <a name="l02046"></a>02046 <a name="l02047"></a><a class="code" href="puma_8f90.html#a13d49d9c008cbc01f37c0c31d2012ad4">02047</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a13d49d9c008cbc01f37c0c31d2012ad4">lubksb</a>(a,n,indx,b) <a name="l02048"></a>02048 dimension a(n,n),b(n),indx(n) <a name="l02049"></a>02049 k = 0 <a name="l02050"></a>02050 <span class="keyword">do</span> i = 1 , n <a name="l02051"></a>02051 l = indx(i) <a name="l02052"></a>02052 sum = b(l) <a name="l02053"></a>02053 b(l) = b(i) <a name="l02054"></a>02054 <span class="keyword">if</span> (k > 0) <span class="keyword">then</span> <a name="l02055"></a>02055 <span class="keyword">do</span> j = k , i-1 <a name="l02056"></a>02056 sum = sum - a(i,j) * b(j) <a name="l02057"></a>02057 <span class="keyword">enddo</span> <a name="l02058"></a>02058 <span class="keyword">else</span> <span class="keyword">if</span> (sum /= 0.0) <span class="keyword">then</span> <a name="l02059"></a>02059 k = i <a name="l02060"></a>02060 <span class="keyword">endif</span> <a name="l02061"></a>02061 b(i) = sum <a name="l02062"></a>02062 <span class="keyword">enddo</span> <a name="l02063"></a>02063 <a name="l02064"></a>02064 <span class="keyword">do</span> i = n , 1 , -1 <a name="l02065"></a>02065 sum = b(i) <a name="l02066"></a>02066 <span class="keyword">do</span> j = i+1 , n <a name="l02067"></a>02067 sum = sum - a(i,j) * b(j) <a name="l02068"></a>02068 <span class="keyword">enddo</span> <a name="l02069"></a>02069 b(i) = sum / a(i,i) <a name="l02070"></a>02070 <span class="keyword">enddo</span> <a name="l02071"></a>02071 return <a name="l02072"></a>02072 <span class="keyword"> end</span> <a name="l02073"></a>02073 <a name="l02074"></a>02074 <span class="comment">! =================</span> <a name="l02075"></a>02075 <span class="comment">! SUBROUTINE LUDCMP</span> <a name="l02076"></a>02076 <span class="comment">! =================</span> <a name="l02077"></a>02077 <a name="l02078"></a><a class="code" href="puma_8f90.html#afa767a8d587c360ca92357e066b6bf22">02078</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#afa767a8d587c360ca92357e066b6bf22">ludcmp</a>(a,n,indx) <a name="l02079"></a>02079 dimension a(n,n),indx(n),vv(n) <a name="l02080"></a>02080 <a name="l02081"></a>02081 d = 1.0 <a name="l02082"></a>02082 vv = 1.0 / maxval(abs(a),2) <a name="l02083"></a>02083 <a name="l02084"></a>02084 <span class="keyword">do</span> 19 j = 1 , n <a name="l02085"></a>02085 <span class="keyword">do</span> i = 2 , j-1 <a name="l02086"></a>02086 a(i,j) = a(i,j) - dot_product(a(i,1:i-1),a(1:i-1,j)) <a name="l02087"></a>02087 <span class="keyword">enddo</span> <a name="l02088"></a>02088 aamax = 0.0 <a name="l02089"></a>02089 <span class="keyword">do</span> i = j , n <a name="l02090"></a>02090 <span class="keyword">if</span> (j > 1) & <a name="l02091"></a>02091 & a(i,j) = a(i,j) - dot_product(a(i,1:j-1),a(1:j-1,j)) <a name="l02092"></a>02092 dum = vv(i) * abs(a(i,j)) <a name="l02093"></a>02093 <span class="keyword">if</span> (dum .ge. aamax) <span class="keyword">then</span> <a name="l02094"></a>02094 imax = i <a name="l02095"></a>02095 aamax = dum <a name="l02096"></a>02096 <span class="keyword">endif</span> <a name="l02097"></a>02097 <span class="keyword">enddo</span> <a name="l02098"></a>02098 <span class="keyword">if</span> (j .ne. imax) <span class="keyword">then</span> <a name="l02099"></a>02099 <span class="keyword">do</span> 17 k = 1 , n <a name="l02100"></a>02100 dum = a(imax,k) <a name="l02101"></a>02101 a(imax,k) = a(j,k) <a name="l02102"></a>02102 a(j,k) = dum <a name="l02103"></a>02103 17 continue <a name="l02104"></a>02104 d = -d <a name="l02105"></a>02105 vv(imax) = vv(j) <a name="l02106"></a>02106 <span class="keyword">endif</span> <a name="l02107"></a>02107 indx(j) = imax <a name="l02108"></a>02108 <span class="keyword">if</span> (a(j,j) == 0.0) a(j,j) = tiny(a(j,j)) <a name="l02109"></a>02109 <span class="keyword">if</span> (j < n) a(j+1:n,j) = a(j+1:n,j) / a(j,j) <a name="l02110"></a>02110 19 continue <a name="l02111"></a>02111 return <a name="l02112"></a>02112 <span class="keyword"> end</span> <a name="l02113"></a>02113 <a name="l02114"></a>02114 <span class="comment">! =============================</span> <a name="l02115"></a>02115 <span class="comment">! SUBROUTINE FILTER_ZONAL_WAVES</span> <a name="l02116"></a>02116 <span class="comment">! =============================</span> <a name="l02117"></a>02117 <a name="l02118"></a><a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">02118</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(pfc) <a name="l02119"></a>02119 use <span class="keywordflow">pumamod</span> <a name="l02120"></a>02120 dimension pfc(2,NLON/2,NLPP) <a name="l02121"></a>02121 <a name="l02122"></a>02122 <span class="keyword">do</span> jlat = 1 , NLPP <a name="l02123"></a>02123 pfc(1,1:NTP1,jlat) = pfc(1,1:NTP1,jlat) * nselzw(:) <a name="l02124"></a>02124 pfc(2,1:NTP1,jlat) = pfc(2,1:NTP1,jlat) * nselzw(:) <a name="l02125"></a>02125 <span class="keyword">enddo</span> <a name="l02126"></a>02126 <a name="l02127"></a>02127 return <a name="l02128"></a>02128 <span class="keyword"> end</span> <a name="l02129"></a>02129 <a name="l02130"></a>02130 <a name="l02131"></a>02131 <span class="comment">! ================================</span> <a name="l02132"></a>02132 <span class="comment">! SUBROUTINE FILTER_SPECTRAL_MODES</span> <a name="l02133"></a>02133 <span class="comment">! ================================</span> <a name="l02134"></a>02134 <a name="l02135"></a><a class="code" href="puma_8f90.html#a9a1e7493444984ad2c2161609dbb6e69">02135</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9a1e7493444984ad2c2161609dbb6e69">filter_spectral_modes</a> <a name="l02136"></a>02136 use <span class="keywordflow">pumamod</span> <a name="l02137"></a>02137 <a name="l02138"></a>02138 j = 0 <a name="l02139"></a>02139 k = -1 <a name="l02140"></a>02140 <span class="keyword">do</span> m = 0 , NTRU <a name="l02141"></a>02141 <span class="keyword">do</span> n = m , NTRU <a name="l02142"></a>02142 k = k + 2 <a name="l02143"></a>02143 j = j + 1 <a name="l02144"></a>02144 <span class="keyword">if</span> (nselsp(j) == 0) <span class="keyword">then</span> <a name="l02145"></a>02145 spp(k:k+1 ) = 0.0 <a name="l02146"></a>02146 sdp(k:k+1,:) = 0.0 <a name="l02147"></a>02147 stp(k:k+1,:) = 0.0 <a name="l02148"></a>02148 spt(k:k+1 ) = 0.0 <a name="l02149"></a>02149 sdt(k:k+1,:) = 0.0 <a name="l02150"></a>02150 stt(k:k+1,:) = 0.0 <a name="l02151"></a>02151 spm(k:k+1 ) = 0.0 <a name="l02152"></a>02152 sdm(k:k+1,:) = 0.0 <a name="l02153"></a>02153 stm(k:k+1,:) = 0.0 <a name="l02154"></a>02154 srp1(k:k+1,:) = 0.0 <a name="l02155"></a>02155 srp2(k:k+1,:) = 0.0 <a name="l02156"></a>02156 <span class="keyword">if</span> (n < NTRU) <span class="keyword">then</span> <a name="l02157"></a>02157 szp(k+2:k+3,:) = 0.0 <a name="l02158"></a>02158 szt(k+2:k+3,:) = 0.0 <a name="l02159"></a>02159 szm(k+2:k+3,:) = 0.0 <a name="l02160"></a>02160 <span class="keyword">endif</span> <a name="l02161"></a>02161 <span class="keyword">endif</span> <a name="l02162"></a>02162 <span class="keyword">enddo</span> <a name="l02163"></a>02163 <span class="keyword">enddo</span> <a name="l02164"></a>02164 <a name="l02165"></a>02165 return <a name="l02166"></a>02166 <span class="keyword"> end</span> <a name="l02167"></a>02167 <a name="l02168"></a>02168 <a name="l02169"></a>02169 <span class="comment">! ================</span> <a name="l02170"></a>02170 <span class="comment">! SUBROUTINE NOISE</span> <a name="l02171"></a>02171 <span class="comment">! ================</span> <a name="l02172"></a>02172 <a name="l02173"></a><a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">02173</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#abdcee9a4a4d07fc6e5b7a7f5768026ac">noise</a>(kickval) <a name="l02174"></a>02174 use <span class="keywordflow">pumamod</span> <a name="l02175"></a>02175 <a name="l02176"></a>02176 <span class="comment">! kickval = -1 : read ln(ps) from puma_sp_init</span> <a name="l02177"></a>02177 <span class="comment">! kickval = 0 : model runs zonally symmetric with no eddies</span> <a name="l02178"></a>02178 <span class="comment">! kickval = 1 : add white noise to ln(Ps) asymmetric hemispheres</span> <a name="l02179"></a>02179 <span class="comment">! kickval = 2 : add white noise to ln(Ps) symmetric to the equator</span> <a name="l02180"></a>02180 <span class="comment">! kickval = 3 : force mode(1,2) of ln(Ps) allowing reproducable runs</span> <a name="l02181"></a>02181 <span class="comment">! kickval = 4 : add white noise to symmetric zonal wavenumbers 7 of ln(Ps)</span> <a name="l02182"></a>02182 <a name="l02183"></a>02183 <span class="keywordtype">integer</span> :: kickval <a name="l02184"></a>02184 <span class="keywordtype">integer</span> :: jsp, jsp1, jn, jm <a name="l02185"></a>02185 <span class="keywordtype">integer</span> :: jr, ji, ins <a name="l02186"></a>02186 <span class="keywordtype">real</span> :: zr, zi, zscale, zrand <a name="l02187"></a>02187 <a name="l02188"></a>02188 zscale = 0.000001 <span class="comment">! amplitude of noise</span> <a name="l02189"></a>02189 zr = 0.01 <span class="comment">! kickval=3 value for mode(1,2) real</span> <a name="l02190"></a>02190 zi = 0.005 <span class="comment">! kickval=3 value for mode(1,2) imag</span> <a name="l02191"></a>02191 <a name="l02192"></a>02192 <span class="keyword">select</span> <span class="keyword">case</span> (kickval) <a name="l02193"></a>02193 <span class="keyword">case</span> (-1) <a name="l02194"></a>02194 <span class="keyword">open</span>(71, file=puma_sp_init,form=<span class="stringliteral">'unformatted'</span>,iostat=iostat) <a name="l02195"></a>02195 <span class="keyword">if</span> (iostat /= 0) <span class="keyword">then</span> <a name="l02196"></a>02196 <span class="keyword">write</span>(nud,*) <span class="stringliteral">' *** kick=-1: needs file <'</span>,trim(puma_sp_init),<span class="stringliteral">'> ***'</span> <a name="l02197"></a>02197 stop <a name="l02198"></a>02198 <span class="keyword">endif</span> <a name="l02199"></a>02199 <span class="keyword">read</span>(71,iostat=iostat) sp(:) <a name="l02200"></a>02200 <span class="keyword">if</span> (iostat /= 0) <span class="keyword">then</span> <a name="l02201"></a>02201 <span class="keyword">write</span>(nud,*) <span class="stringliteral">' *** error reading file <'</span>,trim(puma_sp_init),<span class="stringliteral">'> ***'</span> <a name="l02202"></a>02202 stop <a name="l02203"></a>02203 <span class="keyword">endif</span> <a name="l02204"></a>02204 <span class="keyword">close</span>(71) <a name="l02205"></a>02205 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'initial ln(ps) field read from <'</span>,trim(puma_sp_init),<span class="stringliteral">'>'</span> <a name="l02206"></a>02206 return <a name="l02207"></a>02207 <span class="keyword">case</span> (0) <span class="comment">! do nothing</span> <a name="l02208"></a>02208 <span class="keyword">case</span> (1) <a name="l02209"></a>02209 jsp1=2*NTP1+1 <a name="l02210"></a>02210 <span class="keyword">do</span> jsp=jsp1,NRSP <a name="l02211"></a>02211 call random_number(zrand) <a name="l02212"></a>02212 <span class="keyword">if</span> (mrpid > 0) zrand = zrand + mrpid * 0.01 <a name="l02213"></a>02213 sp(jsp)=sp(jsp)+zscale*(zrand-0.5) <a name="l02214"></a>02214 <span class="keyword">enddo</span> <a name="l02215"></a>02215 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'white noise added'</span> <a name="l02216"></a>02216 <span class="keyword">case</span> (2) <a name="l02217"></a>02217 jr=2*NTP1-1 <a name="l02218"></a>02218 <span class="keyword">do</span> jm=1,NTRU <a name="l02219"></a>02219 <span class="keyword">do</span> jn=jm,NTRU <a name="l02220"></a>02220 jr=jr+2 <a name="l02221"></a>02221 ji=jr+1 <a name="l02222"></a>02222 <span class="keyword">if</span> (mod(jn+jm,2) == 0) <span class="keyword">then</span> <a name="l02223"></a>02223 call random_number(zrand) <a name="l02224"></a>02224 <span class="keyword">if</span> (mrpid > 0) zrand = zrand + mrpid * 0.01 <a name="l02225"></a>02225 sp(jr)=sp(jr)+zscale*(zrand-0.5) <a name="l02226"></a>02226 sp(ji)=sp(ji)+zscale*(zrand-0.5) <a name="l02227"></a>02227 <span class="keyword">endif</span> <a name="l02228"></a>02228 <span class="keyword">enddo</span> <a name="l02229"></a>02229 <span class="keyword">enddo</span> <a name="l02230"></a>02230 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'symmetric white noise added'</span> <a name="l02231"></a>02231 <span class="keyword">case</span> (3) <a name="l02232"></a>02232 sp(2*NTP1+3) = sp(2*NTP1+3) + zr <a name="l02233"></a>02233 sp(2*NTP1+4) = sp(2*NTP1+4) + zi <a name="l02234"></a>02234 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'mode(1,2) of ln(Ps) set to ('</span>,sp(2*NTP1+3),<span class="stringliteral">','</span>,sp(2*NTP1+4),<span class="stringliteral">')'</span> <a name="l02235"></a>02235 <span class="keyword">case</span> (4) <a name="l02236"></a>02236 jr=2*NTP1-1 <a name="l02237"></a>02237 <span class="keyword">do</span> jm=1,NTRU <a name="l02238"></a>02238 <span class="keyword">do</span> jn=jm,NTRU <a name="l02239"></a>02239 jr=jr+2 <a name="l02240"></a>02240 ji=jr+1 <a name="l02241"></a>02241 <span class="keyword">if</span> (mod(jn+jm,2) == 0 .and. jm == 7) <span class="keyword">then</span> <a name="l02242"></a>02242 call random_number(zrand) <a name="l02243"></a>02243 sp(jr)=sp(jr)+zscale*(zrand-0.5) <a name="l02244"></a>02244 sp(ji)=sp(ji)+zscale*(zrand-0.5) <a name="l02245"></a>02245 <span class="keyword">endif</span> <a name="l02246"></a>02246 <span class="keyword">enddo</span> <a name="l02247"></a>02247 <span class="keyword">enddo</span> <a name="l02248"></a>02248 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'symmetric zonal wavenumbers 7 of ln(Ps) perturbed'</span>, & <a name="l02249"></a>02249 & <span class="stringliteral">'with white noise.'</span> <a name="l02250"></a>02250 <span class="keyword">case</span> default <a name="l02251"></a>02251 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Value '</span>,kickval ,<span class="stringliteral">' for kickval not implemented.'</span> <a name="l02252"></a>02252 stop <a name="l02253"></a>02253 <span class="keyword">end select</span> <a name="l02254"></a>02254 <a name="l02255"></a>02255 <span class="keyword">if</span> (nwspini == 1) <span class="keyword">then</span> <a name="l02256"></a>02256 <span class="keyword">open</span>(71, file=puma_sp_init, form=<span class="stringliteral">'unformatted'</span>) <a name="l02257"></a>02257 <span class="keyword">write</span>(71) sp(:) <a name="l02258"></a>02258 <span class="keyword">close</span>(71) <a name="l02259"></a>02259 <span class="keyword">endif</span> <a name="l02260"></a>02260 <a name="l02261"></a>02261 return <a name="l02262"></a>02262 <span class="keyword"> end</span> <a name="l02263"></a>02263 <a name="l02264"></a>02264 <span class="comment">! ================</span> <a name="l02265"></a>02265 <span class="comment">! SUBROUTINE SETZT</span> <a name="l02266"></a>02266 <span class="comment">! ================</span> <a name="l02267"></a><a class="code" href="puma_8f90.html#a4a662c6d6619fc6405eb110f62653dc0">02267</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a4a662c6d6619fc6405eb110f62653dc0">setzt</a> <a name="l02268"></a>02268 use <span class="keywordflow">pumamod</span> <a name="l02269"></a>02269 <a name="l02270"></a>02270 <span class="comment">! *************************************************************</span> <a name="l02271"></a>02271 <span class="comment">! * Set up the restoration temperature fields sr1 and sr2 *</span> <a name="l02272"></a>02272 <span class="comment">! * for aqua planet conditions. *</span> <a name="l02273"></a>02273 <span class="comment">! * The temperature at sigma = 1 is <tgr>, entered in kelvin. *</span> <a name="l02274"></a>02274 <span class="comment">! * The lapse rate of ALR K/m is assumed under the tropopause *</span> <a name="l02275"></a>02275 <span class="comment">! * and zero above. The tropopause is defined by <dtrop>. *</span> <a name="l02276"></a>02276 <span class="comment">! * The smoothing ot the tropopause depends on <dttrp>. *</span> <a name="l02277"></a>02277 <span class="comment">! ************************************************************* </span> <a name="l02278"></a>02278 <a name="l02279"></a>02279 dimension ztrs(NLEV) <span class="comment">! Mean profile</span> <a name="l02280"></a>02280 dimension zfac(NLEV) <a name="l02281"></a>02281 <a name="l02282"></a>02282 sr1(:,:) = 0.0 <span class="comment">! NESP,NLEV</span> <a name="l02283"></a>02283 sr2(:,:) = 0.0 <span class="comment">! NESP,NLEV</span> <a name="l02284"></a>02284 <a name="l02285"></a>02285 <span class="comment">! Temperatures in [K]</span> <a name="l02286"></a>02286 <a name="l02287"></a>02287 zsigprev = 1.0 <span class="comment">! sigma value</span> <a name="l02288"></a>02288 ztprev = tgr <span class="comment">! Temperature [K]</span> <a name="l02289"></a>02289 zzprev = 0.0 <span class="comment">! Height [m]</span> <a name="l02290"></a>02290 <a name="l02291"></a>02291 <span class="keyword">do</span> jlev = NLEV , 1 , -1 <span class="comment">! from bottom to top of atmosphere</span> <a name="l02292"></a>02292 zzp=zzprev+(gascon*ztprev/ga)*log(zsigprev/sigma(jlev)) <a name="l02293"></a>02293 ztp=tgr-dtrop*alr <span class="comment">! temperature at tropopause</span> <a name="l02294"></a>02294 ztp=ztp+sqrt((.5*alr*(zzp-dtrop))**2+dttrp**2) <a name="l02295"></a>02295 ztp=ztp-.5*alr*(zzp-dtrop) <a name="l02296"></a>02296 ztpm=.5*(ztprev+ztp) <a name="l02297"></a>02297 zzpp=zzprev+(gascon*ztpm/ga)*log(zsigprev/sigma(jlev)) <a name="l02298"></a>02298 ztpp=tgr-dtrop*alr <a name="l02299"></a>02299 ztpp=ztpp+sqrt((.5*alr*(zzpp-dtrop))**2+dttrp**2) <a name="l02300"></a>02300 ztpp=ztpp-.5*alr*(zzpp-dtrop) <a name="l02301"></a>02301 ztrs(jlev)=ztpp <a name="l02302"></a>02302 zzprev=zzprev+(.5*(ztpp+ztprev)*gascon/ga)*log(zsigprev/sigma(jlev)) <a name="l02303"></a>02303 ztprev=ztpp <a name="l02304"></a>02304 zsigprev=sigma(jlev) <a name="l02305"></a>02305 <span class="keyword">enddo</span> <a name="l02306"></a>02306 <a name="l02307"></a>02307 <span class="keyword">do</span> jlev=1,NLEV <a name="l02308"></a>02308 ztrs(jlev)=ztrs(jlev)/ct <a name="l02309"></a>02309 <span class="keyword">enddo</span> <a name="l02310"></a>02310 <a name="l02311"></a>02311 <span class="comment">!******************************************************************</span> <a name="l02312"></a>02312 <span class="comment">! loop to set array zfac - this controls temperature gradients as a</span> <a name="l02313"></a>02313 <span class="comment">! function of sigma in tres. it is a sine wave from one at</span> <a name="l02314"></a>02314 <span class="comment">! sigma = 1 to zero at stps (sigma at the tropopause) .</span> <a name="l02315"></a>02315 <span class="comment">!******************************************************************</span> <a name="l02316"></a>02316 <span class="comment">! first find sigma at dtrop</span> <a name="l02317"></a>02317 <span class="comment">!</span> <a name="l02318"></a>02318 zttrop=tgr-dtrop*alr <a name="l02319"></a>02319 ztps=(zttrop/tgr)**(ga/(alr*gascon)) <a name="l02320"></a>02320 <span class="comment">!</span> <a name="l02321"></a>02321 <span class="comment">! now the latitudinal variation in tres is set up ( this being in terms</span> <a name="l02322"></a>02322 <span class="comment">! of a deviation from t0 which is usually constant with height)</span> <a name="l02323"></a>02323 <span class="comment">!</span> <a name="l02324"></a>02324 zsqrt2 = sqrt(2.0) <a name="l02325"></a>02325 zsqrt04 = sqrt(0.4) <a name="l02326"></a>02326 zsqrt6 = sqrt(6.0) <a name="l02327"></a>02327 <span class="keyword">do</span> 2100 jlev=1,NLEV <a name="l02328"></a>02328 zfac(jlev)=sin(0.5*PI*(sigma(jlev)-ztps)/(1.-ztps)) <a name="l02329"></a>02329 <span class="keyword">if</span> (zfac(jlev).lt.0.0) zfac(jlev)=0.0 <a name="l02330"></a>02330 sr1(1,jlev)=zsqrt2*(ztrs(jlev)-t0(jlev)) <a name="l02331"></a>02331 sr2(3,jlev)=(1./zsqrt6)*dtns*zfac(jlev) <a name="l02332"></a>02332 sr1(5,jlev)=-2./3.*zsqrt04*dtep*zfac(jlev) <a name="l02333"></a>02333 2100 continue <a name="l02334"></a>02334 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'**************************************************'</span> <a name="l02335"></a>02335 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'* Restoration Temperature set up for aqua planet *'</span> <a name="l02336"></a>02336 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'**************************************************'</span> <a name="l02337"></a>02337 return <a name="l02338"></a>02338 <span class="keyword"> end</span> <a name="l02339"></a>02339 <a name="l02340"></a>02340 <span class="comment">! =======================</span> <a name="l02341"></a>02341 <span class="comment">! SUBROUTINE PRINTPROFILE</span> <a name="l02342"></a>02342 <span class="comment">! =======================</span> <a name="l02343"></a>02343 <a name="l02344"></a><a class="code" href="puma_8f90.html#aa92d6879772b364173e13521d835895e">02344</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aa92d6879772b364173e13521d835895e">printprofile</a> <a name="l02345"></a>02345 use <span class="keywordflow">pumamod</span> <a name="l02346"></a>02346 <a name="l02347"></a>02347 <span class="comment">! **********************************</span> <a name="l02348"></a>02348 <span class="comment">! * write out vertical information *</span> <a name="l02349"></a>02349 <span class="comment">! **********************************</span> <a name="l02350"></a>02350 <a name="l02351"></a>02351 <span class="keyword">write</span>(nud,9001) <a name="l02352"></a>02352 <span class="keyword">write</span>(nud,9002) <a name="l02353"></a>02353 <span class="keyword">write</span>(nud,9003) <a name="l02354"></a>02354 <span class="keyword">write</span>(nud,9002) <a name="l02355"></a>02355 <a name="l02356"></a>02356 <span class="keyword">do</span> jlev=1,NLEV <a name="l02357"></a>02357 zt = (sr1(1,jlev)/sqrt(2.0) + t0(jlev)) * ct <a name="l02358"></a>02358 <span class="keyword">if</span> (tauf(jlev) > 0.1) <span class="keyword">then</span> <a name="l02359"></a>02359 <span class="keyword">write</span>(nud,9004) jlev,sigma(jlev),zt,taur(jlev),tauf(jlev) <a name="l02360"></a>02360 <span class="keyword">else</span> <a name="l02361"></a>02361 <span class="keyword">write</span>(nud,9005) jlev,sigma(jlev),zt,taur(jlev) <a name="l02362"></a>02362 <span class="keyword">endif</span> <a name="l02363"></a>02363 <span class="keyword">enddo</span> <a name="l02364"></a>02364 <a name="l02365"></a>02365 <span class="keyword">write</span>(nud,9002) <a name="l02366"></a>02366 <span class="keyword">write</span>(nud,9001) <a name="l02367"></a>02367 return <a name="l02368"></a>02368 9001 format(/) <a name="l02369"></a>02369 9002 format(36(<span class="stringliteral">'*'</span>)) <a name="l02370"></a>02370 9003 format(<span class="stringliteral">'* Lv * Sigma Restor-T tauR tauF *'</span>) <a name="l02371"></a>02371 9004 format(<span class="stringliteral">'*'</span>,i3,<span class="stringliteral">' * '</span>,f8.3,f9.3,2f5.1,<span class="stringliteral">' *'</span>) <a name="l02372"></a>02372 9005 format(<span class="stringliteral">'*'</span>,i3,<span class="stringliteral">' * '</span>,f8.3,f9.3,f5.1,<span class="stringliteral">' - *'</span>) <a name="l02373"></a>02373 <span class="keyword"> end</span> <a name="l02374"></a>02374 <a name="l02375"></a>02375 <a name="l02376"></a>02376 <span class="comment">! ====================</span> <a name="l02377"></a>02377 <span class="comment">! SUBROUTINE READ_SURF</span> <a name="l02378"></a>02378 <span class="comment">! ====================</span> <a name="l02379"></a>02379 <a name="l02380"></a><a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">02380</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#aa8533c8ebc4415ef95ca9c34c4ba7d6b">read_surf</a>(kcode,psp,klev,kread) <a name="l02381"></a>02381 use <span class="keywordflow">pumamod</span> <a name="l02382"></a>02382 <a name="l02383"></a>02383 <span class="keywordtype">logical</span> :: lexist <a name="l02384"></a>02384 <span class="keywordtype">integer</span> :: kread <a name="l02385"></a>02385 <span class="keywordtype">integer</span> :: ihead(8) <a name="l02386"></a>02386 <span class="keywordtype">character(len=256)</span> :: yfilename <a name="l02387"></a>02387 <span class="keywordtype">real</span> :: psp(NESP,klev) <a name="l02388"></a>02388 <span class="keywordtype">real</span> :: zgp(NUGP,klev) <a name="l02389"></a>02389 <span class="keywordtype">real</span> :: zpp(NHOR,klev) <a name="l02390"></a>02390 <a name="l02391"></a>02391 kread = 0 <a name="l02392"></a>02392 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02393"></a>02393 <span class="keyword">if</span> (NLAT < 1000) <span class="keyword">then</span> <a name="l02394"></a>02394 <span class="keyword">write</span>(yfilename,<span class="stringliteral">'("N",I3.3,"_surf_",I4.4,".sra")'</span>) NLAT,kcode <a name="l02395"></a>02395 <span class="keyword">else</span> <a name="l02396"></a>02396 <span class="keyword">write</span>(yfilename,<span class="stringliteral">'("N",I4.4,"_surf_",I4.4,".sra")'</span>) NLAT,kcode <a name="l02397"></a>02397 <span class="keyword">endif</span> <a name="l02398"></a>02398 <span class="keyword">inquire</span>(file=yfilename,exist=lexist) <a name="l02399"></a>02399 <span class="keyword">endif</span> <a name="l02400"></a>02400 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lexist) <a name="l02401"></a>02401 <span class="keyword">if</span> (.not. lexist) return <a name="l02402"></a>02402 <a name="l02403"></a>02403 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02404"></a>02404 <span class="keyword">open</span>(65,file=yfilename,form=<span class="stringliteral">'formatted'</span>) <a name="l02405"></a>02405 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Reading file <'</span>,trim(yfilename),<span class="stringliteral">'>'</span> <a name="l02406"></a>02406 <span class="keyword">do</span> jlev = 1 , klev <a name="l02407"></a>02407 <span class="keyword">read</span> (65,*) ihead(:) <a name="l02408"></a>02408 <span class="keyword">read</span> (65,*) zgp(:,jlev) <a name="l02409"></a>02409 <span class="keyword">enddo</span> <a name="l02410"></a>02410 <span class="keyword">close</span>(65) <a name="l02411"></a>02411 <span class="keyword">if</span> (kcode == 134) <span class="keyword">then</span> <a name="l02412"></a>02412 <span class="keyword">write</span>(nud,*) <span class="stringliteral">"Converting Ps to LnPs"</span> <a name="l02413"></a>02413 zscale = log(100.0) - log(psurf) <span class="comment">! Input [hPa] / PSURF [Pa]</span> <a name="l02414"></a>02414 zgp(:,:) = log(zgp(:,:)) + zscale <a name="l02415"></a>02415 <span class="keyword">endif</span> <a name="l02416"></a>02416 call <a class="code" href="legsym_8f90.html#a4a468562c0549b4ca3ec6ea34f87545a">reg2alt</a>(zgp,klev) <a name="l02417"></a>02417 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span> <a name="l02418"></a>02418 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,zpp,klev) <a name="l02419"></a>02419 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zpp,NLON,NLPP*klev) <a name="l02420"></a>02420 <span class="keyword">do</span> jlev = 1 , klev <a name="l02421"></a>02421 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zpp(1,jlev),psp(1,jlev)) <a name="l02422"></a>02422 <span class="keyword">enddo</span> <a name="l02423"></a>02423 call <a class="code" href="mpimod_8f90.html#af894efd9525c935f22415e017dcbc482">mpsum</a>(psp,klev) <a name="l02424"></a>02424 kread = 1 <a name="l02425"></a>02425 return <a name="l02426"></a>02426 <span class="keyword"> end subroutine read_surf</span> <a name="l02427"></a>02427 <a name="l02428"></a>02428 <a name="l02429"></a>02429 <a name="l02430"></a>02430 <span class="comment">! =====================</span> <a name="l02431"></a>02431 <span class="comment">! SUBROUTINE READ_VARGP</span> <a name="l02432"></a>02432 <span class="comment">! =====================</span> <a name="l02433"></a>02433 <a name="l02434"></a><a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">02434</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9dfa3f46641f3df498d07ff40df08a57">read_vargp</a>(kcode,klev,kread) <a name="l02435"></a>02435 use <span class="keywordflow">pumamod</span> <a name="l02436"></a>02436 <a name="l02437"></a>02437 <span class="keywordtype">logical</span> :: lexist <a name="l02438"></a>02438 <span class="keywordtype">integer</span> :: ihead(8) <a name="l02439"></a>02439 <span class="keywordtype">character(len=256)</span> :: yfilename <a name="l02440"></a>02440 <span class="keywordtype">real</span> :: zgp(NUGP,klev) <a name="l02441"></a>02441 <a name="l02442"></a>02442 kread = 0 <a name="l02443"></a>02443 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02444"></a>02444 <span class="keyword">if</span> (NLAT < 1000) <span class="keyword">then</span> <a name="l02445"></a>02445 <span class="keyword">write</span>(yfilename,<span class="stringliteral">'("N",I3.3,"_surf_",I4.4,".sra")'</span>) NLAT,kcode <a name="l02446"></a>02446 <span class="keyword">else</span> <a name="l02447"></a>02447 <span class="keyword">write</span>(yfilename,<span class="stringliteral">'("N",I4.4,"_surf_",I4.4,".sra")'</span>) NLAT,kcode <a name="l02448"></a>02448 <span class="keyword">endif</span> <a name="l02449"></a>02449 <span class="keyword">inquire</span>(file=yfilename,exist=lexist) <a name="l02450"></a>02450 <span class="keyword">endif</span> <a name="l02451"></a>02451 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(lexist) <a name="l02452"></a>02452 <span class="keyword">if</span> (.not. lexist) <span class="keyword">then</span> <a name="l02453"></a>02453 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02454"></a>02454 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'File <'</span>,trim(yfilename),<span class="stringliteral">'> not found'</span> <a name="l02455"></a>02455 <span class="keyword">endif</span> <a name="l02456"></a>02456 return <a name="l02457"></a>02457 <span class="keyword">endif</span> <a name="l02458"></a>02458 <a name="l02459"></a>02459 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02460"></a>02460 <span class="keyword">open</span>(65,file=yfilename,form=<span class="stringliteral">'formatted'</span>) <a name="l02461"></a>02461 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Reading file <'</span>,trim(yfilename),<span class="stringliteral">'>'</span> <a name="l02462"></a>02462 <span class="keyword">do</span> jlev = 1 , klev <a name="l02463"></a>02463 <span class="keyword">read</span> (65,*) ihead(:) <a name="l02464"></a>02464 <span class="keyword">read</span> (65,*) zgp(:,jlev) <a name="l02465"></a>02465 <span class="keyword">enddo</span> <a name="l02466"></a>02466 <span class="keyword">close</span>(65) <a name="l02467"></a>02467 call <a class="code" href="legsym_8f90.html#a4a468562c0549b4ca3ec6ea34f87545a">reg2alt</a>(zgp,klev) <a name="l02468"></a>02468 <span class="keyword">endif</span> <span class="comment">! (mypid == NROOT)</span> <a name="l02469"></a>02469 <a name="l02470"></a>02470 <span class="keyword">select</span> <span class="keyword">case</span>(kcode) <a name="l02471"></a>02471 <span class="keyword">case</span>(121) <a name="l02472"></a>02472 <span class="comment">!--- non-dimensionalize and shift const radiative rest. temp.</span> <a name="l02473"></a>02473 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02474"></a>02474 zgp(:,:) = zgp(:,:)/ct <a name="l02475"></a>02475 <span class="keyword">do</span> jhor = 1,nugp <a name="l02476"></a>02476 zgp(jhor,:) = zgp(jhor,:) - t0(:) <a name="l02477"></a>02477 <span class="keyword">enddo</span> <a name="l02478"></a>02478 <span class="keyword">endif</span> <a name="l02479"></a>02479 <span class="keyword">allocate</span>(gr1(nhor,klev)) <a name="l02480"></a>02480 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02481"></a>02481 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Field gr1 allocated'</span> <a name="l02482"></a>02482 <span class="keyword">endif</span> <a name="l02483"></a>02483 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr1,klev) <a name="l02484"></a>02484 <span class="keyword">case</span>(122) <a name="l02485"></a>02485 <span class="comment">!--- non-dimensionalize variable. radiative rest. temp.</span> <a name="l02486"></a>02486 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02487"></a>02487 zgp(:,:) = zgp(:,:)/ct <a name="l02488"></a>02488 <span class="keyword">endif</span> <a name="l02489"></a>02489 <span class="keyword">allocate</span>(gr2(nhor,klev)) <a name="l02490"></a>02490 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02491"></a>02491 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Field gr2 allocated'</span> <a name="l02492"></a>02492 <span class="keyword">endif</span> <a name="l02493"></a>02493 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr2,klev) <a name="l02494"></a>02494 <span class="keyword">case</span>(123) <a name="l02495"></a>02495 <span class="comment">!--- non-dimensionalize radiative relaxation time scale</span> <a name="l02496"></a>02496 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02497"></a>02497 zgp(:,:) = zgp(:,:)/ww <a name="l02498"></a>02498 <span class="keyword">endif</span> <a name="l02499"></a>02499 <span class="keyword">allocate</span>(gtdamp(nhor,klev)) <a name="l02500"></a>02500 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02501"></a>02501 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Field gtdamp allocated'</span> <a name="l02502"></a>02502 <span class="keyword">endif</span> <a name="l02503"></a>02503 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gtdamp,klev) <a name="l02504"></a>02504 <span class="keyword">case</span>(124) <a name="l02505"></a>02505 <span class="comment">!--- non-dimensionalize and shift const. convective rest. temp.</span> <a name="l02506"></a>02506 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02507"></a>02507 zgp(:,:) = zgp(:,:)/ct <a name="l02508"></a>02508 <span class="keyword">do</span> jhor = 1,nugp <a name="l02509"></a>02509 zgp(jhor,:) = zgp(jhor,:) - t0(:) <a name="l02510"></a>02510 <span class="keyword">enddo</span> <a name="l02511"></a>02511 <span class="keyword">endif</span> <a name="l02512"></a>02512 <span class="keyword">allocate</span>(gr1c(nhor,klev)) <a name="l02513"></a>02513 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02514"></a>02514 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Field gr1c allocated'</span> <a name="l02515"></a>02515 <span class="keyword">endif</span> <a name="l02516"></a>02516 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr1c,klev) <a name="l02517"></a>02517 <span class="keyword">case</span>(125) <a name="l02518"></a>02518 <span class="comment">!--- non-dimensionalize variable. convective rest. temp.</span> <a name="l02519"></a>02519 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02520"></a>02520 zgp(:,:) = zgp(:,:)/ct <a name="l02521"></a>02521 <span class="keyword">endif</span> <a name="l02522"></a>02522 <span class="keyword">allocate</span>(gr2c(nhor,klev)) <a name="l02523"></a>02523 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02524"></a>02524 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Field gr2c allocated'</span> <a name="l02525"></a>02525 <span class="keyword">endif</span> <a name="l02526"></a>02526 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gr2c,klev) <a name="l02527"></a>02527 <span class="keyword">case</span>(126) <a name="l02528"></a>02528 <span class="comment">!--- non-dimensionalize convective relaxation time scale</span> <a name="l02529"></a>02529 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02530"></a>02530 zgp(:,:) = zgp(:,:)/ww <a name="l02531"></a>02531 <span class="keyword">endif</span> <a name="l02532"></a>02532 <span class="keyword">allocate</span>(gtdampc(nhor,klev)) <a name="l02533"></a>02533 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02534"></a>02534 <span class="keyword">write</span>(nud,*) <span class="stringliteral">'Field gtdampc allocated'</span> <a name="l02535"></a>02535 <span class="keyword">endif</span> <a name="l02536"></a>02536 call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(zgp,gtdampc,klev) <a name="l02537"></a>02537 <span class="keyword">end select</span> <a name="l02538"></a>02538 kread = 1 <a name="l02539"></a>02539 return <a name="l02540"></a>02540 <span class="keyword"> end subroutine read_vargp</span> <a name="l02541"></a>02541 <a name="l02542"></a>02542 <span class="comment">! ===============</span> <a name="l02543"></a>02543 <span class="comment">! SUBROUTINE DIAG</span> <a name="l02544"></a>02544 <span class="comment">! ===============</span> <a name="l02545"></a>02545 <a name="l02546"></a><a class="code" href="puma_8f90.html#ad0981694b4fc7644f20d9ad785deba27">02546</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ad0981694b4fc7644f20d9ad785deba27">diag</a> <a name="l02547"></a>02547 use <span class="keywordflow">pumamod</span> <a name="l02548"></a>02548 <span class="keyword">if</span> (noutput > 0 .and. mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) == 0) <span class="keyword">then</span> <a name="l02549"></a>02549 <span class="keyword">if</span> (ncoeff > 0) call <a class="code" href="puma_8f90.html#a901150c868c1f2d65744ec49df0c24ed">prisp</a> <a name="l02550"></a>02550 call <a class="code" href="puma_8f90.html#a8e59ae6d7b5a22b0e46c56187cdd62cf">xsect</a> <a name="l02551"></a>02551 <span class="keyword">endif</span> <a name="l02552"></a>02552 call <a class="code" href="puma_8f90.html#a9617b01410b9d0a76ca6ceb1b333bb96">energy</a> <a name="l02553"></a>02553 return <a name="l02554"></a>02554 <span class="keyword"> end</span> <a name="l02555"></a>02555 <a name="l02556"></a>02556 <span class="comment">! ================</span> <a name="l02557"></a>02557 <span class="comment">! SUBROUTINE PRISP</span> <a name="l02558"></a>02558 <span class="comment">! ================</span> <a name="l02559"></a>02559 <a name="l02560"></a><a class="code" href="puma_8f90.html#a901150c868c1f2d65744ec49df0c24ed">02560</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a901150c868c1f2d65744ec49df0c24ed">prisp</a> <a name="l02561"></a>02561 use <span class="keywordflow">pumamod</span> <a name="l02562"></a>02562 <a name="l02563"></a>02563 <span class="keywordtype">character(30)</span> :: title <a name="l02564"></a>02564 <a name="l02565"></a>02565 scale = 100.0 <a name="l02566"></a>02566 title = <span class="stringliteral">'Vorticity [10-2]'</span> <a name="l02567"></a>02567 <span class="keyword">do</span> 100 jlev=1,NLEV <a name="l02568"></a>02568 <span class="keyword">if</span> (ndil(jlev).ne.0) call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(sz(1,jlev),jlev,title,scale) <a name="l02569"></a>02569 100 continue <a name="l02570"></a>02570 <a name="l02571"></a>02571 title = <span class="stringliteral">'Divergence [10-2]'</span> <a name="l02572"></a>02572 <span class="keyword">do</span> 200 jlev=1,NLEV <a name="l02573"></a>02573 <span class="keyword">if</span> (ndil(jlev).ne.0) call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(sd(1,jlev),jlev,title,scale) <a name="l02574"></a>02574 200 continue <a name="l02575"></a>02575 <a name="l02576"></a>02576 scale = 1000.0 <a name="l02577"></a>02577 title = <span class="stringliteral">'Temperature [10-3]'</span> <a name="l02578"></a>02578 <span class="keyword">do</span> 300 jlev=1,NLEV <a name="l02579"></a>02579 <span class="keyword">if</span> (ndil(jlev).ne.0) call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(st(1,jlev),jlev,title,scale) <a name="l02580"></a>02580 300 continue <a name="l02581"></a>02581 <a name="l02582"></a>02582 title = <span class="stringliteral">'Pressure [10-3]'</span> <a name="l02583"></a>02583 call <a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(sp,0,title,scale) <a name="l02584"></a>02584 <a name="l02585"></a>02585 return <a name="l02586"></a>02586 <span class="keyword"> end</span> <a name="l02587"></a>02587 <a name="l02588"></a>02588 <span class="comment">! ====================</span> <a name="l02589"></a>02589 <span class="comment">! SUBROUTINE POWERSPEC</span> <a name="l02590"></a>02590 <span class="comment">! ====================</span> <a name="l02591"></a>02591 <a name="l02592"></a><a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">02592</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(pf,pspec) <a name="l02593"></a>02593 use <span class="keywordflow">pumamod</span> <a name="l02594"></a>02594 <span class="keywordtype">real</span> :: pf(2,NCSP) <a name="l02595"></a>02595 <span class="keywordtype">real</span> :: pspec(NTP1) <a name="l02596"></a>02596 <a name="l02597"></a>02597 <span class="keyword">do</span> j = 1 , NTP1 <a name="l02598"></a>02598 pspec(j) = 0.5 * (pf(1,j) * pf(1,j) + pf(2,j) * pf(2,j)) <a name="l02599"></a>02599 <span class="keyword">enddo</span> <a name="l02600"></a>02600 <a name="l02601"></a>02601 j = NTP1 + 1 <a name="l02602"></a>02602 <span class="keyword">do</span> m = 2 , NTP1 <a name="l02603"></a>02603 <span class="keyword">do</span> l = m , NTP1 <a name="l02604"></a>02604 pspec(l) = pspec(l) + pf(1,j) * pf(1,j) + pf(2,j) * pf(2,j) <a name="l02605"></a>02605 j = j + 1 <a name="l02606"></a>02606 <span class="keyword">enddo</span> <a name="l02607"></a>02607 <span class="keyword">enddo</span> <a name="l02608"></a>02608 return <a name="l02609"></a>02609 <span class="keyword"> end</span> <a name="l02610"></a>02610 <a name="l02611"></a>02611 <span class="comment">! =====================</span> <a name="l02612"></a>02612 <span class="comment">! SUBROUTINE POWERPRINT</span> <a name="l02613"></a>02613 <span class="comment">! =====================</span> <a name="l02614"></a>02614 <a name="l02615"></a><a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">02615</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(text,pspec) <a name="l02616"></a>02616 use <span class="keywordflow">pumamod</span> <a name="l02617"></a>02617 <span class="keywordtype">character(3)</span> :: text <a name="l02618"></a>02618 <span class="keywordtype">real</span> :: pspec(NTP1) <a name="l02619"></a>02619 <a name="l02620"></a>02620 zmax = maxval(pspec(:)) <a name="l02621"></a>02621 <span class="keyword">if</span> (zmax <= 1.0e-20) return <a name="l02622"></a>02622 zsca = 10 ** (4 - int(log10(zmax))) <a name="l02623"></a>02623 <span class="keyword">write</span>(nud,1000) text,(int(pspec(j)*zsca),j=2,13) <a name="l02624"></a>02624 return <a name="l02625"></a>02625 1000 format(<span class="stringliteral">'* Power('</span>,a3,<span class="stringliteral">') '</span>,i8,11i5,<span class="stringliteral">' *'</span>) <a name="l02626"></a>02626 <span class="keyword"> end</span> <a name="l02627"></a>02627 <a name="l02628"></a>02628 <a name="l02629"></a>02629 <a name="l02630"></a>02630 <a name="l02631"></a>02631 <span class="comment">! ==============</span> <a name="l02632"></a>02632 <span class="comment">! FUNCTION RMSSP</span> <a name="l02633"></a>02633 <span class="comment">! ==============</span> <a name="l02634"></a>02634 <a name="l02635"></a><a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">02635</a> <span class="keyword">function </span><a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(pf) <a name="l02636"></a>02636 use <span class="keywordflow">pumamod</span> <a name="l02637"></a>02637 <span class="keywordtype">real</span> pf(NESP,NLEV) <a name="l02638"></a>02638 <a name="l02639"></a>02639 zsum = 0.0 <a name="l02640"></a>02640 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l02641"></a>02641 zsum = zsum + dsigma(jlev)& <a name="l02642"></a>02642 & * (dot_product(pf(1:NZOM,jlev),pf(1:NZOM,jlev)) * 0.5& <a name="l02643"></a>02643 & + dot_product(pf(NZOM+1:NRSP,jlev),pf(NZOM+1:NRSP,jlev))) <a name="l02644"></a>02644 <span class="keyword">enddo</span> <a name="l02645"></a>02645 <a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a> = zsum <a name="l02646"></a>02646 return <a name="l02647"></a>02647 <span class="keyword"> end</span> <a name="l02648"></a>02648 <a name="l02649"></a>02649 <span class="comment">! =================</span> <a name="l02650"></a>02650 <span class="comment">! SUBROUTINE ENERGY</span> <a name="l02651"></a>02651 <span class="comment">! =================</span> <a name="l02652"></a>02652 <a name="l02653"></a><a class="code" href="puma_8f90.html#a9617b01410b9d0a76ca6ceb1b333bb96">02653</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a9617b01410b9d0a76ca6ceb1b333bb96">energy</a> <a name="l02654"></a>02654 use <span class="keywordflow">pumamod</span> <a name="l02655"></a>02655 <a name="l02656"></a>02656 parameter (idim=5) <span class="comment">! Number of scalars for GUI timeseries</span> <a name="l02657"></a>02657 <a name="l02658"></a>02658 <span class="comment">! calculates various global diagnostic quantities</span> <a name="l02659"></a>02659 <span class="comment">! remove planetary vorticity so sz contains relative vorticity</span> <a name="l02660"></a>02660 <a name="l02661"></a>02661 <span class="keywordtype">real</span> :: spec(NTP1) <a name="l02662"></a>02662 <span class="keywordtype">real (kind=4)</span> ziso(idim) <a name="l02663"></a>02663 <a name="l02664"></a>02664 sz(3,:) = sz(3,:) - plavor <a name="l02665"></a>02665 <a name="l02666"></a>02666 <span class="comment">! ***********************************************</span> <a name="l02667"></a>02667 <span class="comment">! calculate means - zpsitot rms vorticity</span> <a name="l02668"></a>02668 <span class="comment">! zchitot rms divergence</span> <a name="l02669"></a>02669 <span class="comment">! ztmptot rms temperature</span> <a name="l02670"></a>02670 <span class="comment">! ztotp ie+pe potential energy</span> <a name="l02671"></a>02671 <span class="comment">! zamsp mean surface pressure</span> <a name="l02672"></a>02672 <span class="comment">! ***********************************************</span> <a name="l02673"></a>02673 <a name="l02674"></a>02674 zsqrt2 = sqrt(2.0) <a name="l02675"></a>02675 zamsp = 1.0 + span(1) / zsqrt2 <a name="l02676"></a>02676 zst = dot_product(dsigma(:),st(1,:)) / zsqrt2 <a name="l02677"></a>02677 ztout1 = dot_product(dsigma(:),t0(:)) <a name="l02678"></a>02678 <a name="l02679"></a>02679 ztout2 = 0.0 <a name="l02680"></a>02680 zst2b = 0.0 <a name="l02681"></a>02681 ztoti = 0.0 <a name="l02682"></a>02682 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l02683"></a>02683 ztout2 = ztout2 + dsigma(jlev) * t0(jlev) * t0(jlev) <a name="l02684"></a>02684 zst2b = zst2b + dsigma(jlev) * t0(jlev) * st(1,jlev) <a name="l02685"></a>02685 ztoti = ztoti + dsigma(jlev)& <a name="l02686"></a>02686 & * (dot_product(span(1:NZOM),st(1:NZOM,jlev)) * 0.5& <a name="l02687"></a>02687 & + dot_product(span(NZOM+1:NRSP),st(NZOM+1:NRSP,jlev))) <a name="l02688"></a>02688 <span class="keyword">enddo</span> <a name="l02689"></a>02689 <a name="l02690"></a>02690 ztotp = dot_product(span(1:NZOM),so(1:NZOM)) * 0.5& <a name="l02691"></a>02691 & + dot_product(span(NZOM+1:NRSP),so(NZOM+1:NRSP))& <a name="l02692"></a>02692 & + so(1)/zsqrt2 + (zamsp*ztout1+ztoti+zst) / akap <a name="l02693"></a>02693 <a name="l02694"></a>02694 zpsitot = sqrt(<a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(sz)) <a name="l02695"></a>02695 zchitot = sqrt(<a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(sd)) <a name="l02696"></a>02696 ztmptot = sqrt(<a class="code" href="puma_8f90.html#a87f2e4ed3831dc32e18d25fe42d0bfab">rmssp</a>(st)+ztout2+zst2b*zsqrt2) <a name="l02697"></a>02697 <a name="l02698"></a>02698 ziso(1) = ct * (spnorm(1) * st(1,NLEV) + t0(NLEV)) - 273.16 <span class="comment">! T(NLEV) [C]</span> <a name="l02699"></a>02699 ziso(2) = ww * zchitot * 1.0e6 <a name="l02700"></a>02700 ziso(3) = ztmptot <a name="l02701"></a>02701 ziso(4) = ztotp <a name="l02702"></a>02702 ziso(5) = sz(3,2) <a name="l02703"></a>02703 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">"SCALAR"</span> // char(0) ,ziso,idim,1,1) <a name="l02704"></a>02704 <a name="l02705"></a>02705 <span class="comment">! restore sz to absolute vorticity</span> <a name="l02706"></a>02706 <a name="l02707"></a>02707 sz(3,:) = sz(3,:) + plavor <a name="l02708"></a>02708 <a name="l02709"></a>02709 <span class="keyword">if</span> (mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) /= 0) return <span class="comment">! was called for GUI only</span> <a name="l02710"></a>02710 <span class="keyword">write</span>(nud,9001) <a name="l02711"></a>02711 <span class="keyword">write</span>(nud,9002) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,zpsitot,zchitot,ztmptot,ztotp,zamsp <a name="l02712"></a>02712 <span class="keyword">write</span>(nud,9002) <a name="l02713"></a>02713 <span class="keyword">write</span>(nud,9011) (j,j=1,12) <a name="l02714"></a>02714 <span class="keyword">write</span>(nud,9012) <a name="l02715"></a>02715 call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(span,spec) <a name="l02716"></a>02716 call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">'Pre'</span>,spec) <a name="l02717"></a>02717 call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(sz(1,NLEV),spec) <a name="l02718"></a>02718 call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">'Vor'</span>,spec) <a name="l02719"></a>02719 call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(sd(1,NLEV),spec) <a name="l02720"></a>02720 call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">'Div'</span>,spec) <a name="l02721"></a>02721 call <a class="code" href="puma_8f90.html#a8625954404de5b08c55626c4f8a62972">powerspec</a>(st(1,NLEV),spec) <a name="l02722"></a>02722 call <a class="code" href="puma_8f90.html#a53adeff6424dd4b2f124771625a47ca5">powerprint</a>(<span class="stringliteral">'Tem'</span>,spec) <a name="l02723"></a>02723 return <a name="l02724"></a>02724 9001 format(/, <a name="l02725"></a>02725 <span class="stringliteral">' nstep rms z rms d rms t & & pe+ie msp'</span>) <a name="l02726"></a>02726 9002 format(i10,4x,4g12.5,g15.8) <a name="l02727"></a>02727 <span class="comment">!9009 format('*',75(' '),' *')</span> <a name="l02728"></a>02728 <span class="comment">!9010 format('* Power(',a,') ',7e9.2,' *')</span> <a name="l02729"></a>02729 9011 format(<span class="stringliteral">'* Wavenumber '</span>,i8,11i5,<span class="stringliteral">' *'</span>) <a name="l02730"></a>02730 9012 format(<span class="stringliteral">''</span>,78(<span class="stringliteral">'*'</span>)) <a name="l02731"></a>02731 <span class="keyword"> end</span> <a name="l02732"></a>02732 <a name="l02733"></a>02733 <span class="comment">! =================</span> <a name="l02734"></a>02734 <span class="comment">! SUBROUTINE NTOMIN</span> <a name="l02735"></a>02735 <span class="comment">! =================</span> <a name="l02736"></a>02736 <a name="l02737"></a><a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">02737</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(kstep,imin,ihou,iday,imon,iyea) <a name="l02738"></a>02738 use <span class="keywordflow">pumamod</span> <a name="l02739"></a>02739 istep = kstep <span class="comment">! day [0-29] month [0-11]</span> <a name="l02740"></a>02740 <span class="keyword">if</span> (istep .lt. 0) istep = 0 <span class="comment">! min [0-59] hour [0-23]</span> <a name="l02741"></a>02741 imin = mod(istep,ntspd) * 1440 / ntspd <span class="comment">! minutes of current day</span> <a name="l02742"></a>02742 ihou = imin / 60 <span class="comment">! hours of current day</span> <a name="l02743"></a>02743 imin = imin - ihou * 60 <span class="comment">! minutes of current hour</span> <a name="l02744"></a>02744 iday = istep / ntspd <span class="comment">! days in this run</span> <a name="l02745"></a>02745 imon = iday / 30 <span class="comment">! months in this run</span> <a name="l02746"></a>02746 iday = iday - imon * 30 <span class="comment">! days of current month</span> <a name="l02747"></a>02747 iyea = imon / 12 <span class="comment">! years in this run</span> <a name="l02748"></a>02748 imon = imon - iyea * 12 <span class="comment">! month of current year</span> <a name="l02749"></a>02749 iday = iday + 1 <a name="l02750"></a>02750 imon = imon + 1 <a name="l02751"></a>02751 iyea = iyea + 1 <a name="l02752"></a>02752 return <a name="l02753"></a>02753 <span class="keyword"> end</span> <a name="l02754"></a>02754 <a name="l02755"></a>02755 <span class="comment">! =================</span> <a name="l02756"></a>02756 <span class="comment">! SUBROUTINE NTODAT</span> <a name="l02757"></a>02757 <span class="comment">! =================</span> <a name="l02758"></a>02758 <a name="l02759"></a><a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">02759</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">ntodat</a>(istep,datch) <a name="l02760"></a>02760 <span class="keywordtype">character(18)</span> :: datch <a name="l02761"></a>02761 <span class="keywordtype">character(3)</span> :: mona(12) <a name="l02762"></a>02762 <span class="keyword">data</span> mona /<span class="stringliteral">'Jan'</span>,<span class="stringliteral">'Feb'</span>,<span class="stringliteral">'Mar'</span>,<span class="stringliteral">'Apr'</span>,<span class="stringliteral">'May'</span>,<span class="stringliteral">'Jun'</span>,& <a name="l02763"></a>02763 & <span class="stringliteral">'Jul'</span>,<span class="stringliteral">'Aug'</span>,<span class="stringliteral">'Sep'</span>,<span class="stringliteral">'Oct'</span>,<span class="stringliteral">'Nov'</span>,<span class="stringliteral">'Dec'</span>/ <a name="l02764"></a>02764 call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(istep,imin,ihou,iday,imon,iyea) <a name="l02765"></a>02765 <span class="keyword">write</span>(datch,20030) iday,mona(imon),iyea,ihou,imin <a name="l02766"></a>02766 20030 format(i2,<span class="stringliteral">'-'</span>,a3,<span class="stringliteral">'-'</span>,i4.4,2x,i2,<span class="stringliteral">':'</span>,i2.2) <a name="l02767"></a>02767 <span class="keyword"> end</span> <a name="l02768"></a>02768 <a name="l02769"></a>02769 <a name="l02770"></a>02770 <span class="comment">! =================</span> <a name="l02771"></a>02771 <span class="comment">! SUBROUTINE WRSPAM</span> <a name="l02772"></a>02772 <span class="comment">! =================</span> <a name="l02773"></a>02773 <a name="l02774"></a><a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">02774</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a7d2fe5c057c4ef8c0b7981ddeb0cce41">wrspam</a>(ps,klev,title,scale) <a name="l02775"></a>02775 use <span class="keywordflow">pumamod</span> <a name="l02776"></a>02776 <span class="comment">!</span> <a name="l02777"></a>02777 dimension ps(NRSP) <a name="l02778"></a>02778 <span class="keywordtype">character(30)</span> :: title <a name="l02779"></a>02779 <span class="keywordtype">character(18)</span> :: datch <a name="l02780"></a>02780 <a name="l02781"></a>02781 <span class="comment">! cab(i)=real(scale*sqrt(ps(i+i-1)*ps(i+i-1)+ps(i+i)*ps(i+i)))</span> <a name="l02782"></a>02782 <a name="l02783"></a>02783 call <a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">ntodat</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,datch) <a name="l02784"></a>02784 <span class="keyword">write</span>(nud,<span class="stringliteral">'(1x)'</span>) <a name="l02785"></a>02785 <span class="keyword">write</span>(nud,20000) <a name="l02786"></a>02786 <span class="keyword">write</span>(nud,20030) datch,title,klev <a name="l02787"></a>02787 <span class="keyword">write</span>(nud,20000) <a name="l02788"></a>02788 <span class="keyword">write</span>(nud,20020) (i,i=0,9) <a name="l02789"></a>02789 <span class="keyword">write</span>(nud,20000) <a name="l02790"></a>02790 <span class="keyword">write</span>(nud,20100) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=1,10) <a name="l02791"></a>02791 <span class="keyword">write</span>(nud,20200) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=NTRU+2,NTRU+10) <a name="l02792"></a>02792 <span class="keyword">write</span>(nud,20300) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=2*NTRU+2,2*NTRU+9) <a name="l02793"></a>02793 <span class="keyword">write</span>(nud,20400) (<a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i),i=3*NTRU+1,3*NTRU+7) <a name="l02794"></a>02794 <span class="keyword">write</span>(nud,20000) <a name="l02795"></a>02795 <span class="keyword">write</span>(nud,<span class="stringliteral">'(1x)'</span>) <a name="l02796"></a>02796 <a name="l02797"></a>02797 20000 format(78(<span class="stringliteral">'*'</span>)) <a name="l02798"></a>02798 20020 format(<span class="stringliteral">'* n * '</span>,10i7,<span class="stringliteral">' *'</span>) <a name="l02799"></a>02799 20030 format(<span class="stringliteral">'* * '</span>,a18,2x,a30,<span class="stringliteral">' Level '</span>,i2,11x,<span class="stringliteral">'*'</span>) <a name="l02800"></a>02800 20100 format(<span class="stringliteral">'* 0 *'</span>,f8.2,9f7.2,<span class="stringliteral">' *'</span>) <a name="l02801"></a>02801 20200 format(<span class="stringliteral">'* 1 *'</span>,8x,9f7.2,<span class="stringliteral">' *'</span>) <a name="l02802"></a>02802 20300 format(<span class="stringliteral">'* 2 *'</span>,15x,8f7.2,<span class="stringliteral">' *'</span>) <a name="l02803"></a>02803 20400 format(<span class="stringliteral">'* 3 *'</span>,22x,7f7.2,<span class="stringliteral">' *'</span>) <a name="l02804"></a>02804 <span class="keyword">contains</span> <a name="l02805"></a><a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">02805</a> <span class="keyword">function </span><a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a>(i) <a name="l02806"></a>02806 <a class="code" href="puma_8f90.html#a41d141fdb78d222639310fec575eaea5">cab</a> = scale * sqrt(ps(i+i-1)*ps(i+i-1)+ps(i+i)*ps(i+i)) <a name="l02807"></a>02807 <span class="keyword"> end function cab</span> <a name="l02808"></a>02808 <span class="keyword"> end</span> <a name="l02809"></a>02809 <a name="l02810"></a>02810 <span class="comment">! ===============</span> <a name="l02811"></a>02811 <span class="comment">! SUBROUTINE WRZS</span> <a name="l02812"></a>02812 <span class="comment">! ===============</span> <a name="l02813"></a>02813 <a name="l02814"></a><a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">02814</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(zs,title,scale) <a name="l02815"></a>02815 use <span class="keywordflow">pumamod</span> <a name="l02816"></a>02816 <span class="comment">!</span> <a name="l02817"></a>02817 dimension zs(NLAT,NLEV) <a name="l02818"></a>02818 <span class="keywordtype">character(30)</span> :: title <a name="l02819"></a>02819 <span class="keywordtype">character(18)</span> :: datch <a name="l02820"></a>02820 <a name="l02821"></a>02821 ip = NLAT / 16 <a name="l02822"></a>02822 ia = ip/2 <a name="l02823"></a>02823 ib = ia + 7 * ip <a name="l02824"></a>02824 id = NLAT + 1 - ia <a name="l02825"></a>02825 ic = id - 7 * ip <a name="l02826"></a>02826 <a name="l02827"></a>02827 call <a class="code" href="puma_8f90.html#a6b0de7569cc691823dd1104ff42a6993">ntodat</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,datch) <a name="l02828"></a>02828 <span class="keyword">write</span>(nud,<span class="stringliteral">'(1x)'</span>) <a name="l02829"></a>02829 <span class="keyword">write</span>(nud,20000) <a name="l02830"></a>02830 <span class="keyword">write</span>(nud,20030) datch,title <a name="l02831"></a>02831 <span class="keyword">write</span>(nud,20000) <a name="l02832"></a>02832 <span class="keyword">write</span>(nud,20020) (chlat(i),i=ia,ib,ip),(chlat(j),j=ic,id,ip) <a name="l02833"></a>02833 <span class="keyword">write</span>(nud,20000) <a name="l02834"></a>02834 <span class="keyword">do</span> 200 jlev = 1 , NLEV <a name="l02835"></a>02835 <span class="keyword">write</span>(nud,20100) jlev,((int(zs(i,jlev)*scale)),i=ia,ib,ip),& <a name="l02836"></a>02836 & ((int(zs(j,jlev)*scale)),j=ic,id,ip),jlev <a name="l02837"></a>02837 200 continue <a name="l02838"></a>02838 <span class="keyword">write</span>(nud,20000) <a name="l02839"></a>02839 <span class="keyword">write</span>(nud,<span class="stringliteral">'(1x)'</span>) <a name="l02840"></a>02840 <a name="l02841"></a>02841 20000 format(78(<span class="stringliteral">'*'</span>)) <a name="l02842"></a>02842 20020 format(<span class="stringliteral">'* Lv * '</span>,16(1x,a3),<span class="stringliteral">' * Lv *'</span>) <a name="l02843"></a>02843 20030 format(<span class="stringliteral">'* * '</span>,a18,2x,a30,20x,<span class="stringliteral">'*'</span>) <a name="l02844"></a>02844 20100 format(<span class="stringliteral">'* '</span>,i2,<span class="stringliteral">' * '</span>,16i4,<span class="stringliteral">' * '</span>,i2,<span class="stringliteral">' *'</span>) <a name="l02845"></a>02845 <span class="keyword"> end</span> <a name="l02846"></a>02846 <a name="l02847"></a>02847 <span class="comment">! ================</span> <a name="l02848"></a>02848 <span class="comment">! SUBROUTINE XSECT</span> <a name="l02849"></a>02849 <span class="comment">! ================</span> <a name="l02850"></a>02850 <a name="l02851"></a><a class="code" href="puma_8f90.html#a8e59ae6d7b5a22b0e46c56187cdd62cf">02851</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a8e59ae6d7b5a22b0e46c56187cdd62cf">xsect</a> <a name="l02852"></a>02852 use <span class="keywordflow">pumamod</span> <a name="l02853"></a>02853 <span class="keywordtype">character(30)</span> :: title <a name="l02854"></a>02854 <a name="l02855"></a>02855 scale = 10.0 <a name="l02856"></a>02856 title = <span class="stringliteral">'Zonal Wind [0.1 m/s]'</span> <a name="l02857"></a>02857 call <a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(csu,title,scale) <a name="l02858"></a>02858 title = <span class="stringliteral">'Meridional Wind [0.1 m/s]'</span> <a name="l02859"></a>02859 call <a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(csv,title,scale) <a name="l02860"></a>02860 scale = 1.0 <a name="l02861"></a>02861 title = <span class="stringliteral">'Temperature [C]'</span> <a name="l02862"></a>02862 call <a class="code" href="puma_8f90.html#a03b2185c8a9dc75ed4169a7d9bf65863">wrzs</a>(cst,title,scale) <a name="l02863"></a>02863 return <a name="l02864"></a>02864 <span class="keyword"> end</span> <a name="l02865"></a>02865 <a name="l02866"></a>02866 <span class="comment">! ==================</span> <a name="l02867"></a>02867 <span class="comment">! SUBROUTINE WRITESP</span> <a name="l02868"></a>02868 <span class="comment">! ==================</span> <a name="l02869"></a>02869 <a name="l02870"></a><a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">02870</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(kunit,pf,kcode,klev,pscale,poff) <a name="l02871"></a>02871 use <span class="keywordflow">pumamod</span> <a name="l02872"></a>02872 <span class="keywordtype">real</span> :: pf(NRSP) <a name="l02873"></a>02873 <span class="keywordtype">real</span> :: zf(NRSP) <a name="l02874"></a>02874 <span class="keywordtype">integer</span> :: ihead(8) <a name="l02875"></a>02875 <a name="l02876"></a>02876 call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nmin,nhour,nday,nmonth,nyear) <a name="l02877"></a>02877 <a name="l02878"></a>02878 ihead(1) = kcode <a name="l02879"></a>02879 ihead(2) = klev <a name="l02880"></a>02880 ihead(3) = nday + 100 * nmonth + 10000 * nyear <a name="l02881"></a>02881 ihead(4) = nmin + 100 * nhour <a name="l02882"></a>02882 ihead(5) = NRSP <a name="l02883"></a>02883 ihead(6) = 1 <a name="l02884"></a>02884 ihead(7) = 1 <a name="l02885"></a>02885 ihead(8) = 0 <a name="l02886"></a>02886 <a name="l02887"></a>02887 <span class="comment">! normalize ECHAM compatible and scale to physical dimensions</span> <a name="l02888"></a>02888 <a name="l02889"></a>02889 zf(:) = pf(:) * spnorm(1:NRSP) * pscale <a name="l02890"></a>02890 zf(1) = zf(1) + poff <span class="comment">! Add offset if necessary</span> <a name="l02891"></a>02891 <span class="keyword">write</span>(kunit) ihead <a name="l02892"></a>02892 <span class="keyword">write</span>(kunit) zf <a name="l02893"></a>02893 <a name="l02894"></a>02894 return <a name="l02895"></a>02895 <span class="keyword"> end</span> <a name="l02896"></a>02896 <a name="l02897"></a>02897 <span class="comment">! ==================</span> <a name="l02898"></a>02898 <span class="comment">! SUBROUTINE WRITEGP</span> <a name="l02899"></a>02899 <span class="comment">! ==================</span> <a name="l02900"></a>02900 <a name="l02901"></a><a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">02901</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">writegp</a>(kunit,pf,kcode,klev) <a name="l02902"></a>02902 use <span class="keywordflow">pumamod</span> <a name="l02903"></a>02903 <span class="keywordtype">real</span> :: pf(NHOR) <a name="l02904"></a>02904 <span class="keywordtype">real</span> :: zf(NUGP) <a name="l02905"></a>02905 <span class="keywordtype">integer</span> :: ihead(8) <a name="l02906"></a>02906 <a name="l02907"></a>02907 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(zf,pf,1) <a name="l02908"></a>02908 <a name="l02909"></a>02909 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l02910"></a>02910 call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(zf,1) <a name="l02911"></a>02911 call <a class="code" href="puma_8f90.html#a6628dcb7258ff7477a7bc7f3098cded3">ntomin</a>(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,nmin,nhour,nday,nmonth,nyear) <a name="l02912"></a>02912 <a name="l02913"></a>02913 ihead(1) = kcode <a name="l02914"></a>02914 ihead(2) = klev <a name="l02915"></a>02915 ihead(3) = nday + 100 * nmonth + 10000 * nyear <a name="l02916"></a>02916 ihead(4) = nmin + 100 * nhour <a name="l02917"></a>02917 ihead(5) = NLON <a name="l02918"></a>02918 ihead(6) = NLAT <a name="l02919"></a>02919 ihead(7) = 1 <a name="l02920"></a>02920 ihead(8) = 0 <a name="l02921"></a>02921 <a name="l02922"></a>02922 <span class="keyword">write</span>(kunit) ihead <a name="l02923"></a>02923 <span class="keyword">write</span>(kunit) zf <a name="l02924"></a>02924 <span class="keyword">endif</span> <a name="l02925"></a>02925 <a name="l02926"></a>02926 return <a name="l02927"></a>02927 <span class="keyword"> end </span> <a name="l02928"></a>02928 <a name="l02929"></a>02929 <a name="l02930"></a>02930 <span class="comment">! ================</span> <a name="l02931"></a>02931 <span class="comment">! SUBROUTINE OUTSP</span> <a name="l02932"></a>02932 <span class="comment">! ================</span> <a name="l02933"></a>02933 <a name="l02934"></a><a class="code" href="puma_8f90.html#a0352cc6bbeedace31c54d9afba847ad6">02934</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0352cc6bbeedace31c54d9afba847ad6">outsp</a> <a name="l02935"></a>02935 use <span class="keywordflow">pumamod</span> <a name="l02936"></a>02936 <span class="keywordtype">real</span> zsr(NESP) <a name="l02937"></a>02937 <a name="l02938"></a>02938 <span class="keyword">if</span> (nwrioro == 1) <span class="keyword">then</span> <a name="l02939"></a>02939 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,so,129,0,cv*cv,0.0) <a name="l02940"></a>02940 nwrioro = 0 <a name="l02941"></a>02941 <span class="keyword">endif</span> <a name="l02942"></a>02942 <a name="l02943"></a>02943 <span class="keyword">if</span> (nextout == 1) <span class="keyword">then</span> <a name="l02944"></a>02944 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sp2,40,0,1.0,log(psmean)) <a name="l02945"></a>02945 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sp1,41,0,1.0,log(psmean)) <a name="l02946"></a>02946 <span class="keyword">do</span> jlev = 1,NLEV <a name="l02947"></a>02947 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,st2(1,jlev),42,jlev,ct,t0(jlev)*ct) <a name="l02948"></a>02948 <span class="keyword">enddo</span> <a name="l02949"></a>02949 <span class="keyword">do</span> jlev = 1,NLEV <a name="l02950"></a>02950 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,st1(1,jlev),43,jlev,ct,t0(jlev)*ct) <a name="l02951"></a>02951 <span class="keyword">enddo</span> <a name="l02952"></a>02952 <span class="keyword">endif</span> <a name="l02953"></a>02953 <a name="l02954"></a>02954 <span class="comment">! ************</span> <a name="l02955"></a>02955 <span class="comment">! * pressure *</span> <a name="l02956"></a>02956 <span class="comment">! ************</span> <a name="l02957"></a>02957 <a name="l02958"></a>02958 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sp,152,0,1.0,log(psmean)) <a name="l02959"></a>02959 <a name="l02960"></a>02960 <span class="comment">! ***************</span> <a name="l02961"></a>02961 <span class="comment">! * temperature *</span> <a name="l02962"></a>02962 <span class="comment">! ***************</span> <a name="l02963"></a>02963 <a name="l02964"></a>02964 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l02965"></a>02965 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,st(1,jlev),130,jlev,ct,t0(jlev)*ct) <a name="l02966"></a>02966 <span class="keyword">enddo</span> <a name="l02967"></a>02967 <a name="l02968"></a>02968 <span class="comment">! ********************</span> <a name="l02969"></a>02969 <span class="comment">! * res. temperature *</span> <a name="l02970"></a>02970 <span class="comment">! ********************</span> <a name="l02971"></a>02971 <a name="l02972"></a>02972 zampl = cos((<span class="keywordtype">real</span>(nstep)-pac)*tac) <a name="l02973"></a>02973 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l02974"></a>02974 zsr(:)=sr1(:,jlev)+sr2(:,jlev)*zampl <a name="l02975"></a>02975 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,zsr,154,jlev,ct,t0(jlev)*ct) <a name="l02976"></a>02976 <span class="keyword">enddo</span> <a name="l02977"></a>02977 <a name="l02978"></a>02978 <span class="comment">! **************</span> <a name="l02979"></a>02979 <span class="comment">! * divergence *</span> <a name="l02980"></a>02980 <span class="comment">! **************</span> <a name="l02981"></a>02981 <a name="l02982"></a>02982 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l02983"></a>02983 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sd(1,jlev),155,jlev,ww,0.0) <a name="l02984"></a>02984 <span class="keyword">enddo</span> <a name="l02985"></a>02985 <a name="l02986"></a>02986 <span class="comment">! *************</span> <a name="l02987"></a>02987 <span class="comment">! * vorticity *</span> <a name="l02988"></a>02988 <span class="comment">! *************</span> <a name="l02989"></a>02989 <a name="l02990"></a>02990 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l02991"></a>02991 zsave = sz(3,jlev) <a name="l02992"></a>02992 sz(3,jlev) = sz(3,jlev) - plavor <a name="l02993"></a>02993 call <a class="code" href="puma_8f90.html#a29f97b19d997b3a5c29df1fd4cdd4792">writesp</a>(40,sz(1,jlev),138,jlev,ww,0.0) <a name="l02994"></a>02994 sz(3,jlev) = zsave <a name="l02995"></a>02995 <span class="keyword">enddo</span> <a name="l02996"></a>02996 <a name="l02997"></a>02997 return <a name="l02998"></a>02998 <span class="keyword"> end</span> <a name="l02999"></a>02999 <a name="l03000"></a>03000 <span class="comment">! ================</span> <a name="l03001"></a>03001 <span class="comment">! SUBROUTINE OUTGP</span> <a name="l03002"></a>03002 <span class="comment">! ================</span> <a name="l03003"></a>03003 <a name="l03004"></a><a class="code" href="puma_8f90.html#a1f5ebb3d7ab8cc007a6ed2d81b858f03">03004</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a1f5ebb3d7ab8cc007a6ed2d81b858f03">outgp</a> <a name="l03005"></a>03005 use <span class="keywordflow">pumamod</span> <a name="l03006"></a>03006 <span class="keywordtype">real</span> zhelp(NHOR) <a name="l03007"></a>03007 <span class="comment">! </span> <a name="l03008"></a>03008 <span class="comment">! energy diagnostics</span> <a name="l03009"></a>03009 <span class="comment">! </span> <a name="l03010"></a>03010 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03011"></a>03011 <span class="keyword">do</span> je=1,9 <a name="l03012"></a>03012 jcode=300+je <a name="l03013"></a>03013 zhelp(:)=denergy(:,je) <a name="l03014"></a>03014 call <a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">writegp</a>(40,zhelp,jcode,0) <a name="l03015"></a>03015 <span class="keyword">enddo</span> <a name="l03016"></a>03016 <span class="keyword">endif</span> <a name="l03017"></a>03017 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l03018"></a>03018 <span class="keyword">do</span> je=1,9 <a name="l03019"></a>03019 jcode=310+je <a name="l03020"></a>03020 zhelp(:)=dentropy(:,je) <a name="l03021"></a>03021 call <a class="code" href="puma_8f90.html#a8f8e06ff9c98bc44f6c356d5ffc0a426">writegp</a>(40,zhelp,jcode,0) <a name="l03022"></a>03022 <span class="keyword">enddo</span> <a name="l03023"></a>03023 <span class="keyword">endif</span> <a name="l03024"></a>03024 <span class="comment">!</span> <a name="l03025"></a>03025 return <a name="l03026"></a>03026 <span class="keyword"> end</span> <a name="l03027"></a>03027 <a name="l03028"></a>03028 <a name="l03029"></a>03029 <span class="comment">! ====================</span> <a name="l03030"></a>03030 <span class="comment">! SUBROUTINE CHECKUNIT</span> <a name="l03031"></a>03031 <span class="comment">! ====================</span> <a name="l03032"></a>03032 <a name="l03033"></a><a class="code" href="puma_8f90.html#ab608e12bdff55ab600a9d975673c5a53">03033</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ab608e12bdff55ab600a9d975673c5a53">checkunit</a> <a name="l03034"></a>03034 use <span class="keywordflow">pumamod</span> <a name="l03035"></a>03035 <a name="l03036"></a>03036 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sp( 1 )'</span>,sp(1),sp(1)*spnorm(1)+log(psmean) <a name="l03037"></a>03037 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'st( 1,1)'</span>,st(1,1),st(1,1)*spnorm(1)*ct+t0(1)*ct <a name="l03038"></a>03038 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sd( 1,1)'</span>,sd(1,1),sd(1,1)*spnorm(1)*ww <a name="l03039"></a>03039 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sz( 1,1)'</span>,sz(1,1),sz(1,1)*spnorm(1)*ww <a name="l03040"></a>03040 <a name="l03041"></a>03041 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'st( 1,NLEV)'</span>,st(1,NLEV),st(1,NLEV)*spnorm(1)*ct+t0(5)*ct <a name="l03042"></a>03042 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sd( 1,NLEV)'</span>,sd(1,NLEV),sd(1,NLEV)*spnorm(1)*ww <a name="l03043"></a>03043 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sz( 1,NLEV)'</span>,sz(1,NLEV),sz(1,NLEV)*spnorm(1)*ww <a name="l03044"></a>03044 <a name="l03045"></a>03045 <span class="keyword">if</span> (100 < NRSP) <span class="keyword">then</span> <a name="l03046"></a>03046 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sp(100 )'</span>,sp(100),sp(100)*spnorm(100) <a name="l03047"></a>03047 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'st(100,NLEV)'</span>,st(100,NLEV),st(100,NLEV)*spnorm(100)*ct <a name="l03048"></a>03048 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sd(100,NLEV)'</span>,sd(100,NLEV),sd(100,NLEV)*spnorm(100)*ww <a name="l03049"></a>03049 <span class="keyword">write</span>(ncu,1000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">'sz(100,NLEV)'</span>,sz(100,NLEV),sz(100,NLEV)*spnorm(100)*ww <a name="l03050"></a>03050 <span class="keyword">endif</span> <a name="l03051"></a>03051 <a name="l03052"></a>03052 return <a name="l03053"></a>03053 1000 format(i5,1x,a,1x,2f14.7) <a name="l03054"></a>03054 <span class="keyword"> end</span> <a name="l03055"></a>03055 <a name="l03056"></a>03056 <a name="l03057"></a>03057 <span class="comment">! =====================</span> <a name="l03058"></a>03058 <span class="comment">! * SUBROUTINE LEGPRI *</span> <a name="l03059"></a>03059 <span class="comment">! =====================</span> <a name="l03060"></a>03060 <a name="l03061"></a><a class="code" href="puma_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">03061</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a03d027a1b5f735efb9bce2396d5fc2b6">legpri</a> <a name="l03062"></a>03062 use <span class="keywordflow">pumamod</span> <a name="l03063"></a>03063 <a name="l03064"></a>03064 <span class="keyword">write</span>(nud,231) <a name="l03065"></a>03065 <span class="keyword">write</span>(nud,232) <a name="l03066"></a>03066 <span class="keyword">write</span>(nud,233) <a name="l03067"></a>03067 <span class="keyword">write</span>(nud,232) <a name="l03068"></a>03068 <span class="keyword">do</span> 14 jlat = 1 , NLAT <a name="l03069"></a>03069 zalat = asin(sid(jlat))*180.0/PI <a name="l03070"></a>03070 <span class="keyword">write</span>(nud,234) jlat,zalat,csq(jlat),gwd(jlat) <a name="l03071"></a>03071 14 continue <a name="l03072"></a>03072 <span class="keyword">write</span>(nud,232) <a name="l03073"></a>03073 <span class="keyword">write</span>(nud,231) <a name="l03074"></a>03074 return <a name="l03075"></a>03075 231 format(/) <a name="l03076"></a>03076 232 format(37(<span class="stringliteral">'*'</span>)) <a name="l03077"></a>03077 233 format(<span class="stringliteral">'* No * Lat * csq weight *'</span>) <a name="l03078"></a>03078 234 format(<span class="stringliteral">'*'</span>,i4,<span class="stringliteral">' *'</span>,f6.1,<span class="stringliteral">' *'</span>,2f10.4,<span class="stringliteral">' *'</span>) <a name="l03079"></a>03079 <span class="keyword"> end</span> <a name="l03080"></a>03080 <a name="l03081"></a>03081 <a name="l03082"></a>03082 <span class="comment">! =================</span> <a name="l03083"></a>03083 <span class="comment">! SUBROUTINE INILAT</span> <a name="l03084"></a>03084 <span class="comment">! =================</span> <a name="l03085"></a>03085 <a name="l03086"></a><a class="code" href="puma_8f90.html#a7780f6c3a813605c014f7da964ff83d2">03086</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#a7780f6c3a813605c014f7da964ff83d2">inilat</a> <a name="l03087"></a>03087 use <span class="keywordflow">pumamod</span> <a name="l03088"></a>03088 <span class="keywordtype">real (kind=8)</span> :: zcsq <a name="l03089"></a>03089 <a name="l03090"></a>03090 <span class="keyword">do</span> jlat = 1 , NLAT <a name="l03091"></a>03091 zcsq = 1.0 - sid(jlat) * sid(jlat) <a name="l03092"></a>03092 csq(jlat) = zcsq <a name="l03093"></a>03093 rcs(jlat) = 1.0 / sqrt(zcsq) <a name="l03094"></a>03094 <span class="keyword">enddo</span> <a name="l03095"></a>03095 <span class="keyword">do</span> jlat = 1 , NLAT/2 <a name="l03096"></a>03096 ideg = nint(180.0/PI * asin(sid(jlat))) <a name="l03097"></a>03097 <span class="keyword">write</span>(chlat(jlat),<span class="stringliteral">'(i2,a1)'</span>) ideg,<span class="stringliteral">'N'</span> <a name="l03098"></a>03098 <span class="keyword">write</span>(chlat(NLAT+1-jlat),<span class="stringliteral">'(i2,a1)'</span>) ideg,<span class="stringliteral">'S'</span> <a name="l03099"></a>03099 <span class="keyword">enddo</span> <a name="l03100"></a>03100 return <a name="l03101"></a>03101 <span class="keyword"> end</span> <a name="l03102"></a>03102 <a name="l03103"></a>03103 <a name="l03104"></a>03104 <span class="comment">! ====================</span> <a name="l03105"></a>03105 <span class="comment">! SUBROUTINE GRIDPOINT</span> <a name="l03106"></a>03106 <span class="comment">! ====================</span> <a name="l03107"></a>03107 <a name="l03108"></a><a class="code" href="puma_8f90.html#aefdbfd36b330ce29d344d428431119c9">03108</a> <span class="keyword">subroutine </span><a class="code" href="ppp_8f90.html#aefdbfd36b330ce29d344d428431119c9">gridpoint</a> <a name="l03109"></a>03109 use <span class="keywordflow">pumamod</span> <a name="l03110"></a>03110 <a name="l03111"></a>03111 <span class="keywordtype">real</span> gtn(NLON,NLPP,NLEV) <a name="l03112"></a>03112 <span class="keywordtype">real</span> gvpp(NHOR) <a name="l03113"></a>03113 <span class="keywordtype">real</span> gpmt(NLON,NLPP) <a name="l03114"></a>03114 <span class="keywordtype">real</span> sdf(NESP,NLEV) <a name="l03115"></a>03115 <span class="keywordtype">real</span> stf(NESP,NLEV) <a name="l03116"></a>03116 <span class="keywordtype">real</span> szf(NESP,NLEV) <a name="l03117"></a>03117 <span class="keywordtype">real</span> spf(NESP) <a name="l03118"></a>03118 <span class="keywordtype">real</span> zgp(NLON,NLAT) <a name="l03119"></a>03119 <span class="keywordtype">real</span> zgpp(NHOR) <a name="l03120"></a>03120 <span class="keywordtype">real (kind=4)</span> :: zcs(NLAT,NLEV) <a name="l03121"></a>03121 <span class="keywordtype">real (kind=4)</span> :: zsp(NRSP) <a name="l03122"></a>03122 <a name="l03123"></a>03123 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03124"></a>03124 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sd(1,jlev),gd(1,jlev)) <a name="l03125"></a>03125 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(st(1,jlev),gt(1,jlev)) <a name="l03126"></a>03126 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sz(1,jlev),gz(1,jlev)) <a name="l03127"></a>03127 <span class="keyword">enddo</span> <a name="l03128"></a>03128 <a name="l03129"></a>03129 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sp,gp) <span class="comment">! LnPs</span> <a name="l03130"></a>03130 call <a class="code" href="legsym_8f90.html#ac25a3c42ee19118b299203d2747cb59e">sp2fcdmu</a>(sp,gpj) <span class="comment">! d(lnps) / d(mu)</span> <a name="l03131"></a>03131 <span class="comment">! divergence, vorticity -> u*cos(phi), v*cos(phi)</span> <a name="l03132"></a>03132 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03133"></a>03133 call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(sd(1,jlev),sz(1,jlev),gu(1,jlev),gv(1,jlev)) <a name="l03134"></a>03134 <span class="keyword">enddo</span> <a name="l03135"></a>03135 <span class="keyword">if</span> (lselect) <span class="keyword">then</span> <a name="l03136"></a>03136 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gp) <a name="l03137"></a>03137 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gpj) <a name="l03138"></a>03138 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03139"></a>03139 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gu(1,jlev)) <a name="l03140"></a>03140 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gv(1,jlev)) <a name="l03141"></a>03141 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gd(1,jlev)) <a name="l03142"></a>03142 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gt(1,jlev)) <a name="l03143"></a>03143 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gz(1,jlev)) <a name="l03144"></a>03144 <span class="keyword">enddo</span> <a name="l03145"></a>03145 <span class="keyword">endif</span> <a name="l03146"></a>03146 <a name="l03147"></a>03147 <span class="keyword">if</span> (ngui > 0 .or. mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) == 0) <span class="keyword">then</span> <a name="l03148"></a>03148 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03149"></a>03149 <span class="keyword">do</span> jlat = 1 , NLPP <a name="l03150"></a>03150 sec = cv / sqrt(csq(jlat)) <a name="l03151"></a>03151 csu(jlat,jlev) = gu(1+(jlat-1)*NLON,jlev) * sec <a name="l03152"></a>03152 csv(jlat,jlev) = gv(1+(jlat-1)*NLON,jlev) * sec <a name="l03153"></a>03153 cst(jlat,jlev) =(gt(1+(jlat-1)*NLON,jlev) + t0(jlev))*ct-273.16 <a name="l03154"></a>03154 <span class="keyword">enddo</span> <a name="l03155"></a>03155 <span class="keyword">enddo</span> <a name="l03156"></a>03156 <span class="keyword">endif</span> <a name="l03157"></a>03157 <a name="l03158"></a>03158 <span class="keyword">do</span> jlat = 1 , NLPP <a name="l03159"></a>03159 <span class="keyword">do</span> jlon = 1 , NLON-1 , 2 <a name="l03160"></a>03160 gpmt(jlon ,jlat) = -gp(jlon+1+(jlat-1)*NLON) * ((jlon-1)/2) <a name="l03161"></a>03161 gpmt(jlon+1,jlat) = gp(jlon +(jlat-1)*NLON) * ((jlon-1)/2) <a name="l03162"></a>03162 <span class="keyword">end do</span> <a name="l03163"></a>03163 <span class="keyword">end do</span> <a name="l03164"></a>03164 <a name="l03165"></a>03165 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gu ,NLON,NLPP*NLEV) <a name="l03166"></a>03166 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gv ,NLON,NLPP*NLEV) <a name="l03167"></a>03167 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gt ,NLON,NLPP*NLEV) <a name="l03168"></a>03168 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gd ,NLON,NLPP*NLEV) <a name="l03169"></a>03169 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gz ,NLON,NLPP*NLEV) <a name="l03170"></a>03170 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gpj,NLON,NLPP) <a name="l03171"></a>03171 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gpmt,NLON,NLPP) <a name="l03172"></a>03172 <a name="l03173"></a>03173 call <a class="code" href="puma_8f90.html#a0e2e6d98e219c0540bd78f5673a2dd57">calcgp</a>(gtn,gpmt,gvpp) <a name="l03174"></a>03174 <a name="l03175"></a>03175 gut(:,:) = gu(:,:) * gt(:,:) <a name="l03176"></a>03176 gvt(:,:) = gv(:,:) * gt(:,:) <a name="l03177"></a>03177 gke(:,:) = gu(:,:) * gu(:,:) + gv(:,:) * gv(:,:) <a name="l03178"></a>03178 <a name="l03179"></a>03179 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gtn ,NLON,NLPP*NLEV) <a name="l03180"></a>03180 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gut ,NLON,NLPP*NLEV) <a name="l03181"></a>03181 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gvt ,NLON,NLPP*NLEV) <a name="l03182"></a>03182 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gfv ,NLON,NLPP*NLEV) <a name="l03183"></a>03183 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gfu ,NLON,NLPP*NLEV) <a name="l03184"></a>03184 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gke ,NLON,NLPP*NLEV) <a name="l03185"></a>03185 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(gvpp,NLON,NLPP ) <a name="l03186"></a>03186 <a name="l03187"></a>03187 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(gvpp,spf) <a name="l03188"></a>03188 <a name="l03189"></a>03189 <span class="keyword">if</span> (lselect) <span class="keyword">then</span> <a name="l03190"></a>03190 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gvpp) <a name="l03191"></a>03191 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03192"></a>03192 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gtn(1,1,jlev)) <a name="l03193"></a>03193 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gut(1,jlev)) <a name="l03194"></a>03194 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gvt(1,jlev)) <a name="l03195"></a>03195 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gfv(1,jlev)) <a name="l03196"></a>03196 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gfu(1,jlev)) <a name="l03197"></a>03197 call <a class="code" href="puma_8f90.html#a7278b4e4c576939f77bc4055e51cdaef">filter_zonal_waves</a>(gke(1,jlev)) <a name="l03198"></a>03198 <span class="keyword">enddo</span> <a name="l03199"></a>03199 <span class="keyword">endif</span> <a name="l03200"></a>03200 <a name="l03201"></a>03201 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03202"></a>03202 call <a class="code" href="legsym_8f90.html#ab97cf272bad63e9bdd87a01317bb71c9">mktend</a>(sdf(1,jlev),stf(1,jlev),szf(1,jlev),gtn(1,1,jlev),& <a name="l03203"></a>03203 gfu(1,jlev),gfv(1,jlev),gke(1,jlev),gut(1,jlev),gvt(1,jlev)) <a name="l03204"></a>03204 <span class="keyword">enddo</span> <a name="l03205"></a>03205 <a name="l03206"></a>03206 <span class="keyword">if</span> (nruido > 0) call <a class="code" href="puma_8f90.html#ab257e27330a3ab13c9c90ebd985ef60e">stepruido</a> <a name="l03207"></a>03207 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(spf,spt,1) <a name="l03208"></a>03208 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(stf,stt,NLEV) <a name="l03209"></a>03209 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(sdf,sdt,NLEV) <a name="l03210"></a>03210 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(szf,szt,NLEV) <a name="l03211"></a>03211 <a name="l03212"></a>03212 <span class="keyword">if</span> (ngui > 0 .or. mod(<a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,ndiag) == 0) <span class="keyword">then</span> <a name="l03213"></a>03213 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gp,NLON,NLPP) <a name="l03214"></a>03214 zgpp(:) = exp(gp) <span class="comment">! LnPs -> Ps</span> <a name="l03215"></a>03215 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(zgp,zgpp,1) <span class="comment">! zgp = Ps (full grid)</span> <a name="l03216"></a>03216 <span class="keyword">if</span> (ngui > 0) <span class="keyword">then</span> <a name="l03217"></a>03217 call <a class="code" href="guimod_8f90.html#aef8771e5b34f33e37c1370ac60c41aea">guips</a>(zgp,psmean) <a name="l03218"></a>03218 call <a class="code" href="guimod_8f90.html#ad4f84b3b48dfc55519b6072ba9a62e97">guigv</a>(<span class="stringliteral">"GU"</span> // char(0),gu) <a name="l03219"></a>03219 call <a class="code" href="guimod_8f90.html#ad4f84b3b48dfc55519b6072ba9a62e97">guigv</a>(<span class="stringliteral">"GV"</span> // char(0),gv) <a name="l03220"></a>03220 call <a class="code" href="guimod_8f90.html#a043a85f7d43cabc1814465b055b8da18">guigt</a>(gt) <a name="l03221"></a>03221 <span class="keyword">endif</span> <a name="l03222"></a>03222 zgpp(:) = zgpp(:) - 1.0 <span class="comment">! Mean(LnPs) = 0 <-> Mean(Ps) = 1</span> <a name="l03223"></a>03223 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zgpp,NLON,NLPP) <a name="l03224"></a>03224 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zgpp,span) <a name="l03225"></a>03225 <a name="l03226"></a>03226 call <a class="code" href="mpimod_8f90.html#af894efd9525c935f22415e017dcbc482">mpsum</a>(span,1) <span class="comment">! span = Ps spectral</span> <a name="l03227"></a>03227 call <a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(csu) <a name="l03228"></a>03228 call <a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(csv) <a name="l03229"></a>03229 call <a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(cst) <a name="l03230"></a>03230 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l03231"></a>03231 call <a class="code" href="legsym_8f90.html#a6ba5b0b99819bcbad73f2e2eb49c62bb">altcs</a>(csu) <a name="l03232"></a>03232 call <a class="code" href="legsym_8f90.html#a6ba5b0b99819bcbad73f2e2eb49c62bb">altcs</a>(csv) <a name="l03233"></a>03233 call <a class="code" href="legsym_8f90.html#a6ba5b0b99819bcbad73f2e2eb49c62bb">altcs</a>(cst) <a name="l03234"></a>03234 <span class="keyword">if</span> (ngui > 0) <span class="keyword">then</span> <a name="l03235"></a>03235 zcs(:,:) = csu(:,:) <a name="l03236"></a>03236 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">"CSU"</span> // char(0) ,zcs ,NLAT,NLEV,1) <a name="l03237"></a>03237 zcs(:,:) = csv(:,:) <a name="l03238"></a>03238 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">"CSV"</span> // char(0) ,zcs ,NLAT,NLEV,1) <a name="l03239"></a>03239 zcs(:,:) = cst(:,:) <a name="l03240"></a>03240 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">"CST"</span> // char(0) ,zcs ,NLAT,NLEV,1) <a name="l03241"></a>03241 zsp(:) = span(1:NRSP) <a name="l03242"></a>03242 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">"SPAN"</span> // char(0) ,zsp ,NCSP,-NTP1,1) <a name="l03243"></a>03243 <span class="keyword">endif</span> <a name="l03244"></a>03244 <span class="keyword">endif</span> <a name="l03245"></a>03245 <span class="keyword">endif</span> <a name="l03246"></a>03246 return <a name="l03247"></a>03247 <span class="keyword"> end</span> <a name="l03248"></a>03248 <a name="l03249"></a>03249 <span class="comment">! =================</span> <a name="l03250"></a>03250 <span class="comment">! SUBROUTINE CALCGP</span> <a name="l03251"></a>03251 <span class="comment">! =================</span> <a name="l03252"></a><a class="code" href="puma_8f90.html#a0e2e6d98e219c0540bd78f5673a2dd57">03252</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0e2e6d98e219c0540bd78f5673a2dd57">calcgp</a>(gtn,gpm,gvp) <a name="l03253"></a>03253 <a name="l03254"></a>03254 use <span class="keywordflow">pumamod</span> <a name="l03255"></a>03255 <a name="l03256"></a>03256 <span class="comment">! Comments by Torben Kunz and Guido Schroeder</span> <a name="l03257"></a>03257 <a name="l03258"></a>03258 <span class="comment">! Compute nonlinear tendencies in grid point space.</span> <a name="l03259"></a>03259 <span class="comment">! Hoskins and Simmons 1975 (Q.J.R.Meteorol.Soc.,101,637-655) (HS75)</span> <a name="l03260"></a>03260 <a name="l03261"></a>03261 <span class="comment">! For terms calculated in this routine, see HS75, eqs. (8)-(10) and</span> <a name="l03262"></a>03262 <span class="comment">! appendix I:</span> <a name="l03263"></a>03263 <span class="comment">! - script Fu, Fv as contributions to script D: gl. arrays gfu, gfv</span> <a name="l03264"></a>03264 <span class="comment">! - script T: returned as gtn</span> <a name="l03265"></a>03265 <span class="comment">! - script P: returned as gvp</span> <a name="l03266"></a>03266 <a name="l03267"></a>03267 <a name="l03268"></a>03268 <span class="comment">! parameters (in)</span> <a name="l03269"></a>03269 <span class="comment">! ---------------</span> <a name="l03270"></a>03270 <a name="l03271"></a>03271 <span class="comment">! gpm -- d(ln(ps)) / d(lambda)</span> <a name="l03272"></a>03272 <a name="l03273"></a>03273 <span class="comment">! parameters (out)</span> <a name="l03274"></a>03274 <span class="comment">! ---------------</span> <a name="l03275"></a>03275 <a name="l03276"></a>03276 <span class="comment">! gtn -- temperature tendency</span> <a name="l03277"></a>03277 <span class="comment">! gvp -- vertical integral of (u,v) * grad(ln(ps))</span> <a name="l03278"></a>03278 <a name="l03279"></a>03279 <span class="comment">! global arrays variable in time</span> <a name="l03280"></a>03280 <span class="comment">! ------------------------------</span> <a name="l03281"></a>03281 <a name="l03282"></a>03282 <span class="comment">! gfu, gfv -- terms Fu, Fv in primitive equations,</span> <a name="l03283"></a>03283 <span class="comment">! see HS75 (eqs. (1), (2))</span> <a name="l03284"></a>03284 <span class="comment">! gu, gv -- components u, v of horizontal velocity vector</span> <a name="l03285"></a>03285 <span class="comment">! gd -- divergence D</span> <a name="l03286"></a>03286 <span class="comment">! gz -- absolute vorticity</span> <a name="l03287"></a>03287 <span class="comment">! gt -- temperature deviation T'</span> <a name="l03288"></a>03288 <a name="l03289"></a>03289 <span class="comment">! global arrays constant in time</span> <a name="l03290"></a>03290 <span class="comment">! ------------------------------</span> <a name="l03291"></a>03291 <a name="l03292"></a>03292 <span class="comment">! t0d -- reference temperature difference between two adjacent</span> <a name="l03293"></a>03293 <span class="comment">! full levels</span> <a name="l03294"></a>03294 <span class="comment">! tkp -- reference temperature times kappa (global parameter AKAP)</span> <a name="l03295"></a>03295 <span class="comment">! rdsig -- 1 / (2 * dsigma)</span> <a name="l03296"></a>03296 <span class="comment">! rcsq -- 1 / (1 - mu^2) </span> <a name="l03297"></a>03297 <a name="l03298"></a>03298 <span class="comment">! notations used in subsequent comments</span> <a name="l03299"></a>03299 <span class="comment">! -------------------------------------</span> <a name="l03300"></a>03300 <a name="l03301"></a>03301 <span class="comment">! aINTb(A)dsigma :<=> the integral of A over the interval [a,b]</span> <a name="l03302"></a>03302 <span class="comment">! with respect to sigma</span> <a name="l03303"></a>03303 <a name="l03304"></a>03304 <span class="keywordtype">real</span> gtn(NHOR,NLEV) <a name="l03305"></a>03305 <span class="keywordtype">real</span> gpm(NHOR) , gvp(NHOR) <a name="l03306"></a>03306 <span class="keywordtype">real</span> zsdotp(NHOR,NLEM),zsumd(NHOR),zsumvp(NHOR),zsumvpm(NHOR) <a name="l03307"></a>03307 <span class="keywordtype">real</span> ztpta(NHOR),ztptb(NHOR) <a name="l03308"></a>03308 <span class="keywordtype">real</span> zvgpg(NHOR,NLEV) <a name="l03309"></a>03309 <span class="keywordtype">real</span> gtd(NHOR,NLEM) <a name="l03310"></a>03310 <span class="keywordtype">real</span> gud(NHOR,NLEM) <a name="l03311"></a>03311 <span class="keywordtype">real</span> gvd(NHOR,NLEM) <a name="l03312"></a>03312 <a name="l03313"></a>03313 <span class="comment">! 1.</span> <a name="l03314"></a>03314 <span class="comment">! 1.1 zvgpg: (u,v) * grad(ln(ps))</span> <a name="l03315"></a>03315 <a name="l03316"></a>03316 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03317"></a>03317 zvgpg(:,jlev) = rcsq * (gu(:,jlev)*gpm(:)+gv(:,jlev)*gpj(:)) <a name="l03318"></a>03318 <span class="keyword">enddo</span> <a name="l03319"></a>03319 <a name="l03320"></a>03320 <span class="comment">! 1.2 Calculate vertical integral of A = D + (u,v) * grad(ln(ps)),</span> <a name="l03321"></a>03321 <span class="comment">! separated into divergence and ln(ps) advection.</span> <a name="l03322"></a>03322 <span class="comment">! zsumd : 0INT1(D)dsigma</span> <a name="l03323"></a>03323 <span class="comment">! gvp : 0INT1[(u,v) * grad ln(ps)]dsigma</span> <a name="l03324"></a>03324 <span class="comment">! zsdotp : 0INTsigma(A)dsigma</span> <a name="l03325"></a>03325 <a name="l03326"></a>03326 zsumd = dsigma(1) * gd(:,1) <a name="l03327"></a>03327 gvp = dsigma(1) * zvgpg(:,1) <a name="l03328"></a>03328 zsdotp(:,1) = zsumd + gvp <a name="l03329"></a>03329 <a name="l03330"></a>03330 <span class="keyword">do</span> jlev = 2 , NLEM <a name="l03331"></a>03331 zsumd = zsumd + dsigma(jlev) * gd(:,jlev) <a name="l03332"></a>03332 gvp = gvp + dsigma(jlev) * zvgpg(:,jlev) <a name="l03333"></a>03333 zsdotp(:,jlev) = zsumd + gvp <a name="l03334"></a>03334 <span class="keyword">enddo</span> <a name="l03335"></a>03335 <a name="l03336"></a>03336 zsumd = zsumd + dsigma(NLEV) * gd(:,NLEV) <a name="l03337"></a>03337 gvp = gvp + dsigma(NLEV) * zvgpg(:,NLEV) <a name="l03338"></a>03338 <a name="l03339"></a>03339 <span class="comment">! 2. Calculate vertical velocity and vertical advection terms</span> <a name="l03340"></a>03340 <span class="comment">! on half levels.</span> <a name="l03341"></a>03341 <a name="l03342"></a>03342 <span class="keyword">do</span> jlev = 1 , NLEM <a name="l03343"></a>03343 zsdotp(:,jlev) = (sigmh(jlev) * (zsumd+gvp) - zsdotp(:,jlev)) <a name="l03344"></a>03344 <span class="keyword">enddo</span> <a name="l03345"></a>03345 <a name="l03346"></a>03346 gtd(:,:) = zsdotp(:,:) * (gt(:,2:NLEV) - gt(:,1:NLEM)) <a name="l03347"></a>03347 gud(:,:) = zsdotp(:,:) * (gu(:,2:NLEV) - gu(:,1:NLEM)) <a name="l03348"></a>03348 gvd(:,:) = zsdotp(:,:) * (gv(:,2:NLEV) - gv(:,1:NLEM)) <a name="l03349"></a>03349 <a name="l03350"></a>03350 <span class="comment">! 3. Calculate nonlinear contributions to temperature tendency and</span> <a name="l03351"></a>03351 <span class="comment">! nonlinear terms Fu, Fv as used in vorticity and</span> <a name="l03352"></a>03352 <span class="comment">! divergence equation.</span> <a name="l03353"></a>03353 <a name="l03354"></a>03354 <span class="comment">! 3.1 top level:</span> <a name="l03355"></a>03355 <a name="l03356"></a>03356 <span class="comment">! 3.1.1 zsumvp: 0INTsigma[(u,v) * grad(ln(ps))]dsigma</span> <a name="l03357"></a>03357 <a name="l03358"></a>03358 zsumvp = zvgpg(:,1) * dsigma(1) <a name="l03359"></a>03359 <a name="l03360"></a>03360 <span class="comment">! 3.1.2 Calculation of gtn, gfv and gfu as for inner levels (3.2),</span> <a name="l03361"></a>03361 <span class="comment">! but somewhat simplified:</span> <a name="l03362"></a>03362 <span class="comment">! a) For the top level the following equation holds in the</span> <a name="l03363"></a>03363 <span class="comment">! discretized form: (1/sigma)*0INTsigma(A)dsigma == A</span> <a name="l03364"></a>03364 <span class="comment">! (HS75, second equation following eq. (7)). Therefore,</span> <a name="l03365"></a>03365 <span class="comment">! (3.2.3) simplifies to -kappa*T' * D and (3.2.4) vanishes.</span> <a name="l03366"></a>03366 <span class="comment">! b) Vertical advection terms (gtd, gud, gvd (see section 2)</span> <a name="l03367"></a>03367 <span class="comment">! and vertical T0 advection (3.2.6)) vanish at upper</span> <a name="l03368"></a>03368 <span class="comment">! boundary (sigma == 0).</span> <a name="l03369"></a>03369 <a name="l03370"></a>03370 gtn(:,1) = (1.0-akap) * gt(:,1) * gd(:,1) - rdsig(1) * (gtd(:,1) & <a name="l03371"></a>03371 + t0d(1) * (sigmh(1)*gvp-zsumvp)) <a name="l03372"></a>03372 <a name="l03373"></a>03373 gfv(:,1) = - gu(:,1)*gz(:,1) - gpj(:)*gt(:,1) - rdsig(1)*gvd(:,1) <a name="l03374"></a>03374 gfu(:,1) = gv(:,1)*gz(:,1) - gpm(:)*gt(:,1) - rdsig(1)*gud(:,1) <a name="l03375"></a>03375 <a name="l03376"></a>03376 <span class="comment">! 3.2 inner levels:</span> <a name="l03377"></a>03377 <a name="l03378"></a>03378 <span class="keyword">do</span> jlev = 2 , NLEM <a name="l03379"></a>03379 <a name="l03380"></a>03380 <span class="comment">! 3.2.1 ztpta: (1/sigma)*0INTsigma(A-D)dsigma</span> <a name="l03381"></a>03381 <span class="comment">! ztptb: (1/sigma)*0INTsigma(A)dsigma</span> <a name="l03382"></a>03382 <span class="comment">! Matrix c contains factors for discretized integration, see</span> <a name="l03383"></a>03383 <span class="comment">! HS75 (second equation following eq. (7)).</span> <a name="l03384"></a>03384 <a name="l03385"></a>03385 ztpta = c(1,jlev) * zvgpg(:,1) <a name="l03386"></a>03386 ztptb = c(1,jlev) * (zvgpg(:,1) + gd(:,1)) <a name="l03387"></a>03387 <a name="l03388"></a>03388 <span class="keyword">do</span> jlej = 2 , jlev <a name="l03389"></a>03389 ztpta = ztpta + c(jlej,jlev) * zvgpg(:,jlej) <a name="l03390"></a>03390 ztptb = ztptb + c(jlej,jlev) * (zvgpg(:,jlej) + gd(:,jlej)) <a name="l03391"></a>03391 <span class="keyword">enddo</span> <a name="l03392"></a>03392 <a name="l03393"></a>03393 zsumvpm = zsumvp <a name="l03394"></a>03394 zsumvp = zsumvp + zvgpg(:,jlev) * dsigma(jlev) <a name="l03395"></a>03395 <a name="l03396"></a>03396 <span class="comment">! 3.2.2 D * T' </span> <a name="l03397"></a>03397 <a name="l03398"></a>03398 gtn(:,jlev) = gt(:,jlev) * gd(:,jlev) <a name="l03399"></a>03399 <a name="l03400"></a>03400 <span class="comment">! 3.2.3 kappa*T' *</span> <a name="l03401"></a>03401 <span class="comment">! [(u,v)*grad(ln(ps)) - (1/sigma)*0INTsigma(A)dsigma]</span> <a name="l03402"></a>03402 <a name="l03403"></a>03403 gtn(:,jlev) = gtn(:,jlev) & <a name="l03404"></a>03404 & + akap * gt(:,jlev) * (zvgpg(:,jlev) - ztptb) <a name="l03405"></a>03405 <a name="l03406"></a>03406 <span class="comment">! 3.2.4 kappa*T0 *</span> <a name="l03407"></a>03407 <span class="comment">! [(u,v)*grad(ln(ps)) - (1/sigma)*0INTsigma(A-D)dsigma]</span> <a name="l03408"></a>03408 <a name="l03409"></a>03409 gtn(:,jlev) = gtn(:,jlev) & <a name="l03410"></a>03410 & + tkp(jlev) * (zvgpg(:,jlev) - ztpta) <a name="l03411"></a>03411 <a name="l03412"></a>03412 <span class="comment">! 3.2.5 Calculate vertical T' advection on full levels by</span> <a name="l03413"></a>03413 <span class="comment">! averaging two half level advection terms (gtd, calculated</span> <a name="l03414"></a>03414 <span class="comment">! in section 2).</span> <a name="l03415"></a>03415 <a name="l03416"></a>03416 <span class="comment">! and</span> <a name="l03417"></a>03417 <a name="l03418"></a>03418 <span class="comment">! 3.2.6 Calculate vertical T0 advection on full levels by</span> <a name="l03419"></a>03419 <span class="comment">! averaging two half level advection terms.</span> <a name="l03420"></a>03420 <a name="l03421"></a>03421 gtn(:,jlev) = gtn(:,jlev) & <a name="l03422"></a>03422 & - rdsig(jlev) * (gtd(:,jlev) + gtd(:,jlev-1) & <a name="l03423"></a>03423 & +(sigmh(jlev) * gvp - zsumvp) * t0d(jlev) & <a name="l03424"></a>03424 & +(sigmh(jlev-1) * gvp - zsumvpm) * t0d(jlev-1)) <a name="l03425"></a>03425 <a name="l03426"></a>03426 <span class="comment">! 3.2.7 terms Fv, Fu, see HS75 (equations following eq. (5));</span> <a name="l03427"></a>03427 <span class="comment">! vertical advection terms interpolated to full levels by</span> <a name="l03428"></a>03428 <span class="comment">! averaging two half level advection terms.</span> <a name="l03429"></a>03429 <a name="l03430"></a>03430 gfv(:,jlev) = - gu(:,jlev)*gz(:,jlev) - gpj(:)*gt(:,jlev) & <a name="l03431"></a>03431 & - rdsig(jlev)*(gvd(:,jlev) + gvd(:,jlev-1)) <a name="l03432"></a>03432 <a name="l03433"></a>03433 gfu(:,jlev) = gv(:,jlev)*gz(:,jlev) - gpm(:)*gt(:,jlev) & <a name="l03434"></a>03434 & - rdsig(jlev)*(gud(:,jlev) + gud(:,jlev-1)) <a name="l03435"></a>03435 <span class="keyword">enddo</span> <a name="l03436"></a>03436 <a name="l03437"></a>03437 <span class="comment">! 3.3 bottom level</span> <a name="l03438"></a>03438 <a name="l03439"></a>03439 <span class="comment">! 3.3.1 ztpta, ztptb: see 3.2.1</span> <a name="l03440"></a>03440 <a name="l03441"></a>03441 ztpta = c(1,NLEV) * zvgpg(:,1) <a name="l03442"></a>03442 ztptb = c(1,NLEV) * (zvgpg(:,1) + gd(:,1)) <a name="l03443"></a>03443 <a name="l03444"></a>03444 <span class="keyword">do</span> jlej = 2 , NLEV <a name="l03445"></a>03445 ztpta = ztpta + c(jlej,NLEV) * zvgpg(:,jlej) <a name="l03446"></a>03446 ztptb = ztptb + c(jlej,NLEV) * (zvgpg(:,jlej) + gd(:,jlej)) <a name="l03447"></a>03447 <span class="keyword">enddo</span> <a name="l03448"></a>03448 <a name="l03449"></a>03449 <span class="comment">! 3.3.2 Calculation of gtn, gfv and gfu as for inner levels (3.2),</span> <a name="l03450"></a>03450 <span class="comment">! but somewhat simplified:</span> <a name="l03451"></a>03451 <span class="comment">! Vertical advection terms (gtd, gud, gvd (see section 2) and </span> <a name="l03452"></a>03452 <span class="comment">! vertical T0 advection (3.2.6)) vanish at</span> <a name="l03453"></a>03453 <span class="comment">! lower boundary (sigma == 1).</span> <a name="l03454"></a>03454 <a name="l03455"></a>03455 gtn(:,NLEV) = gt(:,NLEV) * gd(:,NLEV) & <a name="l03456"></a>03456 & + akap*gt(:,NLEV)*(zvgpg(:,NLEV)-ztptb) & <a name="l03457"></a>03457 & + tkp(NLEV)*(zvgpg(:,NLEV)-ztpta) & <a name="l03458"></a>03458 & - rdsig(NLEV) * (gtd(:,NLEM) & <a name="l03459"></a>03459 & + t0d(NLEM)*(sigmh(NLEM)*gvp-zsumvp)) <a name="l03460"></a>03460 <a name="l03461"></a>03461 gfv(:,NLEV) = -gu(:,NLEV) * gz(:,NLEV) - gpj(:) * gt(:,NLEV) & <a name="l03462"></a>03462 & - rdsig(NLEV) * gvd(:,NLEM) <a name="l03463"></a>03463 gfu(:,NLEV) = gv(:,NLEV) * gz(:,NLEV) - gpm(:) * gt(:,NLEV) & <a name="l03464"></a>03464 & - rdsig(NLEV) * gud(:,NLEM) <a name="l03465"></a>03465 <a name="l03466"></a>03466 <span class="comment">! 3.3.3 Add gaussian noise to T (controlled by nruido)</span> <a name="l03467"></a>03467 <a name="l03468"></a>03468 <span class="keyword">if</span> (nruido > 0) gtn(:,:) = gtn(:,:) + ruidop(:,:) <a name="l03469"></a>03469 <a name="l03470"></a>03470 return <a name="l03471"></a>03471 <span class="keyword"> end</span> <a name="l03472"></a>03472 <a name="l03473"></a>03473 <span class="comment">! ===================</span> <a name="l03474"></a>03474 <span class="comment">! SUBROUTINE SPECTRAL</span> <a name="l03475"></a>03475 <span class="comment">! ===================</span> <a name="l03476"></a>03476 <a name="l03477"></a><a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">03477</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a218b1f5483f314ea3a7eeba949933773">spectral</a> <a name="l03478"></a>03478 use <span class="keywordflow">pumamod</span> <a name="l03479"></a>03479 <a name="l03480"></a>03480 <span class="comment">!* Add adiabatic and diabatic tendencies - perform leapfrog</span> <a name="l03481"></a>03481 <a name="l03482"></a>03482 <span class="comment">! The adiabatic tendencies are added using the semi implicit scheme</span> <a name="l03483"></a>03483 <span class="comment">! Hoskins and Simmons 1975 (Q.J.R.Meteorol.Soc.,101,637-655) (HS75)</span> <a name="l03484"></a>03484 <span class="comment">! To compare the code directly with HS75 the following notes might</span> <a name="l03485"></a>03485 <span class="comment">! be helpful (in addition to the comments below):</span> <a name="l03486"></a>03486 <a name="l03487"></a>03487 <span class="comment">! Name rule for global arrays <abc>:</span> <a name="l03488"></a>03488 <span class="comment">! a : representation (s=spectral, g=grid, z=local)</span> <a name="l03489"></a>03489 <span class="comment">! b : variable (p=ln(ps), d=divergence, z=vorticity, t=temperature)</span> <a name="l03490"></a>03490 <span class="comment">! c : modifier (m=previous timestep, p=present timestep, t=tendency)</span> <a name="l03491"></a>03491 <a name="l03492"></a>03492 <span class="comment">! global arrays variable in time</span> <a name="l03493"></a>03493 <span class="comment">! ------------------------------</span> <a name="l03494"></a>03494 <a name="l03495"></a>03495 <span class="comment">! spt - pressure tendency HS75 (10)</span> <a name="l03496"></a>03496 <span class="comment">! sdt - divergence tendency HS75 ( 8)</span> <a name="l03497"></a>03497 <span class="comment">! szt - vorticity tendency</span> <a name="l03498"></a>03498 <span class="comment">! stt - temperature tendency HS75 ( 9)</span> <a name="l03499"></a>03499 <a name="l03500"></a>03500 <span class="comment">! spm - pressure at previous timestep</span> <a name="l03501"></a>03501 <span class="comment">! sdm - divergence at previous timestep</span> <a name="l03502"></a>03502 <span class="comment">! szm - vorticity at previous timestep</span> <a name="l03503"></a>03503 <span class="comment">! stm - temperature at previous timestep</span> <a name="l03504"></a>03504 <a name="l03505"></a>03505 <span class="comment">! spp - pressure at present timestep</span> <a name="l03506"></a>03506 <span class="comment">! sdp - divergence at present timestep</span> <a name="l03507"></a>03507 <span class="comment">! szp - vorticity at present timestep</span> <a name="l03508"></a>03508 <span class="comment">! stp - temperature at present timestep</span> <a name="l03509"></a>03509 <a name="l03510"></a>03510 <span class="comment">! global arrays constant in time</span> <a name="l03511"></a>03511 <span class="comment">! ------------------------------</span> <a name="l03512"></a>03512 <a name="l03513"></a>03513 <span class="comment">! sak(NSPP) - = hyper diffusion</span> <a name="l03514"></a>03514 <span class="comment">! sop(NSPP) - g* = orography as geopotential</span> <a name="l03515"></a>03515 <span class="comment">! srp1(NSPP,NLEV) - Tr = radiative equilibrium temperature (annual mean)</span> <a name="l03516"></a>03516 <span class="comment">! srp2(NSPP,NLEV) - Tr = radiative equilibrium temperature (annual cycle)</span> <a name="l03517"></a>03517 <span class="comment">! nindex(NSPP) - n = total wavenumber n for spectral modes</span> <a name="l03518"></a>03518 <span class="comment">! srcn(NSPP) - 1/Cn = 1.0 / (n * (n+1))</span> <a name="l03519"></a>03519 <span class="comment">! damp(NLEV) 1/tau R = time constant for newtonian cooling</span> <a name="l03520"></a>03520 <span class="comment">! fric(NLEV) 1/tau F = time constant for Rayleigh friction</span> <a name="l03521"></a>03521 <a name="l03522"></a>03522 <span class="keywordtype">real</span> zpm(NSPP) <span class="comment">! new spm</span> <a name="l03523"></a>03523 <span class="keywordtype">real</span> zdm(NSPP,NLEV) <span class="comment">! new sdm</span> <a name="l03524"></a>03524 <span class="keywordtype">real</span> zzm(NSPP,NLEV) <span class="comment">! new szm</span> <a name="l03525"></a>03525 <span class="keywordtype">real</span> ztm(NSPP,NLEV) <span class="comment">! new stm</span> <a name="l03526"></a>03526 <span class="keywordtype">real</span> zwp(NSPP) <span class="comment">! timefilter delta pm</span> <a name="l03527"></a>03527 <span class="keywordtype">real</span> zwd(NSPP,NLEV) <span class="comment">! timefilter delta sd</span> <a name="l03528"></a>03528 <span class="keywordtype">real</span> zwz(NSPP,NLEV) <span class="comment">! timefilter delta sz</span> <a name="l03529"></a>03529 <span class="keywordtype">real</span> zwt(NSPP,NLEV) <span class="comment">! timefilter delta st</span> <a name="l03530"></a>03530 <span class="keywordtype">real</span> zsrp(NSPP) <span class="comment">! restoring temperature (mean + annual cycle)</span> <a name="l03531"></a>03531 <a name="l03532"></a>03532 <span class="keywordtype">real</span> zgt(NSPP,NLEV) <span class="comment">! work array</span> <a name="l03533"></a>03533 <a name="l03534"></a>03534 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zstte(:,:,:) <span class="comment">! temp. tendencies for energy diag.</span> <a name="l03535"></a>03535 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zszte(:,:,:) <span class="comment">! vort. tendencies for energy recycling</span> <a name="l03536"></a>03536 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zsdte(:,:,:) <span class="comment">! div. tendencies for energy recycling</span> <a name="l03537"></a>03537 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zdps(:) <span class="comment">! surf pressure for energy diag</span> <a name="l03538"></a>03538 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zsp(:) <span class="comment">! surf pressure spectral</span> <a name="l03539"></a>03539 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zspf(:) <span class="comment">! surf pressure spectral</span> <a name="l03540"></a>03540 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zspt(:) <span class="comment">! surf pressure tendency </span> <a name="l03541"></a>03541 <a name="l03542"></a>03542 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zst(:,:) <span class="comment">! temperature for entropy diagnostics</span> <a name="l03543"></a>03543 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zstt(:,:) <span class="comment">! tem. tendencies for entropy diag.</span> <a name="l03544"></a>03544 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: ztgp(:,:) <span class="comment">! </span> <a name="l03545"></a>03545 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zdtgp(:,:) <span class="comment">! </span> <a name="l03546"></a>03546 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zsum1(:) <a name="l03547"></a>03547 <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: zgw(:) <a name="l03548"></a>03548 <a name="l03549"></a>03549 <span class="comment">! 0. Special code for experiments with mode filtering</span> <a name="l03550"></a>03550 <a name="l03551"></a>03551 <span class="keyword">if</span> (lspecsel) call <a class="code" href="puma_8f90.html#a9a1e7493444984ad2c2161609dbb6e69">filter_spectral_modes</a> <a name="l03552"></a>03552 <a name="l03553"></a>03553 <span class="comment">! 1. Initialize local arrays</span> <a name="l03554"></a>03554 <a name="l03555"></a>03555 zpm(:) = spp(:) <a name="l03556"></a>03556 zdm(:,:) = sdp(:,:) <a name="l03557"></a>03557 zzm(:,:) = szp(:,:) <a name="l03558"></a>03558 ztm(:,:) = stp(:,:) <a name="l03559"></a>03559 <span class="comment">!</span> <a name="l03560"></a>03560 <span class="comment">! allocate diagnostic arrays if needed</span> <a name="l03561"></a>03561 <span class="comment">!</span> <a name="l03562"></a>03562 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0) <span class="keyword">then</span> <a name="l03563"></a>03563 <span class="keyword">allocate</span>(zstte(NSPP,NLEV,3)) <a name="l03564"></a>03564 <span class="keyword">endif</span> <a name="l03565"></a>03565 <span class="keyword">if</span>(ndheat > 0) <span class="keyword">then</span> <a name="l03566"></a>03566 <span class="keyword">allocate</span>(zszte(NSPP,NLEV,2)) <a name="l03567"></a>03567 <span class="keyword">allocate</span>(zsdte(NSPP,NLEV,2)) <a name="l03568"></a>03568 <span class="keyword">endif</span> <a name="l03569"></a>03569 <span class="comment">!</span> <a name="l03570"></a>03570 <span class="comment">! allocate and compute surface pressure if needed</span> <a name="l03571"></a>03571 <span class="comment">!</span> <a name="l03572"></a>03572 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0 .or. ndheat > 0) <span class="keyword">then</span> <a name="l03573"></a>03573 <span class="keyword">allocate</span>(zspt(NSPP)) <a name="l03574"></a>03574 <span class="keyword">allocate</span>(zsp(NSPP)) <a name="l03575"></a>03575 <span class="keyword">endif</span> <a name="l03576"></a>03576 <a name="l03577"></a>03577 <span class="comment">! 2. Calculate divergence on timelevel t (sdt) HS75 (17)</span> <a name="l03578"></a>03578 <span class="comment">! which will replace the divergence tendency sdt</span> <a name="l03579"></a>03579 <span class="comment">! (semi implicit scheme)</span> <a name="l03580"></a>03580 <a name="l03581"></a>03581 <span class="comment">! The vertical scheme has being changed to the ECMWF scheme</span> <a name="l03582"></a>03582 <span class="comment">! (see e.g. Simmons and Burridge 1981, Mon.Wea.Rev.,109,758-766).</span> <a name="l03583"></a>03583 <span class="comment">! in this scheme, matrix xlphi (g) differs from that in HS75.</span> <a name="l03584"></a>03584 <a name="l03585"></a>03585 <span class="comment">! z0 : reference temperature To</span> <a name="l03586"></a>03586 <span class="comment">! zq : 1.0 / Cn</span> <a name="l03587"></a>03587 <span class="comment">! zt : xlphi * script T - To * script P</span> <a name="l03588"></a>03588 <span class="comment">! zm : xlphi * T + To * ln(Ps)(t-dt)</span> <a name="l03589"></a>03589 <a name="l03590"></a>03590 <span class="comment">! (note that phi is needed in HS75 (17) and, therefore,</span> <a name="l03591"></a>03591 <span class="comment">! the surface geopotential phi* [sop] is added</span> <a name="l03592"></a>03592 <a name="l03593"></a>03593 <span class="keyword">do</span> jlev=1,NLEV <a name="l03594"></a>03594 z0 = t0(jlev) <a name="l03595"></a>03595 <span class="keyword">do</span> jsp=1,NSPP <a name="l03596"></a>03596 zq = srcn(jsp) <span class="comment">! 1.0 / (n * (n + 1))</span> <a name="l03597"></a>03597 zt = dot_product(xlphi(:,jlev),stt(jsp,:)) - z0 * spt(jsp) <a name="l03598"></a>03598 zm = dot_product(xlphi(:,jlev),stm(jsp,:)) + z0 * spm(jsp) <a name="l03599"></a>03599 za = sdt(jsp,jlev) * zq <a name="l03600"></a>03600 zb = sdm(jsp,jlev) * zq <a name="l03601"></a>03601 zgt(jsp,jlev) = zb + delt * (za + zm + sop(jsp) + zt * delt) <a name="l03602"></a>03602 <span class="keyword">enddo</span> <a name="l03603"></a>03603 <span class="keyword">enddo</span> <a name="l03604"></a>03604 <a name="l03605"></a>03605 <span class="comment">! bm1 is the invers of matrix (1/cn I+B dt**2) (lhs HS75 (17))</span> <a name="l03606"></a>03606 <a name="l03607"></a>03607 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03608"></a>03608 <span class="keyword">do</span> jsp = 1 , NSPP <a name="l03609"></a>03609 jn = nindex(jsp) <span class="comment">! total wavenumber n</span> <a name="l03610"></a>03610 sdt(jsp,jlev) = dot_product(zgt(jsp,:),bm1(:,jlev,jn)) <a name="l03611"></a>03611 <span class="keyword">enddo</span> <a name="l03612"></a>03612 <span class="keyword">enddo</span> <a name="l03613"></a>03613 <a name="l03614"></a>03614 <span class="comment">! 3. Calculate surface pressure tendency -ln(ps) HS75 (15)</span> <a name="l03615"></a>03615 <a name="l03616"></a>03616 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03617"></a>03617 spt(:) = spt(:) + dsigma(jlev) * sdt(:,jlev) <a name="l03618"></a>03618 <span class="keyword">enddo</span> <a name="l03619"></a>03619 <a name="l03620"></a>03620 <span class="comment">! 4. Calculate temperature tendency HS75 (14)</span> <a name="l03621"></a>03621 <a name="l03622"></a>03622 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03623"></a>03623 <span class="keyword">do</span> jsp = 1 , NSPP <a name="l03624"></a>03624 stt(jsp,jlev)=stt(jsp,jlev)-dot_product(xlt(:,jlev),sdt(jsp,:)) <a name="l03625"></a>03625 <span class="keyword">enddo</span> <a name="l03626"></a>03626 <span class="keyword">enddo</span> <a name="l03627"></a>03627 <a name="l03628"></a>03628 <span class="comment">! 5. Add tendencies</span> <a name="l03629"></a>03629 <a name="l03630"></a>03630 spp(:) = spm(:) - delt2 * spt(:) <span class="comment">! spt = -ln(ps) tendency</span> <a name="l03631"></a>03631 sdp(:,:) = 2.0 * sdt(:,:) - sdm(:,:) <span class="comment">! sdt = sdm + delt * tend.</span> <a name="l03632"></a>03632 szp(:,:) = delt2 * szt(:,:) + szm(:,:) <span class="comment">! vorticity</span> <a name="l03633"></a>03633 stp(:,:) = delt2 * stt(:,:) + stm(:,:) <span class="comment">! temperature</span> <a name="l03634"></a>03634 <a name="l03635"></a>03635 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03636"></a>03636 zspt(:)=-spt(:) <a name="l03637"></a>03637 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stm,stt,spm,zspt,denergy(:,1)) <a name="l03638"></a>03638 <span class="keyword">endif</span> <a name="l03639"></a>03639 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l03640"></a>03640 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stm,stt,spm,dentropy(:,1)) <a name="l03641"></a>03641 <span class="keyword">endif</span> <a name="l03642"></a>03642 <a name="l03643"></a>03643 <span class="comment">! 6. Calculate newtonian cooling, friction and biharmonic diffusion</span> <a name="l03644"></a>03644 <span class="comment">! (srp - stp) * damp = (Tr' -T') / tau R = newtonian cooling</span> <a name="l03645"></a>03645 <span class="comment">! srp1 = annual mean component</span> <a name="l03646"></a>03646 <span class="comment">! srp2 = annual cycle component</span> <a name="l03647"></a>03647 <span class="comment">! sak = diffusion</span> <a name="l03648"></a>03648 <span class="comment">! fric = friction</span> <a name="l03649"></a>03649 <span class="comment">! zampl = annual cycle</span> <a name="l03650"></a>03650 <a name="l03651"></a>03651 zampl = cos((<span class="keywordtype">real</span>(nstep)-pac)*tac) <a name="l03652"></a>03652 <a name="l03653"></a>03653 <span class="keyword">if</span> (nhelsua == 0 .or. nhelsua == 1) <span class="keyword">then</span> <a name="l03654"></a>03654 <span class="keyword">do</span> jlev=1,NLEV <a name="l03655"></a>03655 zsrp(:)=srp1(:,jlev)+srp2(:,jlev)*zampl <a name="l03656"></a>03656 sdt(:,jlev) = sdp(:,jlev) * (sak(1:NSPP) - fric(jlev)) <a name="l03657"></a>03657 szt(:,jlev) = szp(:,jlev) * (sak(1:NSPP) - fric(jlev)) <a name="l03658"></a>03658 stt(:,jlev) = (zsrp(:) - stp(:,jlev)) * damp(jlev) & <a name="l03659"></a>03659 & + stp(:,jlev) * sak(1:NSPP) <a name="l03660"></a>03660 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03661"></a>03661 zstte(:,jlev,2)=(zsrp(:)-stp(:,jlev))*damp(jlev) <a name="l03662"></a>03662 zstte(:,jlev,3)=stp(:,jlev)*sak(1:NSPP) <a name="l03663"></a>03663 <span class="keyword">endif</span> <a name="l03664"></a>03664 <span class="keyword">if</span>(ndheat > 0) <span class="keyword">then</span> <a name="l03665"></a>03665 zsdte(:,jlev,1) = -sdp(:,jlev) * fric(jlev) <a name="l03666"></a>03666 zszte(:,jlev,1) = -szp(:,jlev) * fric(jlev) <a name="l03667"></a>03667 zsdte(:,jlev,2) = sdp(:,jlev) * sak(1:NSPP) <a name="l03668"></a>03668 zszte(:,jlev,2) = szp(:,jlev) * sak(1:NSPP) <a name="l03669"></a>03669 <span class="keyword">endif</span> <a name="l03670"></a>03670 <span class="keyword">enddo</span> <a name="l03671"></a>03671 elseif (nhelsua == 2 .or. nhelsua == 3 .or. ndiagp > 0) <span class="keyword">then</span> <a name="l03672"></a>03672 <span class="keyword">if</span> (ndiagp == 0) <span class="keyword">then</span> <a name="l03673"></a>03673 call <a class="code" href="puma_8f90.html#a6cbd3f404dc5fbac334929a64cf2757f">heatgp</a>(zampl) <span class="comment">! stt(:,:) = Newtonian cooling</span> <a name="l03674"></a>03674 <span class="keyword">else</span> <a name="l03675"></a>03675 call <a class="code" href="puma_8f90.html#a28029d854398252d4d3b4eb9f161fed7">diagp</a>(zampl) <span class="comment">! stt(:,:) = Newtonian cooling</span> <a name="l03676"></a>03676 <span class="keyword">endif</span> <a name="l03677"></a>03677 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03678"></a>03678 zstte(:,:,2)=stt(:,:) <a name="l03679"></a>03679 <span class="keyword">endif</span> <a name="l03680"></a>03680 <span class="keyword">do</span> jlev=1,NLEV <a name="l03681"></a>03681 sdt(:,jlev) = sdp(:,jlev) * (sak(1:NSPP) - fric(jlev)) <a name="l03682"></a>03682 szt(:,jlev) = szp(:,jlev) * (sak(1:NSPP) - fric(jlev)) <a name="l03683"></a>03683 stt(:,jlev) = stt(:,jlev) + stp(:,jlev) * sak(1:NSPP) <a name="l03684"></a>03684 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03685"></a>03685 zstte(:,jlev,3)=stp(:,jlev)*sak(1:NSPP) <a name="l03686"></a>03686 <span class="keyword">endif</span> <a name="l03687"></a>03687 <span class="keyword">if</span>(ndheat > 0) <span class="keyword">then</span> <a name="l03688"></a>03688 zsdte(:,jlev,1) = -sdp(:,jlev) * fric(jlev) <a name="l03689"></a>03689 zszte(:,jlev,1) = -szp(:,jlev) * fric(jlev) <a name="l03690"></a>03690 zsdte(:,jlev,2) = sdp(:,jlev) * sak(1:NSPP) <a name="l03691"></a>03691 zszte(:,jlev,2) = szp(:,jlev) * sak(1:NSPP) <a name="l03692"></a>03692 <span class="keyword">endif</span> <a name="l03693"></a>03693 <span class="keyword">enddo</span> <a name="l03694"></a>03694 <span class="keyword">endif</span> <a name="l03695"></a>03695 <a name="l03696"></a>03696 <span class="comment">! Conserve ln(ps) by forcing mode(0,0) to zero</span> <a name="l03697"></a>03697 <span class="comment">! Correct vorticity by canceling the friction and diffusion</span> <a name="l03698"></a>03698 <span class="comment">! applied to planetary vorticity</span> <a name="l03699"></a>03699 <span class="comment">! Only root node processes the first NSPP modes</span> <a name="l03700"></a>03700 <a name="l03701"></a>03701 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03702"></a>03702 zspt(:)=0. <a name="l03703"></a>03703 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,2),spp,zspt,denergy(:,2)) <a name="l03704"></a>03704 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,3),spp,zspt,denergy(:,3)) <a name="l03705"></a>03705 <span class="keyword">endif</span> <a name="l03706"></a>03706 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l03707"></a>03707 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,2),spp,dentropy(:,2)) <a name="l03708"></a>03708 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,3),spp,dentropy(:,3)) <a name="l03709"></a>03709 <span class="keyword">endif</span> <a name="l03710"></a>03710 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0 .or. ndheat > 0) <span class="keyword">then</span> <a name="l03711"></a>03711 zsp(:)=spp(:) <a name="l03712"></a>03712 zstte(:,:,1)=stt(:,:) <a name="l03713"></a>03713 <span class="keyword">endif</span> <a name="l03714"></a>03714 <a name="l03715"></a>03715 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span> <a name="l03716"></a>03716 spp(1) = 0.0 <a name="l03717"></a>03717 spp(2) = 0.0 <a name="l03718"></a>03718 szt(3,:) = szt(3,:) + plavor * (fric(:) - sak(3)) <a name="l03719"></a>03719 <span class="keyword">if</span>(ndheat > 0) <span class="keyword">then</span> <a name="l03720"></a>03720 zszte(3,:,1) = zszte(3,:,1) + plavor * fric(:) <a name="l03721"></a>03721 zszte(3,:,2) = zszte(3,:,2) - plavor * sak(3) <a name="l03722"></a>03722 <span class="keyword">endif</span> <a name="l03723"></a>03723 <span class="keyword">endif</span> <a name="l03724"></a>03724 <span class="comment">!</span> <a name="l03725"></a>03725 <span class="comment">! 6b) call for vertical diffusion</span> <a name="l03726"></a>03726 <span class="comment">!</span> <a name="l03727"></a>03727 <a name="l03728"></a>03728 <span class="keyword">if</span>(dvdiff > 0.) call <a class="code" href="puma_8f90.html#ad1bea0bb9fdda56c5251fa64e712b7b1">vdiff</a>(stp,szp,sdp,stt,szt,sdt) <a name="l03729"></a>03729 <a name="l03730"></a>03730 <span class="comment">!</span> <a name="l03731"></a>03731 <span class="comment">! recycle kin energy dissipation</span> <a name="l03732"></a>03732 <span class="comment">! </span> <a name="l03733"></a>03733 <a name="l03734"></a>03734 <span class="keyword">if</span>(ndheat > 0) <span class="keyword">then</span> <a name="l03735"></a>03735 call <a class="code" href="puma_8f90.html#a079a9ea6caa3eb9d5ef5e0c82f76a2b9">mkdheat</a>(zszte(:,:,1),zszte(:,:,2) & <a name="l03736"></a>03736 & ,zsdte(:,:,1),zsdte(:,:,2),zsp) <a name="l03737"></a>03737 <span class="keyword">endif</span> <a name="l03738"></a>03738 <a name="l03739"></a>03739 <a name="l03740"></a>03740 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0) <span class="keyword">then</span> <a name="l03741"></a>03741 zstte(:,:,1)=stt(:,:)-zstte(:,:,1) <a name="l03742"></a>03742 <span class="keyword">endif</span> <a name="l03743"></a>03743 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03744"></a>03744 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,1),zsp,zspt,denergy(:,4)) <a name="l03745"></a>03745 <span class="keyword">endif</span> <a name="l03746"></a>03746 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l03747"></a>03747 zstte(:,:,1)=stt(:,:)-zstte(:,:,1) <a name="l03748"></a>03748 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,1),zsp,dentropy(:,4)) <a name="l03749"></a>03749 <span class="keyword">endif</span> <a name="l03750"></a>03750 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0) <span class="keyword">then</span> <a name="l03751"></a>03751 zstte(:,:,1)=0. <a name="l03752"></a>03752 zspt(:)=(spp(:)-zsp(:))/delt2 <a name="l03753"></a>03753 <span class="keyword">endif</span> <a name="l03754"></a>03754 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03755"></a>03755 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstte(:,:,1),zsp,zspt,denergy(:,8)) <a name="l03756"></a>03756 <span class="keyword">endif</span> <a name="l03757"></a>03757 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l03758"></a>03758 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstte(:,:,1),zsp,dentropy(:,8)) <a name="l03759"></a>03759 <span class="keyword">endif</span> <a name="l03760"></a>03760 <a name="l03761"></a>03761 <span class="comment">!</span> <a name="l03762"></a>03762 <span class="comment">! diagnostics of efficiency</span> <a name="l03763"></a>03763 <span class="comment">!</span> <a name="l03764"></a>03764 <a name="l03765"></a>03765 <span class="keyword">if</span>(ndheat > 1) <span class="keyword">then</span> <a name="l03766"></a>03766 zcp=gascon/akap <a name="l03767"></a>03767 <span class="keyword">allocate</span>(zst(NESP,NLEV)) <a name="l03768"></a>03768 <span class="keyword">allocate</span>(zstt(NESP,NLEV)) <a name="l03769"></a>03769 <span class="keyword">allocate</span>(zspf(NESP)) <a name="l03770"></a>03770 <span class="keyword">allocate</span>(ztgp(NHOR,NLEV)) <a name="l03771"></a>03771 <span class="keyword">allocate</span>(zdtgp(NHOR,NLEV)) <a name="l03772"></a>03772 <span class="keyword">allocate</span>(zdps(NHOR)) <a name="l03773"></a>03773 <span class="keyword">allocate</span>(zsum1(4)) <a name="l03774"></a>03774 <span class="keyword">allocate</span>(zgw(NHOR)) <a name="l03775"></a>03775 jhor=0 <a name="l03776"></a>03776 <span class="keyword">do</span> jlat=1,NHPP <a name="l03777"></a>03777 <span class="keyword">do</span> jlon=1,NLON*2 <a name="l03778"></a>03778 jhor=jhor+1 <a name="l03779"></a>03779 zgw(jhor)=gwd(jlat) <a name="l03780"></a>03780 <span class="keyword">enddo</span> <a name="l03781"></a>03781 <span class="keyword">enddo</span> <a name="l03782"></a>03782 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zst,stp,NLEV) <a name="l03783"></a>03783 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zstt,stt,NLEV) <a name="l03784"></a>03784 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,zsp,1) <a name="l03785"></a>03785 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l03786"></a>03786 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zst(1,jlev),ztgp(1,jlev)) <a name="l03787"></a>03787 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zstt(1,jlev),zdtgp(1,jlev)) <a name="l03788"></a>03788 <span class="keyword">enddo</span> <a name="l03789"></a>03789 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zdps) <a name="l03790"></a>03790 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(ztgp,NLON,NLPP*NLEV) <a name="l03791"></a>03791 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zdtgp,NLON,NLPP*NLEV) <a name="l03792"></a>03792 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zdps,NLON,NLPP) <a name="l03793"></a>03793 zdps(:)=psurf*exp(zdps(:)) <a name="l03794"></a>03794 zsum1(:)=0. <a name="l03795"></a>03795 <span class="keyword">do</span> jlev=1,NLEV <a name="l03796"></a>03796 ztgp(:,jlev)=ct*(ztgp(:,jlev)+t0(jlev)) <a name="l03797"></a>03797 zdtgp(:,jlev)=ct*ww*zdtgp(:,jlev) <a name="l03798"></a>03798 zsum1(1)=zsum1(1)+SUM(zdtgp(:,jlev)*zgw(:) & <a name="l03799"></a>03799 & *zcp*zdps(:)/ga*dsigma(jlev) & <a name="l03800"></a>03800 & ,mask=(zdtgp(:,jlev) >= 0.)) <a name="l03801"></a>03801 zsum1(2)=zsum1(2)+SUM(zdtgp(:,jlev)*zgw(:) & <a name="l03802"></a>03802 & *zcp*zdps(:)/ga*dsigma(jlev) & <a name="l03803"></a>03803 & ,mask=(zdtgp(:,jlev) < 0.)) <a name="l03804"></a>03804 zsum1(3)=zsum1(3)+SUM(zdtgp(:,jlev)/ztgp(:,jlev)*zgw(:) & <a name="l03805"></a>03805 & *zcp*zdps(:)/ga*dsigma(jlev) & <a name="l03806"></a>03806 & ,mask=(zdtgp(:,jlev) >= 0.)) <a name="l03807"></a>03807 zsum1(4)=zsum1(4)+SUM(zdtgp(:,jlev)/ztgp(:,jlev)*zgw(:) & <a name="l03808"></a>03808 & *zcp*zdps(:)/ga*dsigma(jlev) & <a name="l03809"></a>03809 & ,mask=(zdtgp(:,jlev) < 0.)) <a name="l03810"></a>03810 <span class="keyword">enddo</span> <a name="l03811"></a>03811 zsum3=SUM(zgw(:)) <a name="l03812"></a>03812 call <a class="code" href="mpimod_8f90.html#ad703e6ecd123e9b8280322e402d57d20">mpsumbcr</a>(zsum1,4) <a name="l03813"></a>03813 call <a class="code" href="mpimod_8f90.html#ad703e6ecd123e9b8280322e402d57d20">mpsumbcr</a>(zsum3,1) <a name="l03814"></a>03814 zsum1(:)=zsum1(:)/zsum3 <a name="l03815"></a>03815 <span class="keyword">if</span>(mypid == NROOT) <span class="keyword">then</span> <a name="l03816"></a>03816 ztp=zsum1(1)/zsum1(3) <a name="l03817"></a>03817 zztm=zsum1(2)/zsum1(4) <a name="l03818"></a>03818 <span class="keyword">write</span>(9,*) zsum1(:),zsum1(1)/zsum1(3),zsum1(2)/zsum1(4) & <a name="l03819"></a>03819 & ,(ztp-zztm)/ztp <a name="l03820"></a>03820 <span class="keyword">endif</span> <a name="l03821"></a>03821 <span class="keyword">deallocate</span>(zst) <a name="l03822"></a>03822 <span class="keyword">deallocate</span>(zstt) <a name="l03823"></a>03823 <span class="keyword">deallocate</span>(zspf) <a name="l03824"></a>03824 <span class="keyword">deallocate</span>(ztgp) <a name="l03825"></a>03825 <span class="keyword">deallocate</span>(zdps) <a name="l03826"></a>03826 <span class="keyword">deallocate</span>(zdtgp) <a name="l03827"></a>03827 <span class="keyword">deallocate</span>(zsum1) <a name="l03828"></a>03828 <span class="keyword">deallocate</span>(zgw) <a name="l03829"></a>03829 <span class="keyword">endif</span> <a name="l03830"></a>03830 <a name="l03831"></a>03831 <span class="comment">! 7. Add newtonian cooling, friction and diffusion tendencies</span> <a name="l03832"></a>03832 <a name="l03833"></a>03833 sdp(:,:) = sdp(:,:) + delt2 * sdt(:,:) <a name="l03834"></a>03834 szp(:,:) = szp(:,:) + delt2 * szt(:,:) <a name="l03835"></a>03835 stp(:,:) = stp(:,:) + delt2 * stt(:,:) <a name="l03836"></a>03836 <a name="l03837"></a>03837 <span class="comment">! 11. Coupling for synchronization runs</span> <a name="l03838"></a>03838 <a name="l03839"></a>03839 <span class="keyword">if</span> (mrnum == 2 .and. nsync > 0) <span class="keyword">then</span> <a name="l03840"></a>03840 call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(stp,std,NESP,NLEV) <a name="l03841"></a>03841 call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(sdp,sdd,NESP,NLEV) <a name="l03842"></a>03842 call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(szp,szd,NESP,NLEV) <a name="l03843"></a>03843 call <a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(spp,spd,NESP, 1) <a name="l03844"></a>03844 stp(:,:) = stp(:,:) + syncstr * std(:,:) <a name="l03845"></a>03845 sdp(:,:) = sdp(:,:) + syncstr * sdd(:,:) <a name="l03846"></a>03846 szp(:,:) = szp(:,:) + syncstr * szd(:,:) <a name="l03847"></a>03847 spp(: ) = spp(: ) + syncstr * spd(: ) <a name="l03848"></a>03848 <a name="l03849"></a>03849 <span class="keyword">endif</span> <a name="l03850"></a>03850 <a name="l03851"></a>03851 <span class="comment">! 8. Apply Robert Asselin time filter (not for short initial timesteps)</span> <a name="l03852"></a>03852 <span class="comment">! d(t) = pnu * f(t-1) + pnu * f(t+1) - 2 * pnu * f(t)</span> <a name="l03853"></a>03853 <a name="l03854"></a>03854 <span class="keyword">if</span> (nkits == 0) <span class="keyword">then</span> <a name="l03855"></a>03855 zwp(:) = pnu * (spm(:) + spp(:) - 2.0 * zpm(:) ) <a name="l03856"></a>03856 zwd(:,:) = pnu * (sdm(:,:) + sdp(:,:) - 2.0 * zdm(:,:)) <a name="l03857"></a>03857 zwz(:,:) = pnu * (szm(:,:) + szp(:,:) - 2.0 * zzm(:,:)) <a name="l03858"></a>03858 zwt(:,:) = pnu * (stm(:,:) + stp(:,:) - 2.0 * ztm(:,:)) <a name="l03859"></a>03859 <a name="l03860"></a>03860 <span class="comment">! Add Robert-Asselin-Williams filter value to f(t)</span> <a name="l03861"></a>03861 <a name="l03862"></a>03862 spm(:) = zpm(:) + alpha * zwp(:) <a name="l03863"></a>03863 sdm(:,:) = zdm(:,:) + alpha * zwd(:,:) <a name="l03864"></a>03864 szm(:,:) = zzm(:,:) + alpha * zwz(:,:) <a name="l03865"></a>03865 stm(:,:) = ztm(:,:) + alpha * zwt(:,:) <a name="l03866"></a>03866 <a name="l03867"></a>03867 <span class="comment">! Add filter value to f(t+1)</span> <a name="l03868"></a>03868 <a name="l03869"></a>03869 spp(:) = spp(:) - (1.0 - alpha) * zwp(:) <a name="l03870"></a>03870 sdp(:,:) = sdp(:,:) - (1.0 - alpha) * zwd(:,:) <a name="l03871"></a>03871 szp(:,:) = szp(:,:) - (1.0 - alpha) * zwz(:,:) <a name="l03872"></a>03872 stp(:,:) = stp(:,:) - (1.0 - alpha) * zwt(:,:) <a name="l03873"></a>03873 <span class="keyword">endif</span> <a name="l03874"></a>03874 <a name="l03875"></a>03875 <span class="keyword">if</span> (nenergy > 0 .or. nentropy > 0) <span class="keyword">then</span> <a name="l03876"></a>03876 zstte(:,:,1)=(stm(:,:)-ztm(:,:))/delt2 <a name="l03877"></a>03877 zspt(:)=(spm(:)-zpm(:))/delt2 <a name="l03878"></a>03878 <span class="keyword">endif</span> <a name="l03879"></a>03879 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l03880"></a>03880 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(ztm,zstte(:,:,1),zpm,zspt,denergy(:,9)) <a name="l03881"></a>03881 <span class="keyword">endif</span> <a name="l03882"></a>03882 <span class="keyword">if</span> (nentropy > 0) <span class="keyword">then</span> <a name="l03883"></a>03883 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(ztm,zstte(:,:,1),zpm,dentropy(:,9)) <a name="l03884"></a>03884 <span class="keyword">endif</span> <a name="l03885"></a>03885 <a name="l03886"></a>03886 <span class="comment">! 9. Save spectral arrays for extended output</span> <a name="l03887"></a>03887 <a name="l03888"></a>03888 <span class="keyword">if</span> (nextout == 1 .and. mypid == NROOT) <span class="keyword">then</span> <a name="l03889"></a>03889 <span class="keyword">if</span> (mod(nstep,nafter) == nafter - 2) <span class="keyword">then</span> <a name="l03890"></a>03890 <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(st2)) <span class="keyword">allocate</span>(st2(nesp,nlev)) <a name="l03891"></a>03891 st2(:,:) = st(:,:) <a name="l03892"></a>03892 <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(sp2)) <span class="keyword">allocate</span>(sp2(nesp)) <a name="l03893"></a>03893 sp2(:) = sp(:) <a name="l03894"></a>03894 <span class="keyword">endif</span> <a name="l03895"></a>03895 <span class="keyword">if</span> (mod(nstep,nafter) == nafter - 1) <span class="keyword">then</span> <a name="l03896"></a>03896 <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(st1)) <span class="keyword">allocate</span>(st1(nesp,nlev)) <a name="l03897"></a>03897 st1(:,:) = st(:,:) <a name="l03898"></a>03898 <span class="keyword">if</span> (.not. <span class="keyword">allocated</span>(sp1)) <span class="keyword">allocate</span>(sp1(nesp)) <a name="l03899"></a>03899 sp1(:) = sp(:) <a name="l03900"></a>03900 <span class="keyword">endif</span> <a name="l03901"></a>03901 <span class="keyword">endif</span> <a name="l03902"></a>03902 <a name="l03903"></a>03903 <span class="comment">! 10. Gather spectral modes from all processes</span> <a name="l03904"></a>03904 <a name="l03905"></a>03905 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sp,spp, 1) <a name="l03906"></a>03906 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sd,sdp,NLEV) <a name="l03907"></a>03907 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sz,szp,NLEV) <a name="l03908"></a>03908 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(st,stp,NLEV) <a name="l03909"></a>03909 <a name="l03910"></a>03910 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0) <span class="keyword">then</span> <a name="l03911"></a>03911 <span class="keyword">deallocate</span>(zstte) <a name="l03912"></a>03912 <span class="keyword">endif</span> <a name="l03913"></a>03913 <span class="keyword">if</span>(ndheat > 0) <span class="keyword">then</span> <a name="l03914"></a>03914 <span class="keyword">deallocate</span>(zszte) <a name="l03915"></a>03915 <span class="keyword">deallocate</span>(zsdte) <a name="l03916"></a>03916 <span class="keyword">endif</span> <a name="l03917"></a>03917 <span class="keyword">if</span>(nenergy > 0 .or. nentropy > 0 .or. ndheat > 0) <span class="keyword">then</span> <a name="l03918"></a>03918 <span class="keyword">deallocate</span>(zsp) <a name="l03919"></a>03919 <span class="keyword">deallocate</span>(zspt) <a name="l03920"></a>03920 <span class="keyword">endif</span> <a name="l03921"></a>03921 <a name="l03922"></a>03922 return <a name="l03923"></a>03923 <span class="keyword"> end</span> <a name="l03924"></a>03924 <a name="l03925"></a><a class="code" href="puma_8f90.html#a1ad2c0878e366bb7f12ca880fd36c654">03925</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a1ad2c0878e366bb7f12ca880fd36c654">mrcheck</a>(f) <a name="l03926"></a>03926 use <span class="keywordflow">pumamod</span> <a name="l03927"></a>03927 <span class="keywordtype">real</span> :: f(*) <a name="l03928"></a>03928 <span class="keyword">write</span> (nud,<span class="stringliteral">'(/,i3,8f8.4)'</span>) 0,f(1:16:2) <a name="l03929"></a>03929 <span class="keyword">write</span> (nud,<span class="stringliteral">'( i3,8f8.4)'</span>) 8,f(17:32:2) <a name="l03930"></a>03930 <span class="keyword">write</span> (nud,<span class="stringliteral">'( i3,8f8.4)'</span>) 16,f(33:48:2) <a name="l03931"></a>03931 <span class="keyword">write</span> (nud,<span class="stringliteral">'( i3,8f8.4)'</span>) 24,f(49:64:2) <a name="l03932"></a>03932 <span class="keyword">write</span> (nud,<span class="stringliteral">'( i3,8f8.4)'</span>) 32,f(65:80:2) <a name="l03933"></a>03933 return <a name="l03934"></a>03934 <span class="keyword"> end </span> <a name="l03935"></a>03935 <a name="l03936"></a>03936 <a name="l03937"></a>03937 <span class="comment">! ================</span> <a name="l03938"></a>03938 <span class="comment">! SUBROUTINE DIAGP</span> <a name="l03939"></a>03939 <span class="comment">! ================</span> <a name="l03940"></a>03940 <a name="l03941"></a><a class="code" href="puma_8f90.html#a28029d854398252d4d3b4eb9f161fed7">03941</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a28029d854398252d4d3b4eb9f161fed7">diagp</a>(zampl) <a name="l03942"></a>03942 use <span class="keywordflow">pumamod</span> <a name="l03943"></a>03943 <a name="l03944"></a>03944 <span class="keywordtype">real</span> :: zstf(NESP,NLEV) <a name="l03945"></a>03945 <span class="keywordtype">real</span> :: zgr12(NHOR,NLEV) <a name="l03946"></a>03946 <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV) <a name="l03947"></a>03947 <span class="keywordtype">real</span> :: gr12(NHOR,NLEV) <a name="l03948"></a>03948 <span class="keywordtype">real</span> :: gr12c(NHOR,NLEV) <a name="l03949"></a>03949 <a name="l03950"></a>03950 <a name="l03951"></a>03951 <span class="keywordtype">real</span> :: gdtmp(NHOR) <a name="l03952"></a>03952 <a name="l03953"></a>03953 <span class="keywordtype">real</span> :: zampl <a name="l03954"></a>03954 <a name="l03955"></a>03955 <span class="comment">!--- transform temperature and divergence to grid point space</span> <a name="l03956"></a>03956 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(st,stp,NLEV) <a name="l03957"></a>03957 <span class="keyword">if</span> (nconv > 0) <span class="keyword">then</span> <a name="l03958"></a>03958 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(sd,sdp,NLEV) <a name="l03959"></a>03959 <span class="keyword">endif</span> <a name="l03960"></a>03960 <span class="keyword">do</span> jlev=1,NLEV <a name="l03961"></a>03961 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(st(1,jlev) ,gt(1,jlev) ) <a name="l03962"></a>03962 <span class="keyword">if</span> (nconv > 0) <span class="keyword">then</span> <a name="l03963"></a>03963 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(sd(1,jlev) ,gd(1,jlev) ) <a name="l03964"></a>03964 <span class="keyword">endif</span> <a name="l03965"></a>03965 <span class="keyword">enddo</span> <a name="l03966"></a>03966 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gt ,NLON,NLPP*NLEV) <a name="l03967"></a>03967 <span class="keyword">if</span> (nconv > 0) <span class="keyword">then</span> <a name="l03968"></a>03968 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gd ,NLON,NLPP*NLEV) <a name="l03969"></a>03969 <span class="keyword">endif</span> <a name="l03970"></a>03970 <a name="l03971"></a>03971 <a name="l03972"></a>03972 <span class="comment">!--- radiative temperature tendencies </span> <a name="l03973"></a>03973 gr12(:,:) = gr1(:,:) + gr2(:,:)*zampl <a name="l03974"></a>03974 zgtt(:,:) = (gr12(:,:) - gt(:,:))*gtdamp(:,:) <a name="l03975"></a>03975 <a name="l03976"></a>03976 <span class="comment">!--- add convective temperature tendencies</span> <a name="l03977"></a>03977 <span class="keyword">if</span> (nconv > 0) <span class="keyword">then</span> <a name="l03978"></a>03978 gdtmp(:) = gd(:,nlev) <a name="l03979"></a>03979 <span class="keyword">do</span> jlev = 1,nlev <a name="l03980"></a>03980 <span class="keyword">where</span> (gdtmp < 0.0) <a name="l03981"></a>03981 gr12c(:,jlev) = gr1c(:,jlev) + gr2c(:,jlev)*zampl <a name="l03982"></a>03982 zgtt(:,jlev) = zgtt(:,jlev) + (gr12c(:,jlev) - gt(:,jlev))*gtdampc(:,jlev) <a name="l03983"></a>03983 endwhere <a name="l03984"></a>03984 <span class="keyword">enddo</span> <a name="l03985"></a>03985 <span class="keyword">endif</span> <a name="l03986"></a>03986 <a name="l03987"></a>03987 <span class="comment">!--- transform temperature tendencies to spectral space</span> <a name="l03988"></a>03988 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zgtt ,NLON,NLPP*NLEV) <a name="l03989"></a>03989 <span class="keyword">do</span> jlev=1,NLEV <a name="l03990"></a>03990 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zgtt(1,jlev),zstf(1,jlev)) <a name="l03991"></a>03991 <span class="keyword">enddo</span> <a name="l03992"></a>03992 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf,stt,NLEV) <a name="l03993"></a>03993 <a name="l03994"></a>03994 return <a name="l03995"></a>03995 <span class="keyword"> end subroutine diagp</span> <a name="l03996"></a>03996 <a name="l03997"></a>03997 <span class="comment">! =================</span> <a name="l03998"></a>03998 <span class="comment">! SUBROUTINE HEATGP</span> <a name="l03999"></a>03999 <span class="comment">! =================</span> <a name="l04000"></a>04000 <a name="l04001"></a><a class="code" href="puma_8f90.html#a6cbd3f404dc5fbac334929a64cf2757f">04001</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a6cbd3f404dc5fbac334929a64cf2757f">heatgp</a>(zampl) <a name="l04002"></a>04002 use <span class="keywordflow">pumamod</span> <a name="l04003"></a>04003 <a name="l04004"></a>04004 <span class="keywordtype">real</span> :: zsr12(NESP,NLEV) <a name="l04005"></a>04005 <span class="keywordtype">real</span> :: zsrp12(NSPP,NLEV) <a name="l04006"></a>04006 <span class="keywordtype">real</span> :: zstf(NESP,NLEV) <a name="l04007"></a>04007 <span class="keywordtype">real</span> :: zgr12(NHOR,NLEV) <a name="l04008"></a>04008 <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV) <a name="l04009"></a>04009 <a name="l04010"></a>04010 <span class="keywordtype">real</span> :: zampl <a name="l04011"></a>04011 <a name="l04012"></a>04012 zsrp12(:,:)=srp1(:,:)+srp2(:,:)*zampl <a name="l04013"></a>04013 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsr12,zsrp12,NLEV) <a name="l04014"></a>04014 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(st,stp,NLEV) <a name="l04015"></a>04015 <span class="keyword">do</span> jlev=1,NLEV <a name="l04016"></a>04016 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsr12(1,jlev),zgr12(1,jlev)) <a name="l04017"></a>04017 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(st(1,jlev) ,gt(1,jlev) ) <a name="l04018"></a>04018 <span class="keyword">enddo</span> <a name="l04019"></a>04019 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgr12,NLON,NLPP*NLEV) <a name="l04020"></a>04020 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(gt ,NLON,NLPP*NLEV) <a name="l04021"></a>04021 <a name="l04022"></a>04022 <span class="comment">! Newtonian cooling</span> <a name="l04023"></a>04023 <a name="l04024"></a>04024 zgtt(:,:) = (zgr12(:,:) - gt(:,:)) * gtdamp(:,:) <a name="l04025"></a>04025 <a name="l04026"></a>04026 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zgtt ,NLON,NLPP*NLEV) <a name="l04027"></a>04027 <span class="keyword">do</span> jlev=1,NLEV <a name="l04028"></a>04028 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zgtt(1,jlev),zstf(1,jlev)) <a name="l04029"></a>04029 <span class="keyword">enddo</span> <a name="l04030"></a>04030 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf,stt,NLEV) <a name="l04031"></a>04031 <a name="l04032"></a>04032 return <a name="l04033"></a>04033 <span class="keyword"> end</span> <a name="l04034"></a>04034 <a name="l04035"></a>04035 <span class="comment">! ================</span> <a name="l04036"></a>04036 <span class="comment">! SUBROUTINE VDIFF</span> <a name="l04037"></a>04037 <span class="comment">! ================</span> <a name="l04038"></a>04038 <a name="l04039"></a><a class="code" href="puma_8f90.html#ad1bea0bb9fdda56c5251fa64e712b7b1">04039</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#ad1bea0bb9fdda56c5251fa64e712b7b1">vdiff</a>(pt,pz,pd,ptt,pzt,pdt) <a name="l04040"></a>04040 use <span class="keywordflow">pumamod</span> <a name="l04041"></a>04041 <span class="comment">!</span> <a name="l04042"></a>04042 parameter(ztref=250.) <a name="l04043"></a>04043 <span class="keywordtype">real</span> pt(NSPP,NLEV),pz(NSPP,NLEV),pd(NSPP,NLEV) <a name="l04044"></a>04044 <span class="keywordtype">real</span> ptt(NSPP,NLEV),pzt(NSPP,NLEV),pdt(NSPP,NLEV) <a name="l04045"></a>04045 <span class="keywordtype">real</span> ztn(NSPP,NLEV),zzn(NSPP,NLEV),zdn(NSPP,NLEV) <a name="l04046"></a>04046 <span class="keywordtype">real</span> zebs(NLEM) <a name="l04047"></a>04047 <span class="keywordtype">real</span> zskap(NLEV),zskaph(NLEV) <a name="l04048"></a>04048 <span class="keywordtype">real</span> zkdiff(NLEM) <a name="l04049"></a>04049 <span class="comment">!</span> <a name="l04050"></a>04050 zdelt=delt2/ww <a name="l04051"></a>04051 zkonst1=ga*zdelt/gascon <a name="l04052"></a>04052 zkonst2=zkonst1*ga/gascon <a name="l04053"></a>04053 <span class="comment">!</span> <a name="l04054"></a>04054 zskap(:)=sigma(:)**akap <a name="l04055"></a>04055 zskaph(:)=sigmh(:)**akap <a name="l04056"></a>04056 <span class="comment">!</span> <a name="l04057"></a>04057 <span class="comment">! 1) modified diffusion coefficents</span> <a name="l04058"></a>04058 <span class="comment">!</span> <a name="l04059"></a>04059 <span class="keyword">do</span> jlev=1,NLEM <a name="l04060"></a>04060 jlp=jlev+1 <a name="l04061"></a>04061 zkdiff(jlev)=zkonst2*sigmh(jlev)*sigmh(jlev)/(ztref*ztref) & <a name="l04062"></a>04062 & *dvdiff/(sigma(jlp)-sigma(jlev)) <a name="l04063"></a>04063 <span class="keyword">enddo</span> <a name="l04064"></a>04064 <span class="comment">!</span> <a name="l04065"></a>04065 <span class="comment">! 2. semi implicit scheme</span> <a name="l04066"></a>04066 <span class="comment">!</span> <a name="l04067"></a>04067 <span class="comment">! 2a momentum</span> <a name="l04068"></a>04068 <span class="comment">!</span> <a name="l04069"></a>04069 <span class="comment">! top layer elimination</span> <a name="l04070"></a>04070 <span class="comment">!</span> <a name="l04071"></a>04071 zebs(1)=zkdiff(1)/(dsigma(1)+zkdiff(1)) <a name="l04072"></a>04072 zdn(:,1)=dsigma(1)*pd(:,1)/(dsigma(1)+zkdiff(1)) <a name="l04073"></a>04073 zzn(:,1)=dsigma(1)*pz(:,1)/(dsigma(1)+zkdiff(1)) <a name="l04074"></a>04074 <span class="comment">!</span> <a name="l04075"></a>04075 <span class="comment">! middle layer elimination</span> <a name="l04076"></a>04076 <span class="comment">!</span> <a name="l04077"></a>04077 <span class="keyword">do</span> jlev=2,NLEM <a name="l04078"></a>04078 jlem=jlev-1 <a name="l04079"></a>04079 zebs(jlev)=zkdiff(jlev)/(dsigma(jlev)+zkdiff(jlev) & <a name="l04080"></a>04080 & +zkdiff(jlem)*(1.-zebs(jlem))) <a name="l04081"></a>04081 zdn(:,jlev)=(pd(:,jlev)*dsigma(jlev)+zkdiff(jlem)*zdn(:,jlem)) & <a name="l04082"></a>04082 & /(dsigma(jlev)+zkdiff(jlev) & <a name="l04083"></a>04083 & +zkdiff(jlem)*(1.-zebs(jlem))) <a name="l04084"></a>04084 zzn(:,jlev)=(pz(:,jlev)*dsigma(jlev)+zkdiff(jlem)*zzn(:,jlem)) & <a name="l04085"></a>04085 & /(dsigma(jlev)+zkdiff(jlev) & <a name="l04086"></a>04086 & +zkdiff(jlem)*(1.-zebs(jlem))) <a name="l04087"></a>04087 <span class="keyword">enddo</span> <a name="l04088"></a>04088 <span class="comment">!</span> <a name="l04089"></a>04089 <span class="comment">! bottom layer elimination</span> <a name="l04090"></a>04090 <span class="comment">!</span> <a name="l04091"></a>04091 zdn(:,NLEV)=(pd(:,NLEV)*dsigma(NLEV)+zkdiff(NLEM)*zdn(:,NLEM)) & <a name="l04092"></a>04092 & /(dsigma(NLEV)+zkdiff(NLEM)*(1.-zebs(NLEM))) <a name="l04093"></a>04093 zzn(:,NLEV)=(pz(:,NLEV)*dsigma(NLEV)+zkdiff(NLEM)*zzn(:,NLEM)) & <a name="l04094"></a>04094 & /(dsigma(NLEV)+zkdiff(NLEM)*(1.-zebs(NLEM))) <a name="l04095"></a>04095 <span class="comment">!</span> <a name="l04096"></a>04096 <span class="comment">! back-substitution</span> <a name="l04097"></a>04097 <span class="comment">!</span> <a name="l04098"></a>04098 <span class="keyword">do</span> jlev=NLEM,1,-1 <a name="l04099"></a>04099 jlep=jlev+1 <a name="l04100"></a>04100 zdn(:,jlev)=zdn(:,jlev)+zebs(jlev)*zdn(:,jlep) <a name="l04101"></a>04101 zzn(:,jlev)=zzn(:,jlev)+zebs(jlev)*zzn(:,jlep) <a name="l04102"></a>04102 <span class="keyword">enddo</span> <a name="l04103"></a>04103 <span class="comment">!</span> <a name="l04104"></a>04104 <span class="comment">! tendencies</span> <a name="l04105"></a>04105 <span class="comment">!</span> <a name="l04106"></a>04106 pdt(:,1:NLEV)=pdt(:,1:NLEV)+(zdn(:,1:NLEV)-pd(:,1:NLEV))/delt2 <a name="l04107"></a>04107 pzt(:,1:NLEV)=pzt(:,1:NLEV)+(zzn(:,1:NLEV)-pz(:,1:NLEV))/delt2 <a name="l04108"></a>04108 <span class="comment">!</span> <a name="l04109"></a>04109 <span class="comment">! 2c potential temperature</span> <a name="l04110"></a>04110 <span class="comment">!</span> <a name="l04111"></a>04111 <span class="keyword">do</span> jlev=1,NLEM <a name="l04112"></a>04112 zkdiff(jlev)=zkdiff(jlev)*zskaph(jlev) <a name="l04113"></a>04113 <span class="keyword">enddo</span> <a name="l04114"></a>04114 <span class="comment">!</span> <a name="l04115"></a>04115 <span class="comment">! semi implicit scheme</span> <a name="l04116"></a>04116 <span class="comment">!</span> <a name="l04117"></a>04117 <span class="comment">! top layer elimination</span> <a name="l04118"></a>04118 <span class="comment">!</span> <a name="l04119"></a>04119 zebs(1)=zkdiff(1)/(dsigma(1)+zkdiff(1)/zskap(1)) <a name="l04120"></a>04120 ztn(:,1)=dsigma(1)*pt(:,1)/(dsigma(1)+zkdiff(1)/zskap(1)) <a name="l04121"></a>04121 <span class="comment">!</span> <a name="l04122"></a>04122 <span class="comment">! middle layer elimination</span> <a name="l04123"></a>04123 <span class="comment">!</span> <a name="l04124"></a>04124 <span class="keyword">do</span> jlev=2,NLEM <a name="l04125"></a>04125 jlem=jlev-1 <a name="l04126"></a>04126 zebs(jlev)=zkdiff(jlev)/(dsigma(jlev)+(zkdiff(jlev) & <a name="l04127"></a>04127 & +zkdiff(jlem)*(1.-zebs(jlem)/zskap(jlem)))/zskap(jlev)) <a name="l04128"></a>04128 ztn(:,jlev)=(pt(:,jlev)*dsigma(jlev) & <a name="l04129"></a>04129 & +zkdiff(jlem)/zskap(jlem)*ztn(:,jlem)) & <a name="l04130"></a>04130 & /(dsigma(jlev)+(zkdiff(jlev) & <a name="l04131"></a>04131 & +zkdiff(jlem)*(1.-zebs(jlem)/zskap(jlem))) & <a name="l04132"></a>04132 & /zskap(jlev)) <a name="l04133"></a>04133 <span class="keyword">enddo</span> <a name="l04134"></a>04134 <span class="comment">!</span> <a name="l04135"></a>04135 <span class="comment">! bottom layer elimination</span> <a name="l04136"></a>04136 <span class="comment">!</span> <a name="l04137"></a>04137 ztn(:,NLEV)=(pt(:,NLEV)*dsigma(NLEV) & <a name="l04138"></a>04138 & +zkdiff(NLEM)*ztn(:,NLEM)/zskap(NLEM)) & <a name="l04139"></a>04139 & /(dsigma(NLEV)+zkdiff(NLEM)/zskap(NLEV) & <a name="l04140"></a>04140 & *(1.-zebs(NLEM)/zskap(NLEM))) <a name="l04141"></a>04141 <span class="comment">!</span> <a name="l04142"></a>04142 <span class="comment">! back-substitution</span> <a name="l04143"></a>04143 <span class="comment">!</span> <a name="l04144"></a>04144 <span class="keyword">do</span> jlev=NLEM,1,-1 <a name="l04145"></a>04145 jlep=jlev+1 <a name="l04146"></a>04146 ztn(:,jlev)=ztn(:,jlev)+zebs(jlev)*ztn(:,jlep)/zskap(jlep) <a name="l04147"></a>04147 <span class="keyword">enddo</span> <a name="l04148"></a>04148 <span class="comment">!</span> <a name="l04149"></a>04149 <span class="comment">! tendencies</span> <a name="l04150"></a>04150 <span class="comment">!</span> <a name="l04151"></a>04151 ptt(:,1:NLEV)=ptt(:,1:NLEV)+(ztn(:,1:NLEV)-pt(:,1:NLEV))/delt2 <a name="l04152"></a>04152 <span class="comment">!</span> <a name="l04153"></a>04153 return <a name="l04154"></a>04154 <span class="keyword"> end subroutine vdiff</span> <a name="l04155"></a>04155 <a name="l04156"></a>04156 <span class="comment">! =================</span> <a name="l04157"></a>04157 <span class="comment">! SUBROUTINE GASDEV</span> <a name="l04158"></a>04158 <span class="comment">! =================</span> <a name="l04159"></a>04159 <a name="l04160"></a>04160 <span class="comment">! Gaussian noise generator with zero mean and unit variance.</span> <a name="l04161"></a>04161 <a name="l04162"></a><a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">04162</a> <span class="keyword">real </span><span class="keyword">function </span><a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a>() <a name="l04163"></a>04163 use <span class="keywordflow">pumamod</span> <a name="l04164"></a>04164 <span class="keyword">implicit none</span> <a name="l04165"></a>04165 <span class="keywordtype">real</span> :: fr, vx, vy, ra <a name="l04166"></a>04166 <a name="l04167"></a>04167 <span class="keyword">if</span> (ganext == 0.0) <span class="keyword">then</span> <a name="l04168"></a>04168 ra = 2.0 <a name="l04169"></a>04169 <span class="keyword">do</span> <span class="keyword">while</span> (ra >= 1.0 .or. ra < 1.0e-20) <a name="l04170"></a>04170 call random_number(vx) <a name="l04171"></a>04171 call random_number(vy) <a name="l04172"></a>04172 vx = 2.0 * vx - 1.0 <a name="l04173"></a>04173 vy = 2.0 * vy - 1.0 <a name="l04174"></a>04174 ra = vx * vx + vy * vy <a name="l04175"></a>04175 <span class="keyword">enddo</span> <a name="l04176"></a>04176 fr = sqrt(-2.0 * log(ra) / ra) <a name="l04177"></a>04177 <a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a> = vx * fr <a name="l04178"></a>04178 ganext = vy * fr <a name="l04179"></a>04179 <span class="keyword">else</span> <a name="l04180"></a>04180 <a class="code" href="puma_8f90.html#abc1c514e88a9fc8af7e7fb69f67c2340">gasdev</a> = ganext <a name="l04181"></a>04181 ganext = 0.0 <a name="l04182"></a>04182 <span class="keyword">endif</span> <a name="l04183"></a>04183 <a name="l04184"></a>04184 return <a name="l04185"></a>04185 <span class="keyword"> end</span> <a name="l04186"></a>04186 <a name="l04187"></a>04187 <span class="comment">! =================</span> <a name="l04188"></a>04188 <span class="comment">! SUBROUTINE SPONGE</span> <a name="l04189"></a>04189 <span class="comment">! =================</span> <a name="l04190"></a>04190 <a name="l04191"></a><a class="code" href="puma_8f90.html#a0c040011dabc1b712353c37a4d90cc68">04191</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0c040011dabc1b712353c37a4d90cc68">sponge</a> <a name="l04192"></a>04192 use <span class="keywordflow">pumamod</span> <a name="l04193"></a>04193 <a name="l04194"></a>04194 <span class="keywordtype">real</span> :: zp <a name="l04195"></a>04195 <a name="l04196"></a>04196 <span class="comment">! This introduces a simple sponge layer to the highest model levels</span> <a name="l04197"></a>04197 <span class="comment">! by applying Rayleigh friction there, according to</span> <a name="l04198"></a>04198 <span class="comment">! Polvani & Kushner (2002, GRL), see their appendix.</span> <a name="l04199"></a>04199 <a name="l04200"></a>04200 <span class="keyword">write</span>(nud,*) <a name="l04201"></a>04201 <span class="keyword">write</span>(nud,9991) <a name="l04202"></a>04202 <span class="keyword">write</span>(nud,9997) <a name="l04203"></a>04203 <span class="keyword">write</span>(nud,9991) <a name="l04204"></a>04204 <span class="keyword">write</span>(nud,9996) <a name="l04205"></a>04205 <span class="keyword">write</span>(nud,9991) <a name="l04206"></a>04206 <span class="keyword">do</span> jlev=1,NLEV <a name="l04207"></a>04207 zp = sigma(jlev)*psurf <a name="l04208"></a>04208 <span class="keyword">if</span> (zp < pspon) <span class="keyword">then</span> <a name="l04209"></a>04209 fric(jlev) = (sponk * ((pspon - zp) / pspon)**2) / TWOPI <a name="l04210"></a>04210 <span class="keyword">endif</span> <a name="l04211"></a>04211 <a name="l04212"></a>04212 <span class="comment">! some output</span> <a name="l04213"></a>04213 <span class="keyword">if</span> (zp > pspon) <span class="keyword">then</span> <a name="l04214"></a>04214 <span class="keyword">if</span> (fric(jlev) == 0) <span class="keyword">then</span> <a name="l04215"></a>04215 <span class="keyword">write</span>(nud,9992) jlev <a name="l04216"></a>04216 <span class="keyword">else</span> <a name="l04217"></a>04217 <span class="keyword">write</span>(nud,9993) jlev, fric(jlev)*TWOPI <a name="l04218"></a>04218 <span class="keyword">endif</span> <a name="l04219"></a>04219 <span class="keyword">else</span> <a name="l04220"></a>04220 <span class="keyword">if</span> (fric(jlev) == 0) <span class="keyword">then</span> <a name="l04221"></a>04221 <span class="keyword">write</span>(nud,9994) jlev <a name="l04222"></a>04222 <span class="keyword">else</span> <a name="l04223"></a>04223 <span class="keyword">write</span>(nud,9995) jlev, fric(jlev)*TWOPI <a name="l04224"></a>04224 <span class="keyword">endif</span> <a name="l04225"></a>04225 <span class="keyword">endif</span> <a name="l04226"></a>04226 <span class="keyword">enddo</span> <a name="l04227"></a>04227 <span class="keyword">write</span>(nud,9991) <a name="l04228"></a>04228 <span class="keyword">write</span>(nud,*) <a name="l04229"></a>04229 return <a name="l04230"></a>04230 9991 format(33(<span class="stringliteral">'*'</span>)) <a name="l04231"></a>04231 9992 format(<span class="stringliteral">'*'</span>,i4,<span class="stringliteral">' * '</span>,7(<span class="stringliteral">'-'</span>),<span class="stringliteral">' * *'</span>) <a name="l04232"></a>04232 9993 format(<span class="stringliteral">'*'</span>,i4,<span class="stringliteral">' * '</span>,f7.4,<span class="stringliteral">' * *'</span>) <a name="l04233"></a>04233 9994 format(<span class="stringliteral">'*'</span>,i4,<span class="stringliteral">' * '</span>,7(<span class="stringliteral">'-'</span>),<span class="stringliteral">' *'</span>,<span class="stringliteral">' SPONGE *'</span>) <a name="l04234"></a>04234 9995 format(<span class="stringliteral">'*'</span>,i4,<span class="stringliteral">' * '</span>,f7.4,<span class="stringliteral">' *'</span>,<span class="stringliteral">' SPONGE *'</span>) <a name="l04235"></a>04235 9996 format(<span class="stringliteral">'* Lv * [1/day] * *'</span>) <a name="l04236"></a>04236 9997 format(<span class="stringliteral">'* Rayleigh damping coefficients *'</span>) <a name="l04237"></a>04237 <span class="keyword"> end</span> <a name="l04238"></a>04238 <a name="l04239"></a>04239 <a name="l04240"></a>04240 <span class="comment">! =====================</span> <a name="l04241"></a>04241 <span class="comment">! SUBROUTINE MKENERDIAG</span> <a name="l04242"></a>04242 <span class="comment">! =====================</span> <a name="l04243"></a>04243 <a name="l04244"></a><a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">04244</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(pst,pstt,psp,pspt,penergy) <a name="l04245"></a>04245 use <span class="keywordflow">pumamod</span> <a name="l04246"></a>04246 <span class="comment">!</span> <a name="l04247"></a>04247 <span class="keywordtype">real</span> :: pst(NSPP,NLEV),pstt(NSPP,NLEV) <a name="l04248"></a>04248 <span class="keywordtype">real</span> :: psp(NSPP),pspt(NSPP) <a name="l04249"></a>04249 <span class="keywordtype">real</span> :: penergy(NHOR) <a name="l04250"></a>04250 <span class="comment">!</span> <a name="l04251"></a>04251 <span class="keywordtype">real</span> :: zsttf(NESP,NLEV),zstf(NESP,NLEV) <a name="l04252"></a>04252 <span class="keywordtype">real</span> :: zsptf(NESP),zspf(NESP) <a name="l04253"></a>04253 <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV),zgt(NHOR,NLEV) <a name="l04254"></a>04254 <span class="keywordtype">real</span> :: zgps(NHOR),zgpst(NHOR) <a name="l04255"></a>04255 <span class="keywordtype">real</span> :: ztm(NHOR) <a name="l04256"></a>04256 <span class="comment">!</span> <a name="l04257"></a>04257 zcp=gascon/akap <a name="l04258"></a>04258 zdelt=delt2/ww <a name="l04259"></a>04259 <span class="comment">!</span> <a name="l04260"></a>04260 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsttf,pstt,NLEV) <a name="l04261"></a>04261 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zstf,pst,NLEV) <a name="l04262"></a>04262 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsptf,pspt,1) <a name="l04263"></a>04263 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,psp,1) <a name="l04264"></a>04264 <a name="l04265"></a>04265 <span class="keyword">do</span> jlev=1,NLEV <a name="l04266"></a>04266 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsttf(:,jlev),zgtt(:,jlev)) <a name="l04267"></a>04267 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zstf(:,jlev),zgt(:,jlev)) <a name="l04268"></a>04268 <span class="keyword">enddo</span> <a name="l04269"></a>04269 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsptf,zgpst) <a name="l04270"></a>04270 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zgps) <a name="l04271"></a>04271 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgtt,NLON,NLPP*NLEV) <a name="l04272"></a>04272 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgt,NLON,NLPP*NLEV) <a name="l04273"></a>04273 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgps,NLON,NLPP) <a name="l04274"></a>04274 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgpst,NLON,NLPP) <a name="l04275"></a>04275 zgpst(:)=psurf*(exp(zgps(:)+delt2*zgpst(:))-exp(zgps(:)))/zdelt <a name="l04276"></a>04276 zgps(:)=psurf*exp(zgps(:))+zdelt*zgpst(:) <a name="l04277"></a>04277 zgtt(:,:)=ct*ww*zgtt(:,:) <a name="l04278"></a>04278 <span class="keyword">do</span> jlev=1,NLEV <a name="l04279"></a>04279 zgt(:,jlev)=ct*(zgt(:,jlev)+t0(jlev)) <a name="l04280"></a>04280 <span class="keyword">enddo</span> <a name="l04281"></a>04281 <span class="comment">!</span> <a name="l04282"></a>04282 ztm(:)=0. <a name="l04283"></a>04283 penergy(:)=0. <a name="l04284"></a>04284 <span class="keyword">do</span> jlev=1,NLEV <a name="l04285"></a>04285 ztm(:)=ztm(:)+zgt(:,jlev)*dsigma(jlev) <a name="l04286"></a>04286 penergy(:)=penergy(:)+zgtt(:,jlev)*dsigma(jlev) <a name="l04287"></a>04287 <span class="keyword">enddo</span> <a name="l04288"></a>04288 penergy(:)=ztm(:)*zcp*zgpst(:)/ga & <a name="l04289"></a>04289 & +penergy(:)*zcp*zgps(:)/ga <a name="l04290"></a>04290 <span class="comment">!</span> <a name="l04291"></a>04291 return <a name="l04292"></a>04292 <span class="keyword"> end</span> <a name="l04293"></a>04293 <a name="l04294"></a>04294 <span class="comment">! ======================</span> <a name="l04295"></a>04295 <span class="comment">! SUBROUTINE MKENTRODIAG</span> <a name="l04296"></a>04296 <span class="comment">! ======================</span> <a name="l04297"></a>04297 <a name="l04298"></a><a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">04298</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(pst,pstt,psp,pentropy) <a name="l04299"></a>04299 use <span class="keywordflow">pumamod</span> <a name="l04300"></a>04300 <span class="comment">!</span> <a name="l04301"></a>04301 <span class="keywordtype">real</span> :: pst(NSPP,NLEV),pstt(NSPP,NLEV) <a name="l04302"></a>04302 <span class="keywordtype">real</span> :: psp(NSPP) <a name="l04303"></a>04303 <span class="keywordtype">real</span> :: pentropy(NHOR) <a name="l04304"></a>04304 <span class="comment">!</span> <a name="l04305"></a>04305 <span class="keywordtype">real</span> :: zsttf(NESP,NLEV),zstf(NESP,NLEV) <a name="l04306"></a>04306 <span class="keywordtype">real</span> :: zspf(NESP) <a name="l04307"></a>04307 <span class="keywordtype">real</span> :: zgtt(NHOR,NLEV),zgt(NHOR,NLEV) <a name="l04308"></a>04308 <span class="keywordtype">real</span> :: zgps(NHOR) <a name="l04309"></a>04309 <span class="comment">!</span> <a name="l04310"></a>04310 zcp=gascon/akap <a name="l04311"></a>04311 <span class="comment">!</span> <a name="l04312"></a>04312 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsttf,pstt,NLEV) <a name="l04313"></a>04313 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zstf,pst,NLEV) <a name="l04314"></a>04314 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,psp,1) <a name="l04315"></a>04315 <a name="l04316"></a>04316 <span class="keyword">do</span> jlev=1,NLEV <a name="l04317"></a>04317 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsttf(:,jlev),zgtt(:,jlev)) <a name="l04318"></a>04318 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zstf(:,jlev),zgt(:,jlev)) <a name="l04319"></a>04319 <span class="keyword">enddo</span> <a name="l04320"></a>04320 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zgps) <a name="l04321"></a>04321 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgtt,NLON,NLPP*NLEV) <a name="l04322"></a>04322 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgt,NLON,NLPP*NLEV) <a name="l04323"></a>04323 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zgps,NLON,NLPP) <a name="l04324"></a>04324 zgps(:)=psurf*exp(zgps(:)) <a name="l04325"></a>04325 zgtt(:,:)=ct*ww*zgtt(:,:) <a name="l04326"></a>04326 <span class="keyword">do</span> jlev=1,NLEV <a name="l04327"></a>04327 zgt(:,jlev)=ct*(zgt(:,jlev)+t0(jlev)) <a name="l04328"></a>04328 <span class="keyword">enddo</span> <a name="l04329"></a>04329 <span class="comment">!</span> <a name="l04330"></a>04330 pentropy(:)=0. <a name="l04331"></a>04331 <span class="keyword">do</span> jlev=1,NLEV <a name="l04332"></a>04332 pentropy(:)=pentropy(:)+zgtt(:,jlev)*dsigma(jlev)/zgt(:,jlev) <a name="l04333"></a>04333 <span class="keyword">enddo</span> <a name="l04334"></a>04334 pentropy(:)=pentropy(:)*zcp*zgps(:)/ga <a name="l04335"></a>04335 <span class="comment">!</span> <a name="l04336"></a>04336 return <a name="l04337"></a>04337 <span class="keyword"> end</span> <a name="l04338"></a>04338 <a name="l04339"></a>04339 <span class="comment">! ==================</span> <a name="l04340"></a>04340 <span class="comment">! SUBROUTINE MKDHEAT</span> <a name="l04341"></a>04341 <span class="comment">! ==================</span> <a name="l04342"></a>04342 <a name="l04343"></a><a class="code" href="puma_8f90.html#a079a9ea6caa3eb9d5ef5e0c82f76a2b9">04343</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a079a9ea6caa3eb9d5ef5e0c82f76a2b9">mkdheat</a>(zszt1,zszt2,zsdt1,zsdt2,zsp) <a name="l04344"></a>04344 use <span class="keywordflow">pumamod</span> <a name="l04345"></a>04345 <span class="comment">!</span> <a name="l04346"></a>04346 <span class="comment">! 'recycle' kin. energy loss by heating the environment</span> <a name="l04347"></a>04347 <span class="comment">!</span> <a name="l04348"></a>04348 <span class="comment">! zszt1/zsdt1 : vorticity/divergence tendency due to friction</span> <a name="l04349"></a>04349 <span class="comment">! zszt2/zsdt2 : vorticity/divergence tendency fue to diffusion </span> <a name="l04350"></a>04350 <span class="comment">! zp : surface pressure</span> <a name="l04351"></a>04351 <span class="comment">!</span> <a name="l04352"></a>04352 <span class="keywordtype">real</span> zszt1(NSPP,NLEV),zszt2(NSPP,NLEV) <a name="l04353"></a>04353 <span class="keywordtype">real</span> zsdt1(NSPP,NLEV),zsdt2(NSPP,NLEV) <a name="l04354"></a>04354 <span class="keywordtype">real</span> zsp(NSPP) <a name="l04355"></a>04355 <span class="keywordtype">real</span> zp(NHOR) <a name="l04356"></a>04356 <span class="comment">!</span> <a name="l04357"></a>04357 <span class="keywordtype">real</span> zsd(NESP,NLEV),zsz(NESP,NLEV) <a name="l04358"></a>04358 <span class="keywordtype">real</span> zspf(NESP),zspt(NSPP) <a name="l04359"></a>04359 <span class="keywordtype">real</span> zsdp(NSPP,NLEV),zszp(NSPP,NLEV) <a name="l04360"></a>04360 <span class="keywordtype">real</span> zu(NHOR,NLEV),zun(NHOR,NLEV),zdu1(NHOR,NLEV),zdu2(NHOR,NLEV) <a name="l04361"></a>04361 <span class="keywordtype">real</span> zv(NHOR,NLEV),zvn(NHOR,NLEV),zdv1(NHOR,NLEV),zdv2(NHOR,NLEV) <a name="l04362"></a>04362 <span class="keywordtype">real</span> zdtdt1(NHOR,NLEV),zdtdt2(NHOR,NLEV),zdtdt3(NHOR,NLEV) <a name="l04363"></a>04363 <span class="comment">!</span> <a name="l04364"></a>04364 <span class="keywordtype">real</span> zdtdt(NHOR,NLEV),zdekin(NHOR,NLEV) <a name="l04365"></a>04365 <span class="comment">!</span> <a name="l04366"></a>04366 <span class="keywordtype">real</span> zsde(NSPP,NLEV),zsdef(NESP,NLEV) <a name="l04367"></a>04367 <span class="keywordtype">real</span> zstt(NSPP,NLEV),zstf(NESP,NLEV) <a name="l04368"></a>04368 <span class="keywordtype">real</span> zstt1(NSPP,NLEV),zstf1(NESP,NLEV),zstt3(NSPP,NLEV) <a name="l04369"></a>04369 <span class="keywordtype">real</span> zstt2(NSPP,NLEV),zstf2(NESP,NLEV),zstf3(NESP,NLEV) <a name="l04370"></a>04370 <span class="comment">!</span> <a name="l04371"></a>04371 <span class="comment">! some constants</span> <a name="l04372"></a>04372 <span class="comment">!</span> <a name="l04373"></a>04373 zdelt=delt2/ww <span class="comment">! timestep in s</span> <a name="l04374"></a>04374 zcp=gascon/akap <span class="comment">! heat capacity</span> <a name="l04375"></a>04375 <span class="comment">!</span> <a name="l04376"></a>04376 <span class="comment">! 'recycle' friction</span> <a name="l04377"></a>04377 <span class="comment">!</span> <a name="l04378"></a>04378 <span class="comment">! a) gather the 'partial' field of z and d, and make u and v </span> <a name="l04379"></a>04379 <span class="comment">! at old time level</span> <a name="l04380"></a>04380 <span class="comment">!</span> <a name="l04381"></a>04381 zsdp(:,:)=sdp(:,:) <a name="l04382"></a>04382 zszp(:,:)=szp(:,:) <a name="l04383"></a>04383 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV) <a name="l04384"></a>04384 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV) <a name="l04385"></a>04385 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04386"></a>04386 call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zu(1,jlev),zv(1,jlev)) <a name="l04387"></a>04387 <span class="keyword">enddo</span> <a name="l04388"></a>04388 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zu,NLON,NLPP*NLEV) <a name="l04389"></a>04389 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zv,NLON,NLPP*NLEV) <a name="l04390"></a>04390 <span class="comment">!</span> <a name="l04391"></a>04391 <span class="comment">! b) add fricton tendencies and create new u and v</span> <a name="l04392"></a>04392 <span class="comment">!</span> <a name="l04393"></a>04393 zsdp(:,:)=sdp(:,:)+zsdt1(:,:)*delt2 <a name="l04394"></a>04394 zszp(:,:)=szp(:,:)+zszt1(:,:)*delt2 <a name="l04395"></a>04395 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV) <a name="l04396"></a>04396 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV) <a name="l04397"></a>04397 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04398"></a>04398 call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zun(1,jlev),zvn(1,jlev)) <a name="l04399"></a>04399 <span class="keyword">enddo</span> <a name="l04400"></a>04400 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zun,NLON,NLPP*NLEV) <a name="l04401"></a>04401 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zvn,NLON,NLPP*NLEV) <a name="l04402"></a>04402 <span class="comment">!</span> <a name="l04403"></a>04403 <span class="comment">! c) compute temperature tendency</span> <a name="l04404"></a>04404 <span class="comment">!</span> <a name="l04405"></a>04405 <span class="keyword">do</span> jlev=1,NLEV <a name="l04406"></a>04406 zu(:,jlev)=cv*zu(:,jlev)*SQRT(rcsq(:)) <a name="l04407"></a>04407 zv(:,jlev)=cv*zv(:,jlev)*SQRT(rcsq(:)) <a name="l04408"></a>04408 zun(:,jlev)=cv*zun(:,jlev)*SQRT(rcsq(:)) <a name="l04409"></a>04409 zvn(:,jlev)=cv*zvn(:,jlev)*SQRT(rcsq(:)) <a name="l04410"></a>04410 zdu1(:,jlev)=zun(:,jlev)-zu(:,jlev) <a name="l04411"></a>04411 zdv1(:,jlev)=zvn(:,jlev)-zv(:,jlev) <a name="l04412"></a>04412 zdtdt1(:,jlev)=-(zun(:,jlev)*zun(:,jlev) & <a name="l04413"></a>04413 & -zu(:,jlev)*zu(:,jlev) & <a name="l04414"></a>04414 & +zvn(:,jlev)*zvn(:,jlev) & <a name="l04415"></a>04415 & -zv(:,jlev)*zv(:,jlev))*0.5/zdelt/zcp <a name="l04416"></a>04416 <span class="keyword">enddo</span> <a name="l04417"></a>04417 <a name="l04418"></a>04418 <span class="comment">!</span> <a name="l04419"></a>04419 <span class="comment">! 'recycle' momentum diffusion </span> <a name="l04420"></a>04420 <span class="comment">! </span> <a name="l04421"></a>04421 <span class="comment">! a) add tendencies and create new u and v and get surface pressure</span> <a name="l04422"></a>04422 <span class="comment">!</span> <a name="l04423"></a>04423 <span class="comment">!</span> <a name="l04424"></a>04424 zsdp(:,:)=sdp(:,:)+zsdt2(:,:)*delt2 <a name="l04425"></a>04425 zszp(:,:)=szp(:,:)+zszt2(:,:)*delt2 <a name="l04426"></a>04426 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV) <a name="l04427"></a>04427 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV) <a name="l04428"></a>04428 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zspf,zsp,1) <a name="l04429"></a>04429 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04430"></a>04430 call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zun(1,jlev),zvn(1,jlev)) <a name="l04431"></a>04431 <span class="keyword">enddo</span> <a name="l04432"></a>04432 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zun,NLON,NLPP*NLEV) <a name="l04433"></a>04433 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zvn,NLON,NLPP*NLEV) <a name="l04434"></a>04434 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zspf,zp) <a name="l04435"></a>04435 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zp,NLON,NLPP) <a name="l04436"></a>04436 zp(:)=psurf*exp(zp(:)) <a name="l04437"></a>04437 <span class="comment">!</span> <a name="l04438"></a>04438 <span class="comment">! b) compute loss of kinetic energy</span> <a name="l04439"></a>04439 <span class="comment">! (note: only the global average change of kin. e. is 'lost'</span> <a name="l04440"></a>04440 <span class="comment">! the other changes are just diffusion)</span> <a name="l04441"></a>04441 <span class="comment">!</span> <a name="l04442"></a>04442 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04443"></a>04443 zun(:,jlev)=cv*zun(:,jlev)*SQRT(rcsq(:)) <a name="l04444"></a>04444 zvn(:,jlev)=cv*zvn(:,jlev)*SQRT(rcsq(:)) <a name="l04445"></a>04445 zdu2(:,jlev)=zun(:,jlev)-zu(:,jlev) <a name="l04446"></a>04446 zdv2(:,jlev)=zvn(:,jlev)-zv(:,jlev) <a name="l04447"></a>04447 zdekin(:,jlev)=(zun(:,jlev)*zun(:,jlev) & <a name="l04448"></a>04448 & -zu(:,jlev)*zu(:,jlev) & <a name="l04449"></a>04449 & +zvn(:,jlev)*zvn(:,jlev) & <a name="l04450"></a>04450 & -zv(:,jlev)*zv(:,jlev))*0.5/zdelt & <a name="l04451"></a>04451 & *zp(:)/ga*dsigma(jlev) <a name="l04452"></a>04452 <span class="keyword">enddo</span> <a name="l04453"></a>04453 <span class="comment">!</span> <a name="l04454"></a>04454 <span class="comment">! c) get the global average and transform it back</span> <a name="l04455"></a>04455 <span class="comment">!</span> <a name="l04456"></a>04456 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdekin,NLON,NLPP*NLEV) <a name="l04457"></a>04457 <span class="keyword">do</span> jlev=1,NLEV <a name="l04458"></a>04458 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdekin(:,jlev),zsdef(:,jlev)) <a name="l04459"></a>04459 <span class="keyword">enddo</span> <a name="l04460"></a>04460 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zsdef,zsde,NLEV) <a name="l04461"></a>04461 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsdef,zsde,NLEV) <a name="l04462"></a>04462 zsdef(2:NESP,:)=0. <a name="l04463"></a>04463 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04464"></a>04464 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsdef(1,jlev),zdekin(1,jlev)) <a name="l04465"></a>04465 <span class="keyword">enddo</span> <a name="l04466"></a>04466 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zdekin,NLON,NLPP*NLEV) <a name="l04467"></a>04467 <span class="comment">!</span> <a name="l04468"></a>04468 <span class="comment">! d) compute temperature tendency</span> <a name="l04469"></a>04469 <span class="comment">!</span> <a name="l04470"></a>04470 <span class="keyword">do</span> jlev=1,NLEV <a name="l04471"></a>04471 zdtdt2(:,jlev)=-zdekin(:,jlev)*ga/zp(:)/dsigma(jlev)/zcp <a name="l04472"></a>04472 zdtdt3(:,jlev)=-(zdu1(:,jlev)*zdu2(:,jlev) & <a name="l04473"></a>04473 & +zdv1(:,jlev)*zdv2(:,jlev))/zdelt/zcp <a name="l04474"></a>04474 <span class="keyword">enddo</span> <a name="l04475"></a>04475 <span class="comment">!</span> <a name="l04476"></a>04476 zdtdt1(:,:)=zdtdt1(:,:)/ct/ww <a name="l04477"></a>04477 zdtdt2(:,:)=zdtdt2(:,:)/ct/ww <a name="l04478"></a>04478 zdtdt3(:,:)=zdtdt3(:,:)/ct/ww <a name="l04479"></a>04479 <span class="comment">!</span> <a name="l04480"></a>04480 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdtdt1,NLON,NLPP*NLEV) <a name="l04481"></a>04481 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdtdt2,NLON,NLPP*NLEV) <a name="l04482"></a>04482 call <a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(zdtdt3,NLON,NLPP*NLEV) <a name="l04483"></a>04483 <span class="keyword">do</span> jlev=1,NLEV <a name="l04484"></a>04484 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdtdt1(:,jlev),zstf1(:,jlev)) <a name="l04485"></a>04485 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdtdt2(:,jlev),zstf2(:,jlev)) <a name="l04486"></a>04486 call <a class="code" href="legsym_8f90.html#a04d46a94caf6c743547ac25cfa3058d4">fc2sp</a>(zdtdt3(:,jlev),zstf3(:,jlev)) <a name="l04487"></a>04487 <span class="keyword">enddo</span> <a name="l04488"></a>04488 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf1,zstt1,NLEV) <a name="l04489"></a>04489 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf2,zstt2,NLEV) <a name="l04490"></a>04490 call <a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(zstf3,zstt3,NLEV) <a name="l04491"></a>04491 <span class="comment">!</span> <a name="l04492"></a>04492 <span class="comment">! add the temprature tendencies</span> <a name="l04493"></a>04493 <span class="comment">!</span> <a name="l04494"></a>04494 stt(:,:)=stt(:,:)+zstt1(:,:)+zstt2(:,:)+zstt3(:,:) <a name="l04495"></a>04495 <span class="comment">!</span> <a name="l04496"></a>04496 <span class="comment">! energy diagnostics</span> <a name="l04497"></a>04497 <span class="comment">!</span> <a name="l04498"></a>04498 <span class="keyword">if</span>(nenergy > 0) <span class="keyword">then</span> <a name="l04499"></a>04499 zspt(:)=0. <a name="l04500"></a>04500 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstt1,zsp,zspt,denergy(:,5)) <a name="l04501"></a>04501 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstt2,zsp,zspt,denergy(:,6)) <a name="l04502"></a>04502 call <a class="code" href="puma_8f90.html#a4f476f8f243b066b52526d1a2696b48f">mkenerdiag</a>(stp,zstt3,zsp,zspt,denergy(:,7)) <a name="l04503"></a>04503 <span class="keyword">endif</span> <a name="l04504"></a>04504 <span class="keyword">if</span>(nentropy > 0) <span class="keyword">then</span> <a name="l04505"></a>04505 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstt1,zsp,dentropy(:,5)) <a name="l04506"></a>04506 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstt2,zsp,dentropy(:,6)) <a name="l04507"></a>04507 call <a class="code" href="puma_8f90.html#a36962178b35132627d3f0c4a2b816a92">mkentrodiag</a>(stp,zstt3,zsp,dentropy(:,7)) <a name="l04508"></a>04508 <span class="keyword">endif</span> <a name="l04509"></a>04509 <a name="l04510"></a>04510 <span class="comment">!</span> <a name="l04511"></a>04511 return <a name="l04512"></a>04512 <span class="keyword"> end subroutine mkdheat</span> <a name="l04513"></a>04513 <a name="l04514"></a>04514 <span class="comment">! =================</span> <a name="l04515"></a>04515 <span class="comment">! SUBROUTINE MKEKIN</span> <a name="l04516"></a>04516 <span class="comment">! =================</span> <a name="l04517"></a>04517 <a name="l04518"></a><a class="code" href="puma_8f90.html#a30cefc96eb08dde625692abb8eae576e">04518</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a30cefc96eb08dde625692abb8eae576e">mkekin</a>(zszp,zsdp,zp,zekin) <a name="l04519"></a>04519 use <span class="keywordflow">pumamod</span> <a name="l04520"></a>04520 <span class="comment">!</span> <a name="l04521"></a>04521 <span class="keywordtype">real</span> zszp(NSPP,NLEV),zsdp(NSPP,NLEV) <a name="l04522"></a>04522 <span class="keywordtype">real</span> zp(NHOR),zekin(NHOR) <a name="l04523"></a>04523 <span class="comment">!</span> <a name="l04524"></a>04524 <span class="keywordtype">real</span> zsd(NESP,NLEV),zsz(NESP,NLEV) <a name="l04525"></a>04525 <span class="keywordtype">real</span> zu(NHOR,NLEV),zv(NHOR,NLEV) <a name="l04526"></a>04526 <span class="comment">!</span> <a name="l04527"></a>04527 <span class="comment">! some constants</span> <a name="l04528"></a>04528 <span class="comment">!</span> <a name="l04529"></a>04529 zdelt=delt2/ww <span class="comment">! timestep in s</span> <a name="l04530"></a>04530 zcp=gascon/akap <span class="comment">! heat capacity</span> <a name="l04531"></a>04531 <span class="comment">!</span> <a name="l04532"></a>04532 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV) <a name="l04533"></a>04533 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV) <a name="l04534"></a>04534 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04535"></a>04535 call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zu(1,jlev),zv(1,jlev)) <a name="l04536"></a>04536 <span class="keyword">enddo</span> <a name="l04537"></a>04537 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zu,NLON,NLPP*NLEV) <a name="l04538"></a>04538 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zv,NLON,NLPP*NLEV) <a name="l04539"></a>04539 <span class="comment">!</span> <a name="l04540"></a>04540 zekin(:)=0. <a name="l04541"></a>04541 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04542"></a>04542 zu(:,jlev)=cv*zu(:,jlev)*SQRT(rcsq(:)) <a name="l04543"></a>04543 zv(:,jlev)=cv*zv(:,jlev)*SQRT(rcsq(:)) <a name="l04544"></a>04544 zekin(:)=(zu(:,jlev)*zu(:,jlev)+zv(:,jlev)*zv(:,jlev))*0.5 & <a name="l04545"></a>04545 & *zp(:)/ga*dsigma(jlev)+zekin(:) <a name="l04546"></a>04546 <span class="keyword">enddo</span> <a name="l04547"></a>04547 <span class="comment">!</span> <a name="l04548"></a>04548 return <a name="l04549"></a>04549 <span class="keyword"> end</span> <a name="l04550"></a><a class="code" href="puma_8f90.html#abc6f135f96d6f8c9636cef2d9c9dd796">04550</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#abc6f135f96d6f8c9636cef2d9c9dd796">mkekin2</a>(zszp,zsdp,zspp,zekin) <a name="l04551"></a>04551 use <span class="keywordflow">pumamod</span> <a name="l04552"></a>04552 <span class="comment">!</span> <a name="l04553"></a>04553 <span class="keywordtype">real</span> zszp(NSPP,NLEV),zsdp(NSPP,NLEV),zspp(NSPP) <a name="l04554"></a>04554 <span class="keywordtype">real</span> zp(NHOR),zekin(NHOR) <a name="l04555"></a>04555 <span class="comment">!</span> <a name="l04556"></a>04556 <span class="keywordtype">real</span> zsd(NESP,NLEV),zsz(NESP,NLEV),zsp(NESP) <a name="l04557"></a>04557 <span class="keywordtype">real</span> zu(NHOR,NLEV),zv(NHOR,NLEV) <a name="l04558"></a>04558 <span class="comment">!</span> <a name="l04559"></a>04559 <span class="comment">! some constants</span> <a name="l04560"></a>04560 <span class="comment">!</span> <a name="l04561"></a>04561 zdelt=delt2/ww <span class="comment">! timestep in s</span> <a name="l04562"></a>04562 zcp=gascon/akap <span class="comment">! heat capacity</span> <a name="l04563"></a>04563 <span class="comment">!</span> <a name="l04564"></a>04564 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsd,zsdp,NLEV) <a name="l04565"></a>04565 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsz,zszp,NLEV) <a name="l04566"></a>04566 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsp,zspp,NLEV) <a name="l04567"></a>04567 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04568"></a>04568 call <a class="code" href="legsym_8f90.html#af9cbedf7e87d9d5b2360c204237cc698">dv2uv</a>(zsd(1,jlev),zsz(1,jlev),zu(1,jlev),zv(1,jlev)) <a name="l04569"></a>04569 <span class="keyword">enddo</span> <a name="l04570"></a>04570 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsp,zp) <a name="l04571"></a>04571 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zu,NLON,NLPP*NLEV) <a name="l04572"></a>04572 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zv,NLON,NLPP*NLEV) <a name="l04573"></a>04573 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zp,NLON,NLPP) <a name="l04574"></a>04574 <span class="comment">!</span> <a name="l04575"></a>04575 zp(:)=psurf*exp(zp(:)) <a name="l04576"></a>04576 zekin(:)=0. <a name="l04577"></a>04577 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04578"></a>04578 zu(:,jlev)=cv*zu(:,jlev)*SQRT(rcsq(:)) <a name="l04579"></a>04579 zv(:,jlev)=cv*zv(:,jlev)*SQRT(rcsq(:)) <a name="l04580"></a>04580 zekin(:)=(zu(:,jlev)*zu(:,jlev)+zv(:,jlev)*zv(:,jlev))*0.5 & <a name="l04581"></a>04581 & *zp(:)/ga*dsigma(jlev)+zekin(:) <a name="l04582"></a>04582 <span class="keyword">enddo</span> <a name="l04583"></a>04583 <span class="comment">!</span> <a name="l04584"></a>04584 return <a name="l04585"></a>04585 <span class="keyword"> end</span> <a name="l04586"></a>04586 <a name="l04587"></a>04587 <a name="l04588"></a>04588 <span class="comment">! =================</span> <a name="l04589"></a>04589 <span class="comment">! SUBROUTINE MKEPOT</span> <a name="l04590"></a>04590 <span class="comment">! =================</span> <a name="l04591"></a>04591 <a name="l04592"></a><a class="code" href="puma_8f90.html#a0af984bd0f7283956290a0964e69cf0e">04592</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a0af984bd0f7283956290a0964e69cf0e">mkepot</a>(zstp,zp,zepot) <a name="l04593"></a>04593 use <span class="keywordflow">pumamod</span> <a name="l04594"></a>04594 <span class="comment">!</span> <a name="l04595"></a>04595 <span class="keywordtype">real</span> zstp(NSPP,NLEV) <a name="l04596"></a>04596 <span class="keywordtype">real</span> zp(NHOR),zepot(NHOR) <a name="l04597"></a>04597 <span class="comment">!</span> <a name="l04598"></a>04598 <span class="keywordtype">real</span> zst(NESP,NLEV) <a name="l04599"></a>04599 <span class="keywordtype">real</span> zt(NHOR,NLEV) <a name="l04600"></a>04600 <span class="comment">!</span> <a name="l04601"></a>04601 <span class="comment">! some constants</span> <a name="l04602"></a>04602 <span class="comment">!</span> <a name="l04603"></a>04603 zdelt=delt2/ww <span class="comment">! timestep in s</span> <a name="l04604"></a>04604 zcp=gascon/akap <span class="comment">! heat capacity</span> <a name="l04605"></a>04605 <span class="comment">!</span> <a name="l04606"></a>04606 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zst,zstp,NLEV) <a name="l04607"></a>04607 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04608"></a>04608 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zst(1,jlev),zt(1,jlev)) <a name="l04609"></a>04609 <span class="keyword">enddo</span> <a name="l04610"></a>04610 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zt,NLON,NLPP*NLEV) <a name="l04611"></a>04611 <span class="comment">!</span> <a name="l04612"></a>04612 zepot(:)=0. <a name="l04613"></a>04613 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04614"></a>04614 zt(:,jlev)=ct*(zt(:,jlev)+t0(jlev)) <a name="l04615"></a>04615 zepot(:)=zt(:,jlev)*zcp & <a name="l04616"></a>04616 & *zp(:)/ga*dsigma(jlev)+zepot(:) <a name="l04617"></a>04617 <span class="keyword">enddo</span> <a name="l04618"></a>04618 <span class="comment">!</span> <a name="l04619"></a>04619 return <a name="l04620"></a>04620 <span class="keyword"> end</span> <a name="l04621"></a><a class="code" href="puma_8f90.html#a23384f45e8ba553e7aaed8b22a9a80e8">04621</a> <span class="keyword">subroutine </span><a class="code" href="puma_8f90.html#a23384f45e8ba553e7aaed8b22a9a80e8">mkepot2</a>(zstp,zspp,zepot) <a name="l04622"></a>04622 use <span class="keywordflow">pumamod</span> <a name="l04623"></a>04623 <span class="comment">!</span> <a name="l04624"></a>04624 <span class="keywordtype">real</span> zstp(NSPP,NLEV),zspp(NSPP) <a name="l04625"></a>04625 <span class="keywordtype">real</span> zp(NHOR),zepot(NHOR) <a name="l04626"></a>04626 <span class="comment">!</span> <a name="l04627"></a>04627 <span class="keywordtype">real</span> zst(NESP,NLEV),zsp(NESP) <a name="l04628"></a>04628 <span class="keywordtype">real</span> zt(NHOR,NLEV) <a name="l04629"></a>04629 <span class="comment">!</span> <a name="l04630"></a>04630 <span class="comment">! some constants</span> <a name="l04631"></a>04631 <span class="comment">!</span> <a name="l04632"></a>04632 zdelt=delt2/ww <span class="comment">! timestep in s</span> <a name="l04633"></a>04633 zcp=gascon/akap <span class="comment">! heat capacity</span> <a name="l04634"></a>04634 <span class="comment">!</span> <a name="l04635"></a>04635 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zst,zstp,NLEV) <a name="l04636"></a>04636 call <a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(zsp,zspp,1) <a name="l04637"></a>04637 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04638"></a>04638 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zst(1,jlev),zt(1,jlev)) <a name="l04639"></a>04639 <span class="keyword">enddo</span> <a name="l04640"></a>04640 call <a class="code" href="legsym_8f90.html#aec404fc15930c6e4584c088a399ea099">sp2fc</a>(zsp,zp) <a name="l04641"></a>04641 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zt,NLON,NLPP*NLEV) <a name="l04642"></a>04642 call <a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(zp,NLON,NLPP) <a name="l04643"></a>04643 <span class="comment">!</span> <a name="l04644"></a>04644 zp(:)=psurf*exp(zp(:)) <a name="l04645"></a>04645 zepot(:)=0. <a name="l04646"></a>04646 <span class="keyword">do</span> jlev = 1 , NLEV <a name="l04647"></a>04647 zt(:,jlev)=ct*(zt(:,jlev)+t0(jlev)) <a name="l04648"></a>04648 zepot(:)=zt(:,jlev)*zcp & <a name="l04649"></a>04649 & *zp(:)/ga*dsigma(jlev)+zepot(:) <a name="l04650"></a>04650 <span class="keyword">enddo</span> <a name="l04651"></a>04651 <span class="comment">!</span> <a name="l04652"></a>04652 return <a name="l04653"></a>04653 <span class="keyword"> end</span> <a name="l04654"></a>04654 </pre></div></div> </div> <div id="nav-path" class="navpath"> <ul> <li class="navelem"><a class="el" href="puma_8f90.html">puma.f90</a> </li> <!-- window showing the filter options --> <div id="MSearchSelectWindow" onmouseover="return searchBox.OnSearchSelectShow()" onmouseout="return searchBox.OnSearchSelectHide()" onkeydown="return searchBox.OnSearchSelectKey(event)"> <a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(0)"><span class="SelectionMark"> </span>All</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(1)"><span class="SelectionMark"> </span>Classes</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(2)"><span class="SelectionMark"> </span>Files</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(3)"><span class="SelectionMark"> </span>Functions</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(4)"><span class="SelectionMark"> </span>Variables</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(5)"><span class="SelectionMark"> </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>