guimod_8f90_source.html 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497
  1. <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
  2. <html xmlns="http://www.w3.org/1999/xhtml">
  3. <head>
  4. <meta http-equiv="Content-Type" content="text/xhtml;charset=UTF-8"/>
  5. <title>PUMA: /Users/home/WC/puma/src/guimod.f90 Source File</title>
  6. <link href="tabs.css" rel="stylesheet" type="text/css"/>
  7. <link href="doxygen.css" rel="stylesheet" type="text/css" />
  8. <link href="navtree.css" rel="stylesheet" type="text/css"/>
  9. <script type="text/javascript" src="jquery.js"></script>
  10. <script type="text/javascript" src="resize.js"></script>
  11. <script type="text/javascript" src="navtree.js"></script>
  12. <script type="text/javascript">
  13. $(document).ready(initResizable);
  14. </script>
  15. <link href="search/search.css" rel="stylesheet" type="text/css"/>
  16. <script type="text/javascript" src="search/search.js"></script>
  17. <script type="text/javascript">
  18. $(document).ready(function() { searchBox.OnSelectItem(0); });
  19. </script>
  20. </head>
  21. <body>
  22. <div id="top"><!-- do not remove this div! -->
  23. <div id="titlearea">
  24. <table cellspacing="0" cellpadding="0">
  25. <tbody>
  26. <tr style="height: 56px;">
  27. <td id="projectlogo"><img alt="Logo" src="puma103.jpg"/></td>
  28. <td style="padding-left: 0.5em;">
  29. <div id="projectname">PUMA
  30. &#160;<span id="projectnumber">219</span>
  31. </div>
  32. <div id="projectbrief">Portable University Model of the Atmosphere</div>
  33. </td>
  34. </tr>
  35. </tbody>
  36. </table>
  37. </div>
  38. <!-- Generated by Doxygen 1.7.5.1 -->
  39. <script type="text/javascript">
  40. var searchBox = new SearchBox("searchBox", "search",false,'Search');
  41. </script>
  42. <div id="navrow1" class="tabs">
  43. <ul class="tablist">
  44. <li><a href="index.html"><span>Main&#160;Page</span></a></li>
  45. <li><a href="annotated.html"><span>Data&#160;Types&#160;List</span></a></li>
  46. <li class="current"><a href="files.html"><span>Files</span></a></li>
  47. <li>
  48. <div id="MSearchBox" class="MSearchBoxInactive">
  49. <span class="left">
  50. <img id="MSearchSelect" src="search/mag_sel.png"
  51. onmouseover="return searchBox.OnSearchSelectShow()"
  52. onmouseout="return searchBox.OnSearchSelectHide()"
  53. alt=""/>
  54. <input type="text" id="MSearchField" value="Search" accesskey="S"
  55. onfocus="searchBox.OnSearchFieldFocus(true)"
  56. onblur="searchBox.OnSearchFieldFocus(false)"
  57. onkeyup="searchBox.OnSearchFieldChange(event)"/>
  58. </span><span class="right">
  59. <a id="MSearchClose" href="javascript:searchBox.CloseResultsWindow()"><img id="MSearchCloseImg" border="0" src="search/close.png" alt=""/></a>
  60. </span>
  61. </div>
  62. </li>
  63. </ul>
  64. </div>
  65. <div id="navrow2" class="tabs2">
  66. <ul class="tablist">
  67. <li><a href="files.html"><span>File&#160;List</span></a></li>
  68. <li><a href="globals.html"><span>File&#160;Members</span></a></li>
  69. </ul>
  70. </div>
  71. </div>
  72. <div id="side-nav" class="ui-resizable side-nav-resizable">
  73. <div id="nav-tree">
  74. <div id="nav-tree-contents">
  75. </div>
  76. </div>
  77. <div id="splitbar" style="-moz-user-select:none;"
  78. class="ui-resizable-handle">
  79. </div>
  80. </div>
  81. <script type="text/javascript">
  82. initNavTree('guimod_8f90.html','');
  83. </script>
  84. <div id="doc-content">
  85. <div class="header">
  86. <div class="headertitle">
  87. <div class="title">/Users/home/WC/puma/src/guimod.f90</div> </div>
  88. </div>
  89. <div class="contents">
  90. <a href="guimod_8f90.html">Go to the documentation of this file.</a><div class="fragment"><pre class="fragment"><a name="l00001"></a>00001 <span class="comment">! ***************************************************</span>
  91. <a name="l00002"></a>00002 <span class="comment">! * GUIMOD - Graphical User Interface Routines *</span>
  92. <a name="l00003"></a>00003 <span class="comment">! * 21-Sep-2006 - Edilbert Kirk *</span>
  93. <a name="l00004"></a>00004 <span class="comment">! ***************************************************</span>
  94. <a name="l00005"></a>00005 <span class="comment">! * This file contains all interface routines for *</span>
  95. <a name="l00006"></a>00006 <span class="comment">! * communication between model (PUMA or PLASIM) *</span>
  96. <a name="l00007"></a>00007 <span class="comment">! * and the GUI routines in file &quot;pumax.c&quot;. *</span>
  97. <a name="l00008"></a>00008 <span class="comment">! * This file is identical for both models, if you *</span>
  98. <a name="l00009"></a>00009 <span class="comment">! * make changes, make sure, that these either *</span>
  99. <a name="l00010"></a>00010 <span class="comment">! * affect both models in a proper way or use the *</span>
  100. <a name="l00011"></a>00011 <span class="comment">! * if (model == PUMA) ... endif *</span>
  101. <a name="l00012"></a>00012 <span class="comment">! * if (model == PLASIM) ... endif *</span>
  102. <a name="l00013"></a>00013 <span class="comment">! * statements. After changes copy the new version, *</span>
  103. <a name="l00014"></a>00014 <span class="comment">! * so that ../puma/src/guimod.f90 and *</span>
  104. <a name="l00015"></a>00015 <span class="comment">! * ../plasim/src/guimod.f90 are identical. *</span>
  105. <a name="l00016"></a>00016 <span class="comment">! ***************************************************</span>
  106. <a name="l00017"></a>00017
  107. <a name="l00018"></a><a class="code" href="guimod_8f90.html#a77235ccfbc718d5f8b1edc4be08aed03">00018</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a77235ccfbc718d5f8b1edc4be08aed03">guistart</a>
  108. <a name="l00019"></a>00019 use <span class="keywordflow">pumamod</span>
  109. <a name="l00020"></a>00020
  110. <a name="l00021"></a>00021 <span class="keyword">if</span> (ngui == 0) return
  111. <a name="l00022"></a>00022
  112. <a name="l00023"></a>00023 call <a class="code" href="pumax_8c.html#a1de39836b6c983abd5014eca3b58fb6b">initgui</a>(model,nguidbg,NLAT,mrpid,mrnum)
  113. <a name="l00024"></a>00024
  114. <a name="l00025"></a>00025 return
  115. <a name="l00026"></a>00026 <span class="keyword"> end subroutine guistart</span>
  116. <a name="l00027"></a>00027
  117. <a name="l00028"></a>00028 <span class="comment">! ==================</span>
  118. <a name="l00029"></a>00029 <span class="comment">! SUBROUTINE GUISTOP</span>
  119. <a name="l00030"></a>00030 <span class="comment">! ==================</span>
  120. <a name="l00031"></a>00031
  121. <a name="l00032"></a><a class="code" href="guimod_8f90.html#ad58ecd458338fd5891f0838eda94bb0c">00032</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#ad58ecd458338fd5891f0838eda94bb0c">guistop</a>
  122. <a name="l00033"></a>00033 use <span class="keywordflow">pumamod</span>
  123. <a name="l00034"></a>00034
  124. <a name="l00035"></a>00035 <span class="keyword">if</span> (mypid == NROOT .and. ngui &gt; 0) call <a class="code" href="pumax_8c.html#a5bcccf3b585aabc714dbb0e554817e11">guiclose</a>
  125. <a name="l00036"></a>00036
  126. <a name="l00037"></a>00037 return
  127. <a name="l00038"></a>00038 <span class="keyword"> end subroutine guistop</span>
  128. <a name="l00039"></a>00039
  129. <a name="l00040"></a>00040 <span class="comment">! =======================</span>
  130. <a name="l00041"></a>00041 <span class="comment">! SUBROUTINE GUISTEP_PUMA</span>
  131. <a name="l00042"></a>00042 <span class="comment">! =======================</span>
  132. <a name="l00043"></a>00043
  133. <a name="l00044"></a><a class="code" href="guimod_8f90.html#a71eb8e326967dca8aad8bc84d9f8ad72">00044</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a71eb8e326967dca8aad8bc84d9f8ad72">guistep_puma</a>
  134. <a name="l00045"></a>00045 use <span class="keywordflow">pumamod</span>
  135. <a name="l00046"></a>00046
  136. <a name="l00047"></a>00047 <span class="keyword">interface</span>
  137. <a name="l00048"></a>00048 <span class="keyword">integer(kind=4) </span><span class="keyword">function </span><a class="code" href="pumax_8c.html#a5379e44b382c3d382ad16a9b37d671bc">iguistep</a>(parc,idatim)
  138. <a name="l00049"></a>00049 <span class="keywordtype">real (kind=4)</span>, <span class="keywordtype">intent(inout)</span> :: parc(*)
  139. <a name="l00050"></a>00050 <span class="keywordtype">integer(kind=4)</span>, <span class="keywordtype">intent(in)</span> :: idatim(6)
  140. <a name="l00051"></a>00051 <span class="keyword"> end function iguistep</span>
  141. <a name="l00052"></a>00052 <span class="keyword"> end interface</span>
  142. <a name="l00053"></a>00053
  143. <a name="l00054"></a>00054 <span class="keywordtype">integer (kind=4)</span> idatim(6)
  144. <a name="l00055"></a>00055
  145. <a name="l00056"></a>00056 nsyncold = nsync
  146. <a name="l00057"></a>00057 call <a class="code" href="mpimod_8f90.html#a5d2bb9cfe68e5feb6de6b359f04398e3">mrsum</a>(nsyncold)
  147. <a name="l00058"></a>00058
  148. <a name="l00059"></a>00059 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  149. <a name="l00060"></a>00060 parc(1) = disp
  150. <a name="l00061"></a>00061 parc(2) = dtep * CT;
  151. <a name="l00062"></a>00062 parc(3) = dtns * CT;
  152. <a name="l00063"></a>00063 parc(4) = nsync
  153. <a name="l00064"></a>00064 parc(5) = syncstr
  154. <a name="l00065"></a>00065 crap(:) = parc(:)
  155. <a name="l00066"></a>00066 idatim(:) = <a class="code" href="pumax_8c.html#a5d9c6d601c3a2a89c6397da97ae235ff">ndatim</a>(:)
  156. <a name="l00067"></a>00067 nshutdown = <a class="code" href="pumax_8c.html#a5379e44b382c3d382ad16a9b37d671bc">iguistep</a>(parc,idatim) <span class="comment">! GUI event handler</span>
  157. <a name="l00068"></a>00068 <span class="keyword">if</span> (parc(1) /= crap(1)) call <a class="code" href="guimod_8f90.html#ae0cea97804c2be7b7859c380dd257af8">change_disp</a>(1)
  158. <a name="l00069"></a>00069 <span class="keyword">if</span> (parc(2) /= crap(2)) call <a class="code" href="guimod_8f90.html#a516b90b9b073743e6bc5b0ab88a9d24a">change_dtep</a>(2)
  159. <a name="l00070"></a>00070 <span class="keyword">if</span> (parc(3) /= crap(3)) call <a class="code" href="guimod_8f90.html#afb9135ea9ab544baed4b985f22d7c48c">change_dtns</a>(3)
  160. <a name="l00071"></a>00071 <span class="keyword">if</span> (parc(4) /= crap(4)) call <a class="code" href="guimod_8f90.html#a9cdcbb914041a07e5a9c69532ed73f29">change_nsync</a>(4)
  161. <a name="l00072"></a>00072 <span class="keyword">if</span> (parc(5) /= crap(5)) call <a class="code" href="guimod_8f90.html#a18cd245f5484e061fd59c6d0ce976283">change_syncstr</a>(5)
  162. <a name="l00073"></a>00073 <span class="keyword">endif</span>
  163. <a name="l00074"></a>00074
  164. <a name="l00075"></a>00075 call <a class="code" href="mpimod_8f90.html#a5d2bb9cfe68e5feb6de6b359f04398e3">mrsum</a>(nshutdown) <span class="comment">! Any instance can signal shutdown</span>
  165. <a name="l00076"></a>00076 call <a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(nshutdown)
  166. <a name="l00077"></a>00077 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(disp)
  167. <a name="l00078"></a>00078
  168. <a name="l00079"></a>00079 nsyncnew = nsync
  169. <a name="l00080"></a>00080 call <a class="code" href="mpimod_8f90.html#a5d2bb9cfe68e5feb6de6b359f04398e3">mrsum</a>(nsyncnew) <span class="comment">! Any instance can switch NSYNC</span>
  170. <a name="l00081"></a>00081 <span class="keyword">if</span> (nsyncnew &gt; nsyncold) nsync = 1
  171. <a name="l00082"></a>00082 <span class="keyword">if</span> (nsyncnew &lt; nsyncold) nsync = 0
  172. <a name="l00083"></a>00083
  173. <a name="l00084"></a>00084 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(ldtep)
  174. <a name="l00085"></a>00085 <span class="keyword">if</span> (ldtep) <span class="keyword">then</span>
  175. <a name="l00086"></a>00086 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtep) <span class="comment">! broadcast changed value</span>
  176. <a name="l00087"></a>00087 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sr1,srp1,NLEV) <span class="comment">! scatter changed array</span>
  177. <a name="l00088"></a>00088 ldtep = .false.
  178. <a name="l00089"></a>00089 <span class="keyword">endif</span>
  179. <a name="l00090"></a>00090
  180. <a name="l00091"></a>00091 call <a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(ldtns)
  181. <a name="l00092"></a>00092 <span class="keyword">if</span> (ldtns) <span class="keyword">then</span>
  182. <a name="l00093"></a>00093 call <a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(dtns) <span class="comment">! broadcast changed value</span>
  183. <a name="l00094"></a>00094 call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(sr2,srp2,NLEV) <span class="comment">! scatter changed array</span>
  184. <a name="l00095"></a>00095 ldtns = .false.
  185. <a name="l00096"></a>00096 <span class="keyword">endif</span>
  186. <a name="l00097"></a>00097
  187. <a name="l00098"></a>00098 return
  188. <a name="l00099"></a>00099 <span class="keyword"> end subroutine guistep_puma</span>
  189. <a name="l00100"></a>00100
  190. <a name="l00101"></a>00101 <span class="comment">! ================</span>
  191. <a name="l00102"></a>00102 <span class="comment">! SUBROUTINE GUIPS</span>
  192. <a name="l00103"></a>00103 <span class="comment">! ================</span>
  193. <a name="l00104"></a>00104
  194. <a name="l00105"></a><a class="code" href="guimod_8f90.html#aef8771e5b34f33e37c1370ac60c41aea">00105</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#aef8771e5b34f33e37c1370ac60c41aea">guips</a>(f,pmean)
  195. <a name="l00106"></a>00106 use <span class="keywordflow">pumamod</span>
  196. <a name="l00107"></a>00107 <span class="keywordtype">real</span> :: f(NLON,NLAT)
  197. <a name="l00108"></a>00108 <span class="keywordtype">real</span> :: z(NLON,NLAT)
  198. <a name="l00109"></a>00109 <span class="keywordtype">real (kind=4)</span> :: x(NLON+1,NLAT)
  199. <a name="l00110"></a>00110
  200. <a name="l00111"></a>00111 <span class="keyword">if</span> (ngui == 0) return
  201. <a name="l00112"></a>00112 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  202. <a name="l00113"></a>00113 z(:,:) = f(:,:)
  203. <a name="l00114"></a>00114 call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(z,1)
  204. <a name="l00115"></a>00115 mlon = NLON/2
  205. <a name="l00116"></a>00116 pm = pmean * 0.01 <span class="comment">! [hPa]</span>
  206. <a name="l00117"></a>00117 x( 1:mlon ,:) = z(mlon+1:NLON ,:) * pm
  207. <a name="l00118"></a>00118 x(mlon+1:NLON+1,:) = z( 1:mlon+1,:) * pm
  208. <a name="l00119"></a>00119 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;GP&quot;</span> // char(0) ,x,NLON+1,NLAT,1)
  209. <a name="l00120"></a>00120 <span class="keyword">endif</span>
  210. <a name="l00121"></a>00121 return
  211. <a name="l00122"></a>00122 <span class="keyword"> end</span>
  212. <a name="l00123"></a>00123
  213. <a name="l00124"></a>00124 <span class="comment">! =================</span>
  214. <a name="l00125"></a>00125 <span class="comment">! SUBROUTINE GUIHOR</span>
  215. <a name="l00126"></a>00126 <span class="comment">! =================</span>
  216. <a name="l00127"></a>00127
  217. <a name="l00128"></a><a class="code" href="guimod_8f90.html#a5fb6afdefec3591f4c43bc2af44ebe46">00128</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a5fb6afdefec3591f4c43bc2af44ebe46">guihor</a>(yname,f,klev,pm,pa)
  218. <a name="l00129"></a>00129 use <span class="keywordflow">pumamod</span>
  219. <a name="l00130"></a>00130 <span class="keywordtype">character (len=*)</span> :: yname
  220. <a name="l00131"></a>00131 <span class="keywordtype">real</span> :: f(NLON,NLPP,klev)
  221. <a name="l00132"></a>00132 <span class="keywordtype">real</span> :: z(NLON,NLAT,klev)
  222. <a name="l00133"></a>00133 <span class="keywordtype">real (kind=4)</span> :: x(NLON+1,NLAT,klev)
  223. <a name="l00134"></a>00134
  224. <a name="l00135"></a>00135 <span class="keyword">if</span> (ngui == 0) return
  225. <a name="l00136"></a>00136
  226. <a name="l00137"></a>00137 <span class="comment">! Incoming array f stores longitudes from 0 deg to (360 - delta lambda)</span>
  227. <a name="l00138"></a>00138 <span class="comment">! GUI gets rotated array x stored from -180 deg to +180 deg</span>
  228. <a name="l00139"></a>00139
  229. <a name="l00140"></a>00140 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,f,klev)
  230. <a name="l00141"></a>00141 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  231. <a name="l00142"></a>00142 mlon = NLON/2
  232. <a name="l00143"></a>00143 x( 1:mlon ,:,:) = z(mlon+1:NLON ,:,:) * pm + pa
  233. <a name="l00144"></a>00144 x(mlon+1:NLON+1,:,:) = z( 1:mlon+1,:,:) * pm + pa
  234. <a name="l00145"></a>00145 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(yname,x,NLON+1,NLAT,klev)
  235. <a name="l00146"></a>00146 <span class="keyword">endif</span>
  236. <a name="l00147"></a>00147 return
  237. <a name="l00148"></a>00148 <span class="keyword"> end</span>
  238. <a name="l00149"></a>00149
  239. <a name="l00150"></a>00150 <span class="comment">! ================</span>
  240. <a name="l00151"></a>00151 <span class="comment">! SUBROUTINE GUIGV</span>
  241. <a name="l00152"></a>00152 <span class="comment">! ================</span>
  242. <a name="l00153"></a>00153
  243. <a name="l00154"></a><a class="code" href="guimod_8f90.html#ad4f84b3b48dfc55519b6072ba9a62e97">00154</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#ad4f84b3b48dfc55519b6072ba9a62e97">guigv</a>(yname,f)
  244. <a name="l00155"></a>00155 use <span class="keywordflow">pumamod</span>
  245. <a name="l00156"></a>00156 <span class="keywordtype">character (len=*)</span> :: yname
  246. <a name="l00157"></a>00157 <span class="keywordtype">real</span> :: f(NLON,NLPP,NLEV)
  247. <a name="l00158"></a>00158 <span class="keywordtype">real</span> :: z(NLON,NLAT,NLEV)
  248. <a name="l00159"></a>00159 <span class="keywordtype">real (kind=4)</span> :: x(NLON+1,NLAT,NLEV)
  249. <a name="l00160"></a>00160
  250. <a name="l00161"></a>00161 <span class="keyword">if</span> (ngui == 0) return
  251. <a name="l00162"></a>00162
  252. <a name="l00163"></a>00163 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,f,NLEV)
  253. <a name="l00164"></a>00164 <span class="keyword">if</span> (model == <a class="code" href="pumax_8c.html#a7c5db3163704e174dd734f55fdc698e9">PUMA</a>) call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(z,NLEV)
  254. <a name="l00165"></a>00165 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  255. <a name="l00166"></a>00166 mlon = NLON/2
  256. <a name="l00167"></a>00167 <span class="keyword">do</span> jlat = 1 , NLAT
  257. <a name="l00168"></a>00168 x( 1:mlon ,jlat,:) = z(mlon+1:NLON ,jlat,:) * CV * rcs(jlat)
  258. <a name="l00169"></a>00169 x(mlon+1:NLON+1,jlat,:) = z( 1:mlon+1,jlat,:) * CV * rcs(jlat)
  259. <a name="l00170"></a>00170 <span class="keyword">enddo</span>
  260. <a name="l00171"></a>00171 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(yname,x,NLON+1,NLAT,NLEV)
  261. <a name="l00172"></a>00172 <span class="keyword">endif</span>
  262. <a name="l00173"></a>00173 return
  263. <a name="l00174"></a>00174 <span class="keyword"> end</span>
  264. <a name="l00175"></a>00175
  265. <a name="l00176"></a>00176 <span class="comment">! ================</span>
  266. <a name="l00177"></a>00177 <span class="comment">! SUBROUTINE GUIGT</span>
  267. <a name="l00178"></a>00178 <span class="comment">! ================</span>
  268. <a name="l00179"></a>00179
  269. <a name="l00180"></a><a class="code" href="guimod_8f90.html#a043a85f7d43cabc1814465b055b8da18">00180</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a043a85f7d43cabc1814465b055b8da18">guigt</a>(f)
  270. <a name="l00181"></a>00181 use <span class="keywordflow">pumamod</span>
  271. <a name="l00182"></a>00182 <span class="keywordtype">real</span> :: f(NLON,NLPP,NLEV)
  272. <a name="l00183"></a>00183 <span class="keywordtype">real</span> :: z(NLON,NLAT,NLEV)
  273. <a name="l00184"></a>00184 <span class="keywordtype">real (kind=4)</span> :: x(NLON+1,NLAT,NLEV)
  274. <a name="l00185"></a>00185
  275. <a name="l00186"></a>00186 <span class="keyword">if</span> (ngui == 0) return
  276. <a name="l00187"></a>00187
  277. <a name="l00188"></a>00188 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,f,NLEV)
  278. <a name="l00189"></a>00189 <span class="keyword">if</span> (model == <a class="code" href="pumax_8c.html#a7c5db3163704e174dd734f55fdc698e9">PUMA</a>) call <a class="code" href="legsym_8f90.html#a308819246e409c8dbe1e778d304ef415">alt2reg</a>(z,NLEV)
  279. <a name="l00190"></a>00190 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  280. <a name="l00191"></a>00191 mlon = NLON/2
  281. <a name="l00192"></a>00192 <span class="keyword">do</span> jlon = 1 , mlon
  282. <a name="l00193"></a>00193 <span class="keyword">do</span> jlat = 1 , NLAT
  283. <a name="l00194"></a>00194 x(jlon,jlat,:) = (z(jlon+mlon,jlat,:) + t0(:))*CT - 273.16
  284. <a name="l00195"></a>00195 <span class="keyword">enddo</span>
  285. <a name="l00196"></a>00196 <span class="keyword">enddo</span>
  286. <a name="l00197"></a>00197 <span class="keyword">do</span> jlon = mlon+1,NLON+1
  287. <a name="l00198"></a>00198 <span class="keyword">do</span> jlat = 1 , NLAT
  288. <a name="l00199"></a>00199 x(jlon,jlat,:) = (z(jlon-mlon,jlat,:) + t0(:))*CT - 273.16
  289. <a name="l00200"></a>00200 <span class="keyword">enddo</span>
  290. <a name="l00201"></a>00201 <span class="keyword">enddo</span>
  291. <a name="l00202"></a>00202 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;GT&quot;</span> // char(0),x,NLON+1,NLAT,NLEV)
  292. <a name="l00203"></a>00203 <span class="keyword">endif</span>
  293. <a name="l00204"></a>00204 return
  294. <a name="l00205"></a>00205 <span class="keyword"> end</span>
  295. <a name="l00206"></a>00206
  296. <a name="l00207"></a>00207 <span class="comment">! ===================</span>
  297. <a name="l00208"></a>00208 <span class="comment">! SUBROUTINE GUIGVCOL</span>
  298. <a name="l00209"></a>00209 <span class="comment">! ===================</span>
  299. <a name="l00210"></a>00210
  300. <a name="l00211"></a><a class="code" href="guimod_8f90.html#a249e53720a2c0cb09cd60f233c4d05e2">00211</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a249e53720a2c0cb09cd60f233c4d05e2">guigvcol</a>(yname,f,klon)
  301. <a name="l00212"></a>00212 use <span class="keywordflow">pumamod</span>
  302. <a name="l00213"></a>00213 <span class="keywordtype">character (len=*)</span> :: yname
  303. <a name="l00214"></a>00214 <span class="keywordtype">real</span> :: f(NLON,NLPP,NLEV)
  304. <a name="l00215"></a>00215 <span class="keywordtype">real</span> :: z(NLON,NLAT,NLEV)
  305. <a name="l00216"></a>00216 <span class="keywordtype">real (kind=4)</span> :: x(NLEV,NLAT)
  306. <a name="l00217"></a>00217
  307. <a name="l00218"></a>00218 <span class="keyword">if</span> (ngui == 0) return
  308. <a name="l00219"></a>00219
  309. <a name="l00220"></a>00220 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,f,NLEV)
  310. <a name="l00221"></a>00221 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  311. <a name="l00222"></a>00222 <span class="keyword">do</span> jlat = 1 , NLAT
  312. <a name="l00223"></a>00223 <span class="keyword">do</span> jlev = 1 , NLEV
  313. <a name="l00224"></a>00224 x(jlev,jlat) = z(klon,jlat,jlev) * CV * rcs(jlat)
  314. <a name="l00225"></a>00225 <span class="keyword">enddo</span>
  315. <a name="l00226"></a>00226 <span class="keyword">enddo</span>
  316. <a name="l00227"></a>00227 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(yname,x,NLEV,NLAT,1)
  317. <a name="l00228"></a>00228 <span class="keyword">endif</span>
  318. <a name="l00229"></a>00229 return
  319. <a name="l00230"></a>00230 <span class="keyword"> end</span>
  320. <a name="l00231"></a>00231
  321. <a name="l00232"></a>00232 <span class="comment">! ===================</span>
  322. <a name="l00233"></a>00233 <span class="comment">! SUBROUTINE GUIGTCOL</span>
  323. <a name="l00234"></a>00234 <span class="comment">! ===================</span>
  324. <a name="l00235"></a>00235
  325. <a name="l00236"></a><a class="code" href="guimod_8f90.html#ace8d43f22cbf7e40a53710e26c358bb6">00236</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#ace8d43f22cbf7e40a53710e26c358bb6">guigtcol</a>(f,klon)
  326. <a name="l00237"></a>00237 use <span class="keywordflow">pumamod</span>
  327. <a name="l00238"></a>00238 <span class="keywordtype">real</span> :: f(NLON,NLPP,NLEV)
  328. <a name="l00239"></a>00239 <span class="keywordtype">real</span> :: z(NLON,NLAT,NLEV)
  329. <a name="l00240"></a>00240 <span class="keywordtype">real (kind=4)</span> :: x(NLEV,NLAT)
  330. <a name="l00241"></a>00241
  331. <a name="l00242"></a>00242 <span class="keyword">if</span> (ngui == 0) return
  332. <a name="l00243"></a>00243
  333. <a name="l00244"></a>00244 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,f,NLEV)
  334. <a name="l00245"></a>00245 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  335. <a name="l00246"></a>00246 <span class="keyword">do</span> jlat = 1 , NLAT
  336. <a name="l00247"></a>00247 <span class="keyword">do</span> jlev = 1 , NLEV
  337. <a name="l00248"></a>00248 x(jlev,jlat) = z(klon,jlat,jlev) - TMELT
  338. <a name="l00249"></a>00249 <span class="keyword">enddo</span>
  339. <a name="l00250"></a>00250 <span class="keyword">enddo</span>
  340. <a name="l00251"></a>00251 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(<span class="stringliteral">&quot;GTCOL&quot;</span> // char(0),x,NLEV,NLAT,1)
  341. <a name="l00252"></a>00252 <span class="keyword">endif</span>
  342. <a name="l00253"></a>00253 return
  343. <a name="l00254"></a>00254 <span class="keyword"> end</span>
  344. <a name="l00255"></a>00255
  345. <a name="l00256"></a>00256 <span class="comment">! ====================</span>
  346. <a name="l00257"></a>00257 <span class="comment">! SUBROUTINE GUID3DCOL</span>
  347. <a name="l00258"></a>00258 <span class="comment">! ====================</span>
  348. <a name="l00259"></a>00259
  349. <a name="l00260"></a><a class="code" href="guimod_8f90.html#a5fe23cf66c00091432f98e9338cc4eee">00260</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a5fe23cf66c00091432f98e9338cc4eee">guid3dcol</a>(yname,f,klon,klev,pm,pa)
  350. <a name="l00261"></a>00261 use <span class="keywordflow">pumamod</span>
  351. <a name="l00262"></a>00262 <span class="keywordtype">character (len=*)</span> :: yname
  352. <a name="l00263"></a>00263 <span class="keywordtype">real</span> :: f(NLON,NLPP,klev)
  353. <a name="l00264"></a>00264 <span class="keywordtype">real</span> :: z(NLON,NLAT,klev)
  354. <a name="l00265"></a>00265 <span class="keywordtype">real (kind=4)</span> :: x(NLEV,NLAT)
  355. <a name="l00266"></a>00266
  356. <a name="l00267"></a>00267 <span class="keyword">if</span> (ngui == 0) return
  357. <a name="l00268"></a>00268
  358. <a name="l00269"></a>00269 call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,f,klev)
  359. <a name="l00270"></a>00270 <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
  360. <a name="l00271"></a>00271 <span class="keyword">do</span> jlat = 1 , NLAT
  361. <a name="l00272"></a>00272 <span class="keyword">do</span> jlev = 1 , NLEV
  362. <a name="l00273"></a>00273 x(jlev,jlat) = z(klon,jlat,jlev)*pm + pa
  363. <a name="l00274"></a>00274 <span class="keyword">enddo</span>
  364. <a name="l00275"></a>00275 <span class="keyword">enddo</span>
  365. <a name="l00276"></a>00276 call <a class="code" href="guimod__stub_8f90.html#a246c916d08a954310ea15d64816db13b">guiput</a>(yname,x,NLEV,NLAT,1)
  366. <a name="l00277"></a>00277 <span class="keyword">endif</span>
  367. <a name="l00278"></a>00278 return
  368. <a name="l00279"></a>00279 <span class="keyword"> end</span>
  369. <a name="l00280"></a>00280
  370. <a name="l00281"></a>00281 <span class="comment">! =======================</span>
  371. <a name="l00282"></a>00282 <span class="comment">! SUBROUTINE CHANGE_NSYNC</span>
  372. <a name="l00283"></a>00283 <span class="comment">! =======================</span>
  373. <a name="l00284"></a>00284
  374. <a name="l00285"></a><a class="code" href="guimod_8f90.html#a9cdcbb914041a07e5a9c69532ed73f29">00285</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a9cdcbb914041a07e5a9c69532ed73f29">change_nsync</a>(k)
  375. <a name="l00286"></a>00286 use <span class="keywordflow">pumamod</span>
  376. <a name="l00287"></a>00287 <span class="keyword">write</span> (*,7000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;NSYNC&#39;</span>,crap(k),parc(k)
  377. <a name="l00288"></a>00288 nsync = parc(k) + 0.001
  378. <a name="l00289"></a>00289 return
  379. <a name="l00290"></a>00290 7000 format(<span class="stringliteral">&#39;Step&#39;</span>,i8,<span class="stringliteral">&#39;: User changed &#39;</span>,a,<span class="stringliteral">&#39; from &#39;</span>,f6.2,<span class="stringliteral">&#39; to &#39;</span>,f6.2)
  380. <a name="l00291"></a>00291 <span class="keyword"> end</span>
  381. <a name="l00292"></a>00292
  382. <a name="l00293"></a>00293 <span class="comment">! =========================</span>
  383. <a name="l00294"></a>00294 <span class="comment">! SUBROUTINE CHANGE_SYNCSTR</span>
  384. <a name="l00295"></a>00295 <span class="comment">! =========================</span>
  385. <a name="l00296"></a>00296
  386. <a name="l00297"></a><a class="code" href="guimod_8f90.html#a18cd245f5484e061fd59c6d0ce976283">00297</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a18cd245f5484e061fd59c6d0ce976283">change_syncstr</a>(k)
  387. <a name="l00298"></a>00298 use <span class="keywordflow">pumamod</span>
  388. <a name="l00299"></a>00299 <span class="keyword">write</span> (*,7000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;SYNCSTR&#39;</span>,crap(k),parc(k)
  389. <a name="l00300"></a>00300 syncstr = parc(k)
  390. <a name="l00301"></a>00301 return
  391. <a name="l00302"></a>00302 7000 format(<span class="stringliteral">&#39;Step&#39;</span>,i8,<span class="stringliteral">&#39;: User changed &#39;</span>,a,<span class="stringliteral">&#39; from &#39;</span>,f6.2,<span class="stringliteral">&#39; to &#39;</span>,f6.2)
  392. <a name="l00303"></a>00303 <span class="keyword"> end</span>
  393. <a name="l00304"></a>00304
  394. <a name="l00305"></a>00305 <span class="comment">! ======================</span>
  395. <a name="l00306"></a>00306 <span class="comment">! SUBROUTINE CHANGE_DISP</span>
  396. <a name="l00307"></a>00307 <span class="comment">! ======================</span>
  397. <a name="l00308"></a>00308
  398. <a name="l00309"></a><a class="code" href="guimod_8f90.html#ae0cea97804c2be7b7859c380dd257af8">00309</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#ae0cea97804c2be7b7859c380dd257af8">change_disp</a>(k)
  399. <a name="l00310"></a>00310 use <span class="keywordflow">pumamod</span>
  400. <a name="l00311"></a>00311 <span class="keyword">write</span> (*,7000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;DISP &#39;</span>,crap(k),parc(k)
  401. <a name="l00312"></a>00312 disp = parc(k)
  402. <a name="l00313"></a>00313 return
  403. <a name="l00314"></a>00314 7000 format(<span class="stringliteral">&#39;Step&#39;</span>,i8,<span class="stringliteral">&#39;: User changed &#39;</span>,a,<span class="stringliteral">&#39; from &#39;</span>,f6.2,<span class="stringliteral">&#39; to &#39;</span>,f6.2)
  404. <a name="l00315"></a>00315 <span class="keyword"> end</span>
  405. <a name="l00316"></a>00316
  406. <a name="l00317"></a>00317 <span class="comment">! ======================</span>
  407. <a name="l00318"></a>00318 <span class="comment">! SUBROUTINE CHANGE_DTEP</span>
  408. <a name="l00319"></a>00319 <span class="comment">! ======================</span>
  409. <a name="l00320"></a>00320
  410. <a name="l00321"></a><a class="code" href="guimod_8f90.html#a516b90b9b073743e6bc5b0ab88a9d24a">00321</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#a516b90b9b073743e6bc5b0ab88a9d24a">change_dtep</a>(k)
  411. <a name="l00322"></a>00322 use <span class="keywordflow">pumamod</span>
  412. <a name="l00323"></a>00323 <span class="keyword">write</span> (*,7000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;DTEP &#39;</span>,crap(k),parc(k)
  413. <a name="l00324"></a>00324 dtep = parc(k) / CT;
  414. <a name="l00325"></a>00325 zttrop = tgr-dtrop*ALR
  415. <a name="l00326"></a>00326 ztps = (zttrop/tgr)**(GA/(ALR*GASCON))
  416. <a name="l00327"></a>00327 <span class="keyword">do</span> jlev = 1 , NLEV
  417. <a name="l00328"></a>00328 zfac = sin(0.5*PI*(sigma(jlev)-ztps)/(1.-ztps))
  418. <a name="l00329"></a>00329 <span class="keyword">if</span> (zfac &lt; 0.0) zfac = 0.0
  419. <a name="l00330"></a>00330 sr1(5,jlev) = -2.0/3.0 * sqrt(0.4) * dtep * zfac
  420. <a name="l00331"></a>00331 <span class="keyword">enddo</span>
  421. <a name="l00332"></a>00332 ldtep = .true.
  422. <a name="l00333"></a>00333 return
  423. <a name="l00334"></a>00334 7000 format(<span class="stringliteral">&#39;Step&#39;</span>,i8,<span class="stringliteral">&#39;: User changed &#39;</span>,a,<span class="stringliteral">&#39; from &#39;</span>,f7.2,<span class="stringliteral">&#39; to &#39;</span>,f7.2)
  424. <a name="l00335"></a>00335 <span class="keyword"> end</span>
  425. <a name="l00336"></a>00336
  426. <a name="l00337"></a>00337 <span class="comment">! ======================</span>
  427. <a name="l00338"></a>00338 <span class="comment">! SUBROUTINE CHANGE_DTNS</span>
  428. <a name="l00339"></a>00339 <span class="comment">! ======================</span>
  429. <a name="l00340"></a>00340
  430. <a name="l00341"></a><a class="code" href="guimod_8f90.html#afb9135ea9ab544baed4b985f22d7c48c">00341</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#afb9135ea9ab544baed4b985f22d7c48c">change_dtns</a>(k)
  431. <a name="l00342"></a>00342 use <span class="keywordflow">pumamod</span>
  432. <a name="l00343"></a>00343 <span class="keyword">write</span> (*,7000) <a class="code" href="pumax_8c.html#a354c90bb46e1789fe52c4759474c2c89">nstep</a>,<span class="stringliteral">&#39;DTNS &#39;</span>,crap(k),parc(k)
  433. <a name="l00344"></a>00344 dtns = parc(k) / CT;
  434. <a name="l00345"></a>00345 zttrop = tgr-dtrop*ALR
  435. <a name="l00346"></a>00346 ztps = (zttrop/tgr)**(GA/(ALR*GASCON))
  436. <a name="l00347"></a>00347 <span class="keyword">do</span> jlev = 1 , NLEV
  437. <a name="l00348"></a>00348 zfac = sin(0.5*PI*(sigma(jlev)-ztps)/(1.-ztps))
  438. <a name="l00349"></a>00349 <span class="keyword">if</span> (zfac &lt; 0.0) zfac = 0.0
  439. <a name="l00350"></a>00350 sr2(3,jlev) = (1.0 / sqrt(6.0)) * dtns * zfac
  440. <a name="l00351"></a>00351 <span class="keyword">enddo</span>
  441. <a name="l00352"></a>00352 ldtns = .true.
  442. <a name="l00353"></a>00353 return
  443. <a name="l00354"></a>00354 7000 format(<span class="stringliteral">&#39;Step&#39;</span>,i8,<span class="stringliteral">&#39;: User changed &#39;</span>,a,<span class="stringliteral">&#39; from &#39;</span>,f7.2,<span class="stringliteral">&#39; to &#39;</span>,f7.2)
  444. <a name="l00355"></a>00355 <span class="keyword"> end</span>
  445. <a name="l00356"></a>00356
  446. <a name="l00357"></a>00357
  447. <a name="l00358"></a>00358 <span class="comment">! ========================</span>
  448. <a name="l00359"></a>00359 <span class="comment">! SUBROUTINE CHANGE_SELLON</span>
  449. <a name="l00360"></a>00360 <span class="comment">! ========================</span>
  450. <a name="l00361"></a>00361
  451. <a name="l00362"></a><a class="code" href="guimod_8f90.html#ab102930c8ece1efffa94e47fe5273134">00362</a> <span class="keyword">subroutine </span><a class="code" href="guimod_8f90.html#ab102930c8ece1efffa94e47fe5273134">change_sellon</a>(k)
  452. <a name="l00363"></a>00363 use <span class="keywordflow">pumamod</span>
  453. <a name="l00364"></a>00364 sellon = nint(parc(k) * NLON / 360.0 + 1.0)
  454. <a name="l00365"></a>00365 <span class="keyword">if</span> (sellon &lt; 1) sellon = 1
  455. <a name="l00366"></a>00366 <span class="keyword">if</span> (sellon &gt; NLON) sellon = NLON
  456. <a name="l00367"></a>00367 return
  457. <a name="l00368"></a>00368 <span class="keyword"> end</span>
  458. </pre></div></div>
  459. </div>
  460. <div id="nav-path" class="navpath">
  461. <ul>
  462. <li class="navelem"><a class="el" href="guimod_8f90.html">guimod.f90</a> </li>
  463. <!-- window showing the filter options -->
  464. <div id="MSearchSelectWindow"
  465. onmouseover="return searchBox.OnSearchSelectShow()"
  466. onmouseout="return searchBox.OnSearchSelectHide()"
  467. onkeydown="return searchBox.OnSearchSelectKey(event)">
  468. <a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(0)"><span class="SelectionMark">&#160;</span>All</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(1)"><span class="SelectionMark">&#160;</span>Classes</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(2)"><span class="SelectionMark">&#160;</span>Files</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(3)"><span class="SelectionMark">&#160;</span>Functions</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(4)"><span class="SelectionMark">&#160;</span>Variables</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(5)"><span class="SelectionMark">&#160;</span>Defines</a></div>
  469. <!-- iframe showing the search results (closed by default) -->
  470. <div id="MSearchResultsWindow">
  471. <iframe src="javascript:void(0)" frameborder="0"
  472. name="MSearchResults" id="MSearchResults">
  473. </iframe>
  474. </div>
  475. <li class="footer">Generated on Wed Sep 21 2011 12:35:46 for PUMA by
  476. <a href="http://www.doxygen.org/index.html">
  477. <img class="footer" src="doxygen.png" alt="doxygen"/></a> 1.7.5.1 </li>
  478. </ul>
  479. </div>
  480. </body>
  481. </html>