Etusivu Tutki Apua
Kirjaudu sisään
TECLIM
/
PlaSim
3
0
Fork 0
Tiedostot Ongelmat 0 Pull-pyynnöt 0 Wiki
Puu: 147feb3295
Haarat Tagit
PlaSim
/
puma
/
dox
/
html
/
mpimod_8f90_source.html

mpimod_8f90_source.html 56 KB
Historia Raaka

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808 
  1. <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
    2. 

  2. <html xmlns="http://www.w3.org/1999/xhtml">
    3. 

  3. <head>
    4. 

  4. <meta http-equiv="Content-Type" content="text/xhtml;charset=UTF-8"/>
    5. 

  5. <title>PUMA: /Users/home/WC/puma/src/mpimod.f90 Source File</title>
    6. 

  6. 

  7. <link href="tabs.css" rel="stylesheet" type="text/css"/>
    8. 

  8. <link href="doxygen.css" rel="stylesheet" type="text/css" />
    9. 

  9. <link href="navtree.css" rel="stylesheet" type="text/css"/>
    10. 

  10. <script type="text/javascript" src="jquery.js"></script>
    11. 

  11. <script type="text/javascript" src="resize.js"></script>
    12. 

  12. <script type="text/javascript" src="navtree.js"></script>
    13. 

  13. <script type="text/javascript">
    14. 

  14.   $(document).ready(initResizable);
    15. 

  15. </script>
    16. 

  16. <link href="search/search.css" rel="stylesheet" type="text/css"/>
    17. 

  17. <script type="text/javascript" src="search/search.js"></script>
    18. 

  18. <script type="text/javascript">
    19. 

  19.   $(document).ready(function() { searchBox.OnSelectItem(0); });
    20. 

  20. </script>
    21. 

  21. 

  22. </head>
    23. 

  23. <body>
    24. 

  24. <div id="top"><!-- do not remove this div! -->
    25. 

  25. 

  26. 

  27. <div id="titlearea">
    28. 

  28. <table cellspacing="0" cellpadding="0">
    29. 

  29.  <tbody>
    30. 

  30.  <tr style="height: 56px;">
    31. 

  31.   
    32. 

  32.   <td id="projectlogo"><img alt="Logo" src="puma103.jpg"/></td>
    33. 

  33.   
    34. 

  34.   
    35. 

  35.   <td style="padding-left: 0.5em;">
    36. 

  36.    <div id="projectname">PUMA
    37. 

  37.    &#160;<span id="projectnumber">219</span>
    38. 

  38.    </div>
    39. 

  39.    <div id="projectbrief">Portable University Model of the Atmosphere</div>
    40. 

  40.   </td>
    41. 

  41.   
    42. 

  42.   
    43. 

  43.   
    44. 

  44.  </tr>
    45. 

  45.  </tbody>
    46. 

  46. </table>
    47. 

  47. </div>
    48. 

  48. 

  49. <!-- Generated by Doxygen 1.7.5.1 -->
    50. 

  50. <script type="text/javascript">
    51. 

  51. var searchBox = new SearchBox("searchBox", "search",false,'Search');
    52. 

  52. </script>
    53. 

  53.   <div id="navrow1" class="tabs">
    54. 

  54.     <ul class="tablist">
    55. 

  55.       <li><a href="index.html"><span>Main&#160;Page</span></a></li>
    56. 

  56.       <li><a href="annotated.html"><span>Data&#160;Types&#160;List</span></a></li>
    57. 

  57.       <li class="current"><a href="files.html"><span>Files</span></a></li>
    58. 

  58.       <li>
    59. 

  59.         <div id="MSearchBox" class="MSearchBoxInactive">
    60. 

  60.         <span class="left">
    61. 

  61.           <img id="MSearchSelect" src="search/mag_sel.png"
    62. 

  62.                onmouseover="return searchBox.OnSearchSelectShow()"
    63. 

  63.                onmouseout="return searchBox.OnSearchSelectHide()"
    64. 

  64.                alt=""/>
    65. 

  65.           <input type="text" id="MSearchField" value="Search" accesskey="S"
    66. 

  66.                onfocus="searchBox.OnSearchFieldFocus(true)" 
    67. 

  67.                onblur="searchBox.OnSearchFieldFocus(false)" 
    68. 

  68.                onkeyup="searchBox.OnSearchFieldChange(event)"/>
    69. 

  69.           </span><span class="right">
    70. 

  70.             <a id="MSearchClose" href="javascript:searchBox.CloseResultsWindow()"><img id="MSearchCloseImg" border="0" src="search/close.png" alt=""/></a>
    71. 

  71.           </span>
    72. 

  72.         </div>
    73. 

  73.       </li>
    74. 

  74.     </ul>
    75. 

  75.   </div>
    76. 

  76.   <div id="navrow2" class="tabs2">
    77. 

  77.     <ul class="tablist">
    78. 

  78.       <li><a href="files.html"><span>File&#160;List</span></a></li>
    79. 

  79.       <li><a href="globals.html"><span>File&#160;Members</span></a></li>
    80. 

  80.     </ul>
    81. 

  81.   </div>
    82. 

  82. </div>
    83. 

  83. <div id="side-nav" class="ui-resizable side-nav-resizable">
    84. 

  84.   <div id="nav-tree">
    85. 

  85.     <div id="nav-tree-contents">
    86. 

  86.     </div>
    87. 

  87.   </div>
    88. 

  88.   <div id="splitbar" style="-moz-user-select:none;" 
    89. 

  89.        class="ui-resizable-handle">
    90. 

  90.   </div>
    91. 

  91. </div>
    92. 

  92. <script type="text/javascript">
    93. 

  93.   initNavTree('mpimod_8f90.html','');
    94. 

  94. </script>
    95. 

  95. <div id="doc-content">
    96. 

  96. <div class="header">
    97. 

  97.   <div class="headertitle">
    98. 

  98. <div class="title">/Users/home/WC/puma/src/mpimod.f90</div>  </div>
    99. 

  99. </div>
    100. 

  100. <div class="contents">
    101. 

  101. <a href="mpimod_8f90.html">Go to the documentation of this file.</a><div class="fragment"><pre class="fragment"><a name="l00001"></a><a class="code" href="classmpimod.html">00001</a>       <span class="keyword">module</span> <a class="code" href="classmpimod.html">mpimod</a>
    102. 

  102. <a name="l00002"></a>00002       use <span class="keywordflow">pumamod</span>
    103. 

  103. <a name="l00003"></a>00003       use <span class="keywordflow">mpi</span>
    104. 

  104. <a name="l00004"></a>00004 
    105. 

  105. <a name="l00005"></a><a class="code" href="classmpimod.html#af62a8ae2d736a3459fb4b53b10e387b7">00005</a>       <span class="keywordtype">integer</span> :: mpi_itype = MPI_INTEGER4
    106. 

  106. <a name="l00006"></a><a class="code" href="classmpimod.html#a5a2316efc68e8c325c7f02c3e5038e9e">00006</a>       <span class="keywordtype">integer</span> :: mpi_rtype = MPI_REAL4
    107. 

  107. <a name="l00007"></a><a class="code" href="classmpimod.html#a71f9e9a581e32ba32ab9064f41bb1f91">00007</a>       <span class="keywordtype">integer</span> :: mpi_ltype = MPI_LOGICAL
    108. 

  108. <a name="l00008"></a>00008 
    109. 

  109. <a name="l00009"></a>00009 <span class="keyword">      end module mpimod</span>
    110. 

  110. <a name="l00010"></a>00010 <span class="comment">!</span>
    111. 

  111. <a name="l00011"></a>00011 <span class="comment">!     interface routines to MPI:</span>
    112. 

  112. <a name="l00012"></a>00012 <span class="comment">!</span>
    113. 

  113. <a name="l00013"></a>00013 
    114. 

  114. <a name="l00014"></a>00014 
    115. 

  115. <a name="l00015"></a>00015 <span class="comment">!     ================</span>
    116. 

  116. <a name="l00016"></a>00016 <span class="comment">!     SUBROUTINE MPBCI</span>
    117. 

  117. <a name="l00017"></a>00017 <span class="comment">!     ================</span>
    118. 

  118. <a name="l00018"></a>00018 
    119. 

  119. <a name="l00019"></a><a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">00019</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a89982355acc98319bfc191dab28da805">mpbci</a>(k) ! broadcast 1 integer
    120. 

  120. <a name="l00020"></a>00020       use <span class="keywordflow">mpimod</span>
    121. 

  121. <a name="l00021"></a>00021 
    122. 

  122. <a name="l00022"></a>00022       call mpi_bcast(k,1,mpi_itype,NROOT,myworld,mpinfo)
    123. 

  123. <a name="l00023"></a>00023 
    124. 

  124. <a name="l00024"></a>00024       return
    125. 

  125. <a name="l00025"></a>00025 <span class="keyword">      end subroutine mpbci</span>
    126. 

  126. <a name="l00026"></a>00026 
    127. 

  127. <a name="l00027"></a>00027 <span class="comment">!     =================</span>
    128. 

  128. <a name="l00028"></a>00028 <span class="comment">!     SUBROUTINE MPBCIN</span>
    129. 

  129. <a name="l00029"></a>00029 <span class="comment">!     =================</span>
    130. 

  130. <a name="l00030"></a>00030 
    131. 

  131. <a name="l00031"></a><a class="code" href="mpimod_8f90.html#a85cfae5acde5c37604edf690e9c2f7cf">00031</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a85cfae5acde5c37604edf690e9c2f7cf">mpbcin</a>(k,n) ! broadcast n integer
    132. 

  132. <a name="l00032"></a>00032       use <span class="keywordflow">mpimod</span>
    133. 

  133. <a name="l00033"></a>00033 
    134. 

  134. <a name="l00034"></a>00034       <span class="keywordtype">integer</span> k(n)
    135. 

  135. <a name="l00035"></a>00035 
    136. 

  136. <a name="l00036"></a>00036       call mpi_bcast(k,n,mpi_itype,NROOT,myworld,mpinfo)
    137. 

  137. <a name="l00037"></a>00037 
    138. 

  138. <a name="l00038"></a>00038       return
    139. 

  139. <a name="l00039"></a>00039 <span class="keyword">      end subroutine mpbcin</span>
    140. 

  140. <a name="l00040"></a>00040 
    141. 

  141. <a name="l00041"></a>00041 <span class="comment">!     ================</span>
    142. 

  142. <a name="l00042"></a>00042 <span class="comment">!     SUBROUTINE MPBCR</span>
    143. 

  143. <a name="l00043"></a>00043 <span class="comment">!     ================</span>
    144. 

  144. <a name="l00044"></a>00044 
    145. 

  145. <a name="l00045"></a><a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">00045</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#aded092db7f8071a727e2e96887702ca7">mpbcr</a>(p) ! broadcast 1 real
    146. 

  146. <a name="l00046"></a>00046       use <span class="keywordflow">mpimod</span>
    147. 

  147. <a name="l00047"></a>00047 
    148. 

  148. <a name="l00048"></a>00048       call mpi_bcast(p,1,mpi_rtype,NROOT,myworld,mpinfo)
    149. 

  149. <a name="l00049"></a>00049 
    150. 

  150. <a name="l00050"></a>00050       return
    151. 

  151. <a name="l00051"></a>00051 <span class="keyword">      end subroutine mpbcr</span>
    152. 

  152. <a name="l00052"></a>00052 
    153. 

  153. <a name="l00053"></a>00053 <span class="comment">!     =================</span>
    154. 

  154. <a name="l00054"></a>00054 <span class="comment">!     SUBROUTINE MPBCRN</span>
    155. 

  155. <a name="l00055"></a>00055 <span class="comment">!     =================</span>
    156. 

  156. <a name="l00056"></a>00056 
    157. 

  157. <a name="l00057"></a><a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">00057</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#af2a0a009162180d4abb1daa1bad60cf2">mpbcrn</a>(p,n) ! broadcast n real
    158. 

  158. <a name="l00058"></a>00058       use <span class="keywordflow">mpimod</span>
    159. 

  159. <a name="l00059"></a>00059 
    160. 

  160. <a name="l00060"></a>00060       <span class="keywordtype">real</span> p(n)
    161. 

  161. <a name="l00061"></a>00061 
    162. 

  162. <a name="l00062"></a>00062       call mpi_bcast(p,n,mpi_rtype,NROOT,myworld,mpinfo)
    163. 

  163. <a name="l00063"></a>00063 
    164. 

  164. <a name="l00064"></a>00064       return
    165. 

  165. <a name="l00065"></a>00065 <span class="keyword">      end subroutine mpbcrn</span>
    166. 

  166. <a name="l00066"></a>00066 
    167. 

  167. <a name="l00067"></a>00067 <span class="comment">!     ================</span>
    168. 

  168. <a name="l00068"></a>00068 <span class="comment">!     SUBROUTINE MPBCL</span>
    169. 

  169. <a name="l00069"></a>00069 <span class="comment">!     ================</span>
    170. 

  170. <a name="l00070"></a>00070 
    171. 

  171. <a name="l00071"></a><a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">00071</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a40b910e38273e7f3c9dc4ed36d3e67a0">mpbcl</a>(k) ! broadcast 1 logical
    172. 

  172. <a name="l00072"></a>00072       use <span class="keywordflow">mpimod</span>
    173. 

  173. <a name="l00073"></a>00073       <span class="keywordtype">logical</span> k
    174. 

  174. <a name="l00074"></a>00074 
    175. 

  175. <a name="l00075"></a>00075       call mpi_bcast(k,1,mpi_ltype,NROOT,myworld,mpinfo)
    176. 

  176. <a name="l00076"></a>00076 
    177. 

  177. <a name="l00077"></a>00077       return
    178. 

  178. <a name="l00078"></a>00078 <span class="keyword">      end subroutine mpbcl</span>
    179. 

  179. <a name="l00079"></a>00079 
    180. 

  180. <a name="l00080"></a>00080 <span class="comment">!     =================</span>
    181. 

  181. <a name="l00081"></a>00081 <span class="comment">!     SUBROUTINE MPSCIN</span>
    182. 

  182. <a name="l00082"></a>00082 <span class="comment">!     =================</span>
    183. 

  183. <a name="l00083"></a>00083 
    184. 

  184. <a name="l00084"></a><a class="code" href="mpimod_8f90.html#a8338d8609afcefbb1faa41f353c10ef9">00084</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a8338d8609afcefbb1faa41f353c10ef9">mpscin</a>(k,n) ! scatter n integer
    185. 

  185. <a name="l00085"></a>00085       use <span class="keywordflow">mpimod</span>
    186. 

  186. <a name="l00086"></a>00086 
    187. 

  187. <a name="l00087"></a>00087       <span class="keywordtype">integer</span> k(*)
    188. 

  188. <a name="l00088"></a>00088 
    189. 

  189. <a name="l00089"></a>00089       call mpi_scatter(k,n,mpi_itype,k,n,mpi_itype                  &amp;
    190. 

  190. <a name="l00090"></a>00090      &amp;                ,NROOT,myworld,mpinfo)
    191. 

  191. <a name="l00091"></a>00091 
    192. 

  192. <a name="l00092"></a>00092       return
    193. 

  193. <a name="l00093"></a>00093 <span class="keyword">      end subroutine mpscin</span>
    194. 

  194. <a name="l00094"></a>00094 
    195. 

  195. <a name="l00095"></a>00095 <span class="comment">!     =================</span>
    196. 

  196. <a name="l00096"></a>00096 <span class="comment">!     SUBROUTINE MPSCRN</span>
    197. 

  197. <a name="l00097"></a>00097 <span class="comment">!     =================</span>
    198. 

  198. <a name="l00098"></a>00098 
    199. 

  199. <a name="l00099"></a><a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">00099</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a1504cf64a1ffc198a8a1fe54ba00d775">mpscrn</a>(p,n) ! scatter n real
    200. 

  200. <a name="l00100"></a>00100       use <span class="keywordflow">mpimod</span>
    201. 

  201. <a name="l00101"></a>00101 
    202. 

  202. <a name="l00102"></a>00102       <span class="keywordtype">real</span> p(*)
    203. 

  203. <a name="l00103"></a>00103 
    204. 

  204. <a name="l00104"></a>00104       call mpi_scatter(p,n,mpi_rtype,p,n,mpi_rtype,NROOT,myworld,mpinfo)
    205. 

  205. <a name="l00105"></a>00105 
    206. 

  206. <a name="l00106"></a>00106       return
    207. 

  207. <a name="l00107"></a>00107 <span class="keyword">      end subroutine mpscrn</span>
    208. 

  208. <a name="l00108"></a>00108 
    209. 

  209. <a name="l00109"></a>00109 <span class="comment">!     =================</span>
    210. 

  210. <a name="l00110"></a>00110 <span class="comment">!     SUBROUTINE MPSCDN</span>
    211. 

  211. <a name="l00111"></a>00111 <span class="comment">!     =================</span>
    212. 

  212. <a name="l00112"></a>00112 
    213. 

  213. <a name="l00113"></a><a class="code" href="mpimod_8f90.html#a3d2a5d231fd9527bcbc1fde327326922">00113</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a3d2a5d231fd9527bcbc1fde327326922">mpscdn</a>(p,n) ! scatter n double precision
    214. 

  214. <a name="l00114"></a>00114       use <span class="keywordflow">mpimod</span>
    215. 

  215. <a name="l00115"></a>00115 
    216. 

  216. <a name="l00116"></a>00116       <span class="keywordtype">real (kind=8)</span> :: p(*)
    217. 

  217. <a name="l00117"></a>00117 
    218. 

  218. <a name="l00118"></a>00118       call mpi_scatter(p,n,MPI_REAL8,p,n,MPI_REAL8,NROOT,myworld,mpinfo)
    219. 

  219. <a name="l00119"></a>00119 
    220. 

  220. <a name="l00120"></a>00120       return
    221. 

  221. <a name="l00121"></a>00121 <span class="keyword">      end subroutine mpscdn</span>
    222. 

  222. <a name="l00122"></a>00122 
    223. 

  223. <a name="l00123"></a>00123 <span class="comment">!     =================</span>
    224. 

  224. <a name="l00124"></a>00124 <span class="comment">!     SUBROUTINE MPSCGP</span>
    225. 

  225. <a name="l00125"></a>00125 <span class="comment">!     =================</span>
    226. 

  226. <a name="l00126"></a>00126 
    227. 

  227. <a name="l00127"></a><a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">00127</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(pf,pp,klev) ! scatter gridpoint fields
    228. 

  228. <a name="l00128"></a>00128       use <span class="keywordflow">mpimod</span>
    229. 

  229. <a name="l00129"></a>00129 
    230. 

  230. <a name="l00130"></a>00130       <span class="keywordtype">real</span> pf(NUGP,klev)
    231. 

  231. <a name="l00131"></a>00131       <span class="keywordtype">real</span> pp(NHOR,klev)
    232. 

  232. <a name="l00132"></a>00132 
    233. 

  233. <a name="l00133"></a>00133       <span class="keyword">do</span> jlev = 1 , klev
    234. 

  234. <a name="l00134"></a>00134          call mpi_scatter(pf(1,jlev),NHOR,mpi_rtype,                     &amp;
    235. 

  235. <a name="l00135"></a>00135      &amp;                    pp(1,jlev),NHOR,mpi_rtype,                     &amp;
    236. 

  236. <a name="l00136"></a>00136      &amp;                    NROOT,myworld,mpinfo)
    237. 

  237. <a name="l00137"></a>00137       <span class="keyword">enddo</span>
    238. 

  238. <a name="l00138"></a>00138 
    239. 

  239. <a name="l00139"></a>00139       return
    240. 

  240. <a name="l00140"></a>00140 <span class="keyword">      end subroutine mpscgp</span>
    241. 

  241. <a name="l00141"></a>00141 
    242. 

  242. <a name="l00142"></a>00142 <span class="comment">!     =================</span>
    243. 

  243. <a name="l00143"></a>00143 <span class="comment">!     SUBROUTINE MPGAGP</span>
    244. 

  244. <a name="l00144"></a>00144 <span class="comment">!     =================</span>
    245. 

  245. <a name="l00145"></a>00145 
    246. 

  246. <a name="l00146"></a><a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">00146</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(pf,pp,klev) ! gather gridpoint fields
    247. 

  247. <a name="l00147"></a>00147       use <span class="keywordflow">mpimod</span>
    248. 

  248. <a name="l00148"></a>00148 
    249. 

  249. <a name="l00149"></a>00149       <span class="keywordtype">real</span> pf(NLON*NLAT,klev)
    250. 

  250. <a name="l00150"></a>00150       <span class="keywordtype">real</span> pp(NHOR,klev)
    251. 

  251. <a name="l00151"></a>00151 
    252. 

  252. <a name="l00152"></a>00152       <span class="keyword">do</span> jlev = 1 , klev
    253. 

  253. <a name="l00153"></a>00153          call mpi_gather(pp(1,jlev),NHOR,mpi_rtype,                      &amp;
    254. 

  254. <a name="l00154"></a>00154      &amp;                   pf(1,jlev),NHOR,mpi_rtype,                      &amp;
    255. 

  255. <a name="l00155"></a>00155      &amp;                   NROOT,myworld,mpinfo)
    256. 

  256. <a name="l00156"></a>00156       <span class="keyword">enddo</span>
    257. 

  257. <a name="l00157"></a>00157 
    258. 

  258. <a name="l00158"></a>00158       return
    259. 

  259. <a name="l00159"></a>00159 <span class="keyword">      end subroutine mpgagp</span>
    260. 

  260. <a name="l00160"></a>00160 
    261. 

  261. <a name="l00161"></a>00161 <span class="comment">!     ===================</span>
    262. 

  262. <a name="l00162"></a>00162 <span class="comment">!     SUBROUTINE MPGALLGP</span>
    263. 

  263. <a name="l00163"></a>00163 <span class="comment">!     ===================</span>
    264. 

  264. <a name="l00164"></a>00164 
    265. 

  265. <a name="l00165"></a><a class="code" href="mpimod_8f90.html#a0d1453ad027ffece9843cdeff7178f79">00165</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a0d1453ad027ffece9843cdeff7178f79">mpgallgp</a>(pf,pp,klev) ! gather gritpoint to all
    266. 

  266. <a name="l00166"></a>00166       use <span class="keywordflow">mpimod</span>
    267. 

  267. <a name="l00167"></a>00167 
    268. 

  268. <a name="l00168"></a>00168       <span class="keywordtype">real</span> pf(NLON*NLAT,klev)
    269. 

  269. <a name="l00169"></a>00169       <span class="keywordtype">real</span> pp(NHOR,klev)
    270. 

  270. <a name="l00170"></a>00170 
    271. 

  271. <a name="l00171"></a>00171       <span class="keyword">do</span> jlev = 1 , klev
    272. 

  272. <a name="l00172"></a>00172          call mpi_allgather(pp(1,jlev),NHOR,mpi_rtype,                   &amp;
    273. 

  273. <a name="l00173"></a>00173      &amp;                      pf(1,jlev),NHOR,mpi_rtype,                   &amp;
    274. 

  274. <a name="l00174"></a>00174      &amp;                      myworld,mpinfo)
    275. 

  275. <a name="l00175"></a>00175       <span class="keyword">enddo</span>
    276. 

  276. <a name="l00176"></a>00176 
    277. 

  277. <a name="l00177"></a>00177       return
    278. 

  278. <a name="l00178"></a>00178 <span class="keyword">      end subroutine mpgallgp</span>
    279. 

  279. <a name="l00179"></a>00179 
    280. 

  280. <a name="l00180"></a>00180 <span class="comment">!     =================</span>
    281. 

  281. <a name="l00181"></a>00181 <span class="comment">!     SUBROUTINE MPSCSP</span>
    282. 

  282. <a name="l00182"></a>00182 <span class="comment">!     =================</span>
    283. 

  283. <a name="l00183"></a>00183 
    284. 

  284. <a name="l00184"></a><a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">00184</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(pf,pp,klev) ! scatter spectral fields
    285. 

  285. <a name="l00185"></a>00185       use <span class="keywordflow">mpimod</span>
    286. 

  286. <a name="l00186"></a>00186 
    287. 

  287. <a name="l00187"></a>00187       <span class="keywordtype">real</span> pf(NESP,klev)
    288. 

  288. <a name="l00188"></a>00188       <span class="keywordtype">real</span> pp(NSPP,klev)
    289. 

  289. <a name="l00189"></a>00189 
    290. 

  290. <a name="l00190"></a>00190       <span class="keyword">do</span> jlev = 1 , klev
    291. 

  291. <a name="l00191"></a>00191          call mpi_scatter(pf(1,jlev),NSPP,mpi_rtype                      &amp;
    292. 

  292. <a name="l00192"></a>00192      &amp;                   ,pp(1,jlev),NSPP,mpi_rtype                      &amp;
    293. 

  293. <a name="l00193"></a>00193      &amp;                   ,NROOT,myworld,mpinfo)
    294. 

  294. <a name="l00194"></a>00194       <span class="keyword">enddo</span>
    295. 

  295. <a name="l00195"></a>00195 
    296. 

  296. <a name="l00196"></a>00196       return
    297. 

  297. <a name="l00197"></a>00197 <span class="keyword">      end subroutine mpscsp</span>
    298. 

  298. <a name="l00198"></a>00198 
    299. 

  299. <a name="l00199"></a>00199 <span class="comment">!     =================</span>
    300. 

  300. <a name="l00200"></a>00200 <span class="comment">!     SUBROUTINE MPGASP</span>
    301. 

  301. <a name="l00201"></a>00201 <span class="comment">!     =================</span>
    302. 

  302. <a name="l00202"></a>00202 
    303. 

  303. <a name="l00203"></a><a class="code" href="mpimod_8f90.html#ac053a575b1230f8e4a296164dba5ab27">00203</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#ac053a575b1230f8e4a296164dba5ab27">mpgasp</a>(pf,pp,klev) ! gather spectral fields
    304. 

  304. <a name="l00204"></a>00204       use <span class="keywordflow">mpimod</span>
    305. 

  305. <a name="l00205"></a>00205 
    306. 

  306. <a name="l00206"></a>00206       <span class="keywordtype">real</span> pf(NESP,klev)
    307. 

  307. <a name="l00207"></a>00207       <span class="keywordtype">real</span> pp(NSPP,klev)
    308. 

  308. <a name="l00208"></a>00208 
    309. 

  309. <a name="l00209"></a>00209       <span class="keyword">do</span> jlev = 1 , klev
    310. 

  310. <a name="l00210"></a>00210          call mpi_gather(pp(1,jlev),NSPP,mpi_rtype                       &amp;
    311. 

  311. <a name="l00211"></a>00211      &amp;                  ,pf(1,jlev),NSPP,mpi_rtype                       &amp;
    312. 

  312. <a name="l00212"></a>00212      &amp;                  ,NROOT,myworld,mpinfo)
    313. 

  313. <a name="l00213"></a>00213       <span class="keyword">enddo</span>
    314. 

  314. <a name="l00214"></a>00214 
    315. 

  315. <a name="l00215"></a>00215       return
    316. 

  316. <a name="l00216"></a>00216 <span class="keyword">      end subroutine mpgasp</span>
    317. 

  317. <a name="l00217"></a>00217 
    318. 

  318. <a name="l00218"></a>00218 <span class="comment">!     =================</span>
    319. 

  319. <a name="l00219"></a>00219 <span class="comment">!     SUBROUTINE MPGACS</span>
    320. 

  320. <a name="l00220"></a>00220 <span class="comment">!     =================</span>
    321. 

  321. <a name="l00221"></a>00221 
    322. 

  322. <a name="l00222"></a><a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">00222</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a5aef7e33503e0c46b1d8c0b984c398d1">mpgacs</a>(pcs) ! gather cross sections
    323. 

  323. <a name="l00223"></a>00223       use <span class="keywordflow">mpimod</span>
    324. 

  324. <a name="l00224"></a>00224 
    325. 

  325. <a name="l00225"></a>00225       <span class="keywordtype">real</span> pcs(NLAT,NLEV)
    326. 

  326. <a name="l00226"></a>00226 
    327. 

  327. <a name="l00227"></a>00227       <span class="keyword">do</span> jlev = 1 , NLEV
    328. 

  328. <a name="l00228"></a>00228          call mpi_gather(pcs(1,jlev),NLPP,mpi_rtype                      &amp;
    329. 

  329. <a name="l00229"></a>00229      &amp;                  ,pcs(1,jlev),NLPP,mpi_rtype                      &amp;
    330. 

  330. <a name="l00230"></a>00230      &amp;                  ,NROOT,myworld,mpinfo)
    331. 

  331. <a name="l00231"></a>00231 
    332. 

  332. <a name="l00232"></a>00232       <span class="keyword">enddo</span>
    333. 

  333. <a name="l00233"></a>00233       return
    334. 

  334. <a name="l00234"></a>00234 <span class="keyword">      end subroutine mpgacs</span>
    335. 

  335. <a name="l00235"></a>00235 
    336. 

  336. <a name="l00236"></a>00236 <span class="comment">!     ===================</span>
    337. 

  337. <a name="l00237"></a>00237 <span class="comment">!     SUBROUTINE MPGALLSP</span>
    338. 

  338. <a name="l00238"></a>00238 <span class="comment">!     ===================</span>
    339. 

  339. <a name="l00239"></a>00239 
    340. 

  340. <a name="l00240"></a><a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">00240</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a54cf45feb57177de8eaab2e6b01a7aa2">mpgallsp</a>(pf,pp,klev) ! gather spectral to all
    341. 

  341. <a name="l00241"></a>00241       use <span class="keywordflow">mpimod</span>
    342. 

  342. <a name="l00242"></a>00242 
    343. 

  343. <a name="l00243"></a>00243       <span class="keywordtype">real</span> pf(NESP,klev)
    344. 

  344. <a name="l00244"></a>00244       <span class="keywordtype">real</span> pp(NSPP,klev)
    345. 

  345. <a name="l00245"></a>00245 
    346. 

  346. <a name="l00246"></a>00246       <span class="keyword">do</span> jlev = 1 , klev
    347. 

  347. <a name="l00247"></a>00247          call mpi_allgather(pp(1,jlev),NSPP,mpi_rtype                    &amp;
    348. 

  348. <a name="l00248"></a>00248      &amp;                     ,pf(1,jlev),NSPP,mpi_rtype                    &amp;
    349. 

  349. <a name="l00249"></a>00249      &amp;                     ,myworld,mpinfo)
    350. 

  350. <a name="l00250"></a>00250       <span class="keyword">enddo</span>
    351. 

  351. <a name="l00251"></a>00251 
    352. 

  352. <a name="l00252"></a>00252       return
    353. 

  353. <a name="l00253"></a>00253 <span class="keyword">      end subroutine mpgallsp</span>
    354. 

  354. <a name="l00254"></a>00254 
    355. 

  355. <a name="l00255"></a>00255 <span class="comment">!     ================</span>
    356. 

  356. <a name="l00256"></a>00256 <span class="comment">!     SUBROUTINE MPSUM</span>
    357. 

  357. <a name="l00257"></a>00257 <span class="comment">!     ================</span>
    358. 

  358. <a name="l00258"></a>00258 
    359. 

  359. <a name="l00259"></a><a class="code" href="mpimod_8f90.html#af894efd9525c935f22415e017dcbc482">00259</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#af894efd9525c935f22415e017dcbc482">mpsum</a>(psp,klev) ! sum spectral fields
    360. 

  360. <a name="l00260"></a>00260       use <span class="keywordflow">mpimod</span>
    361. 

  361. <a name="l00261"></a>00261 
    362. 

  362. <a name="l00262"></a>00262       <span class="keywordtype">real</span> psp(NESP,klev)
    363. 

  363. <a name="l00263"></a>00263       <span class="keywordtype">real</span> tmp(NESP,klev)
    364. 

  364. <a name="l00264"></a>00264 
    365. 

  365. <a name="l00265"></a>00265       call mpi_reduce(psp(1,1),tmp(1,1),NESP*klev,mpi_rtype,MPI_SUM     &amp;
    366. 

  366. <a name="l00266"></a>00266      &amp;               ,NROOT,myworld,mpinfo)
    367. 

  367. <a name="l00267"></a>00267       <span class="keyword">if</span> (mypid == NROOT) psp = tmp
    368. 

  368. <a name="l00268"></a>00268 
    369. 

  369. <a name="l00269"></a>00269       return
    370. 

  370. <a name="l00270"></a>00270 <span class="keyword">      end subroutine mpsum</span>
    371. 

  371. <a name="l00271"></a>00271 
    372. 

  372. <a name="l00272"></a>00272 <span class="comment">!     ==================</span>
    373. 

  373. <a name="l00273"></a>00273 <span class="comment">!     SUBROUTINE MPSUMSC</span>
    374. 

  374. <a name="l00274"></a>00274 <span class="comment">!     ==================</span>
    375. 

  375. <a name="l00275"></a>00275 
    376. 

  376. <a name="l00276"></a><a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">00276</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a75a681a8d4b9ab5ba0d4fa97f909647b">mpsumsc</a>(psf,psp,klev) ! sum &amp; scatter spectral
    377. 

  377. <a name="l00277"></a>00277       use <span class="keywordflow">mpimod</span>
    378. 

  378. <a name="l00278"></a>00278 
    379. 

  379. <a name="l00279"></a>00279       <span class="keywordtype">real</span> psf(NESP,klev)
    380. 

  380. <a name="l00280"></a>00280       <span class="keywordtype">real</span> psp(NSPP,klev)
    381. 

  381. <a name="l00281"></a>00281 
    382. 

  382. <a name="l00282"></a>00282       <span class="keyword">do</span> jlev = 1 , klev
    383. 

  383. <a name="l00283"></a>00283          call mpi_reduce_scatter(psf(1,jlev),psp(1,jlev),nscatsp        &amp;
    384. 

  384. <a name="l00284"></a>00284      &amp;                          ,mpi_rtype,MPI_SUM,myworld,mpinfo)
    385. 

  385. <a name="l00285"></a>00285       <span class="keyword">enddo</span>
    386. 

  386. <a name="l00286"></a>00286 
    387. 

  387. <a name="l00287"></a>00287       return
    388. 

  388. <a name="l00288"></a>00288 <span class="keyword">      end subroutine mpsumsc</span>
    389. 

  389. <a name="l00289"></a>00289 
    390. 

  390. <a name="l00290"></a>00290 <span class="comment">!     ====================</span>
    391. 

  391. <a name="l00291"></a>00291 <span class="comment">!     SUBROUTINE MPSUMR</span>
    392. 

  392. <a name="l00292"></a>00292 <span class="comment">!     ====================</span>
    393. 

  393. <a name="l00293"></a>00293 
    394. 

  394. <a name="l00294"></a><a class="code" href="mpimod_8f90.html#af2111ef6d5b772479a74e94d351440f0">00294</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#af2111ef6d5b772479a74e94d351440f0">mpsumr</a>(pr,kdim) ! sum kdim reals
    395. 

  395. <a name="l00295"></a>00295       use <span class="keywordflow">mpimod</span>
    396. 

  396. <a name="l00296"></a>00296 
    397. 

  397. <a name="l00297"></a>00297       <span class="keywordtype">real</span> pr(kdim)
    398. 

  398. <a name="l00298"></a>00298       <span class="keywordtype">real</span> tmp(kdim)
    399. 

  399. <a name="l00299"></a>00299 
    400. 

  400. <a name="l00300"></a>00300       call mpi_reduce(pr,tmp,kdim,mpi_rtype,MPI_SUM,NROOT,myworld,mpinfo)
    401. 

  401. <a name="l00301"></a>00301       <span class="keyword">if</span> (mypid == NROOT) pr = tmp
    402. 

  402. <a name="l00302"></a>00302 
    403. 

  403. <a name="l00303"></a>00303       return
    404. 

  404. <a name="l00304"></a>00304 <span class="keyword">      end subroutine mpsumr</span>
    405. 

  405. <a name="l00305"></a>00305 
    406. 

  406. <a name="l00306"></a>00306 <span class="comment">!     ====================</span>
    407. 

  407. <a name="l00307"></a>00307 <span class="comment">!     SUBROUTINE MPSUMBCR</span>
    408. 

  408. <a name="l00308"></a>00308 <span class="comment">!     ====================</span>
    409. 

  409. <a name="l00309"></a>00309 
    410. 

  410. <a name="l00310"></a><a class="code" href="mpimod_8f90.html#ad703e6ecd123e9b8280322e402d57d20">00310</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#ad703e6ecd123e9b8280322e402d57d20">mpsumbcr</a>(pr,kdim) ! sum &amp; broadcast kdim reals
    411. 

  411. <a name="l00311"></a>00311       use <span class="keywordflow">mpimod</span>
    412. 

  412. <a name="l00312"></a>00312 
    413. 

  413. <a name="l00313"></a>00313       <span class="keywordtype">real</span> :: pr(kdim)
    414. 

  414. <a name="l00314"></a>00314       <span class="keywordtype">real</span> :: tmp(kdim)
    415. 

  415. <a name="l00315"></a>00315 
    416. 

  416. <a name="l00316"></a>00316       call mpi_allreduce(pr,tmp,kdim,mpi_rtype,MPI_SUM,myworld,mpinfo)
    417. 

  417. <a name="l00317"></a>00317       pr = tmp
    418. 

  418. <a name="l00318"></a>00318 
    419. 

  419. <a name="l00319"></a>00319       return
    420. 

  420. <a name="l00320"></a>00320 <span class="keyword">      end subroutine mpsumbcr</span>
    421. 

  421. <a name="l00321"></a>00321 
    422. 

  422. <a name="l00322"></a>00322 <span class="comment">!     ==================</span>
    423. 

  423. <a name="l00323"></a>00323 <span class="comment">!     SUBROUTINE MPSTART</span>
    424. 

  424. <a name="l00324"></a>00324 <span class="comment">!     ==================</span>
    425. 

  425. <a name="l00325"></a>00325 
    426. 

  426. <a name="l00326"></a><a class="code" href="mpimod_8f90.html#a41bbd9334a3d0412c73399d699bbb237">00326</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a41bbd9334a3d0412c73399d699bbb237">mpstart</a> <span class="comment">! initialization</span>
    427. 

  427. <a name="l00327"></a>00327       use <span class="keywordflow">mpimod</span>
    428. 

  428. <a name="l00328"></a>00328       <span class="keywordtype">integer</span> :: itest = 0
    429. 

  429. <a name="l00329"></a>00329       <span class="keywordtype">real</span>    :: rtest = 0.0
    430. 

  430. <a name="l00330"></a>00330 
    431. 

  431. <a name="l00331"></a>00331       <span class="keyword">if</span> (kind(itest) == 8) mpi_itype = MPI_INTEGER8
    432. 

  432. <a name="l00332"></a>00332       <span class="keyword">if</span> (kind(rtest) == 8) mpi_rtype = MPI_REAL8
    433. 

  433. <a name="l00333"></a>00333 
    434. 

  434. <a name="l00334"></a>00334       call mpi_init(mpinfo)
    435. 

  435. <a name="l00335"></a>00335       myworld=MPI_COMM_WORLD
    436. 

  436. <a name="l00336"></a>00336 
    437. 

  437. <a name="l00337"></a>00337       call mpi_comm_size(myworld,npro ,mpinfo)
    438. 

  438. <a name="l00338"></a>00338       call mpi_comm_rank(myworld,mypid,mpinfo)
    439. 

  439. <a name="l00339"></a>00339       <span class="keyword">allocate</span>(ympname(npro)) ; ympname(:) = <span class="stringliteral">&#39; &#39;</span>
    440. 

  440. <a name="l00340"></a>00340       call mpi_get_processor_name(ympname(1),ilen,mpinfo)
    441. 

  441. <a name="l00341"></a>00341 
    442. 

  442. <a name="l00342"></a>00342       call mpi_gather(ympname,80,MPI_CHARACTER,   &amp;
    443. 

  443. <a name="l00343"></a>00343                       ympname,80,MPI_CHARACTER,   &amp;
    444. 

  444. <a name="l00344"></a>00344                       NROOT,myworld,mpinfo)
    445. 

  445. <a name="l00345"></a>00345 
    446. 

  446. <a name="l00346"></a>00346       return
    447. 

  447. <a name="l00347"></a>00347 <span class="keyword">      end subroutine mpstart</span>
    448. 

  448. <a name="l00348"></a>00348 
    449. 

  449. <a name="l00349"></a>00349 <span class="comment">!     =================</span>
    450. 

  450. <a name="l00350"></a>00350 <span class="comment">!     SUBROUTINE MPSTOP</span>
    451. 

  451. <a name="l00351"></a>00351 <span class="comment">!     =================</span>
    452. 

  452. <a name="l00352"></a>00352 
    453. 

  453. <a name="l00353"></a><a class="code" href="mpimod_8f90.html#ac80e83b9bc0a4b459fed5f3b79cfafa0">00353</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#ac80e83b9bc0a4b459fed5f3b79cfafa0">mpstop</a>
    454. 

  454. <a name="l00354"></a>00354       use <span class="keywordflow">mpimod</span>
    455. 

  455. <a name="l00355"></a>00355 
    456. 

  456. <a name="l00356"></a>00356       call mpi_barrier(myworld,mpinfo)
    457. 

  457. <a name="l00357"></a>00357       call mpi_finalize(mpinfo)
    458. 

  458. <a name="l00358"></a>00358 
    459. 

  459. <a name="l00359"></a>00359       return
    460. 

  460. <a name="l00360"></a>00360 <span class="keyword">      end subroutine mpstop</span>
    461. 

  461. <a name="l00361"></a>00361 
    462. 

  462. <a name="l00362"></a>00362 <span class="comment">!     ===================</span>
    463. 

  463. <a name="l00363"></a>00363 <span class="comment">!     SUBROUTINE MPREADGP</span>
    464. 

  464. <a name="l00364"></a>00364 <span class="comment">!     ===================</span>
    465. 

  465. <a name="l00365"></a>00365 
    466. 

  466. <a name="l00366"></a><a class="code" href="mpimod_8f90.html#a463456bde27045e2cf286e6e6082b9aa">00366</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a463456bde27045e2cf286e6e6082b9aa">mpreadgp</a>(ktape,p,kdim,klev)
    467. 

  467. <a name="l00367"></a>00367       use <span class="keywordflow">mpimod</span>
    468. 

  468. <a name="l00368"></a>00368 
    469. 

  469. <a name="l00369"></a>00369       <span class="keywordtype">real</span> p(kdim,klev)
    470. 

  470. <a name="l00370"></a>00370       <span class="keywordtype">real</span> z(NLON*NLAT,klev)
    471. 

  471. <a name="l00371"></a>00371 
    472. 

  472. <a name="l00372"></a>00372       z = 0.0
    473. 

  473. <a name="l00373"></a>00373 
    474. 

  474. <a name="l00374"></a>00374       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">read</span> (ktape) z(1:NLON*NLAT,:)
    475. 

  475. <a name="l00375"></a>00375 
    476. 

  476. <a name="l00376"></a>00376       <span class="keyword">if</span> (kdim == NHOR) <span class="keyword">then</span>
    477. 

  477. <a name="l00377"></a>00377        call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(z,p,klev)
    478. 

  478. <a name="l00378"></a>00378       <span class="keyword">else</span>
    479. 

  479. <a name="l00379"></a>00379        <span class="keyword">if</span> (mypid == NROOT) p = z
    480. 

  480. <a name="l00380"></a>00380       <span class="keyword">endif</span>
    481. 

  481. <a name="l00381"></a>00381 
    482. 

  482. <a name="l00382"></a>00382       return
    483. 

  483. <a name="l00383"></a>00383 <span class="keyword">      end subroutine mpreadgp</span>
    484. 

  484. <a name="l00384"></a>00384 
    485. 

  485. <a name="l00385"></a>00385 <span class="comment">!     ====================</span>
    486. 

  486. <a name="l00386"></a>00386 <span class="comment">!     SUBROUTINE MPWRITEGP</span>
    487. 

  487. <a name="l00387"></a>00387 <span class="comment">!     ====================</span>
    488. 

  488. <a name="l00388"></a>00388 
    489. 

  489. <a name="l00389"></a><a class="code" href="mpimod_8f90.html#a3e3ab4b6cd8d7863f7bfc0e74b370488">00389</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a3e3ab4b6cd8d7863f7bfc0e74b370488">mpwritegp</a>(ktape,p,kdim,klev)
    490. 

  490. <a name="l00390"></a>00390       use <span class="keywordflow">mpimod</span>
    491. 

  491. <a name="l00391"></a>00391 
    492. 

  492. <a name="l00392"></a>00392       <span class="keywordtype">real</span> p(kdim,klev)
    493. 

  493. <a name="l00393"></a>00393       <span class="keywordtype">real</span> z(NLON*NLAT,klev)
    494. 

  494. <a name="l00394"></a>00394 
    495. 

  495. <a name="l00395"></a>00395       <span class="keyword">if</span> (kdim == NHOR) <span class="keyword">then</span>
    496. 

  496. <a name="l00396"></a>00396        call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,p,klev)
    497. 

  497. <a name="l00397"></a>00397        <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">write</span>(ktape) z(1:NLON*NLAT,:)
    498. 

  498. <a name="l00398"></a>00398       <span class="keyword">else</span>
    499. 

  499. <a name="l00399"></a>00399        <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">write</span>(ktape) p(1:NLON*NLAT,:)
    500. 

  500. <a name="l00400"></a>00400       <span class="keyword">endif</span>
    501. 

  501. <a name="l00401"></a>00401 
    502. 

  502. <a name="l00402"></a>00402       return
    503. 

  503. <a name="l00403"></a>00403 <span class="keyword">      end subroutine mpwritegp</span>
    504. 

  504. <a name="l00404"></a>00404 
    505. 

  505. <a name="l00405"></a>00405 
    506. 

  506. <a name="l00406"></a>00406 <span class="comment">!     =====================</span>
    507. 

  507. <a name="l00407"></a>00407 <span class="comment">!     SUBROUTINE MPWRITEGPH</span>
    508. 

  508. <a name="l00408"></a>00408 <span class="comment">!     =====================</span>
    509. 

  509. <a name="l00409"></a>00409 
    510. 

  510. <a name="l00410"></a><a class="code" href="mpimod_8f90.html#a325e1b8f8412b422a06fb7558f212f7e">00410</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a325e1b8f8412b422a06fb7558f212f7e">mpwritegph</a>(ktape,p,kdim,klev,ihead)
    511. 

  511. <a name="l00411"></a>00411       use <span class="keywordflow">mpimod</span>
    512. 

  512. <a name="l00412"></a>00412 
    513. 

  513. <a name="l00413"></a>00413       <span class="keywordtype">real</span> p(kdim,klev)
    514. 

  514. <a name="l00414"></a>00414       <span class="keywordtype">real</span> z(NLON*NLAT,klev)
    515. 

  515. <a name="l00415"></a>00415 <span class="comment">!</span>
    516. 

  516. <a name="l00416"></a>00416       <span class="keywordtype">real(kind=4)</span> :: zp(kdim,klev)
    517. 

  517. <a name="l00417"></a>00417       <span class="keywordtype">real(kind=4)</span> :: zz(NLON*NLAT,klev)
    518. 

  518. <a name="l00418"></a>00418 <span class="comment">!</span>
    519. 

  519. <a name="l00419"></a>00419 
    520. 

  520. <a name="l00420"></a>00420       <span class="keywordtype">integer</span> ihead(8)
    521. 

  521. <a name="l00421"></a>00421 
    522. 

  522. <a name="l00422"></a>00422       <span class="keyword">if</span> (kdim == NHOR) <span class="keyword">then</span>
    523. 

  523. <a name="l00423"></a>00423        call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,p,klev)
    524. 

  524. <a name="l00424"></a>00424        <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
    525. 

  525. <a name="l00425"></a>00425           <span class="keyword">write</span>(ktape) ihead
    526. 

  526. <a name="l00426"></a>00426           zz(:,:)=z(:,:)
    527. 

  527. <a name="l00427"></a>00427           <span class="keyword">write</span>(ktape) zz(1:NLON*NLAT,:)
    528. 

  528. <a name="l00428"></a>00428        <span class="keyword">endif</span>
    529. 

  529. <a name="l00429"></a>00429       <span class="keyword">else</span>
    530. 

  530. <a name="l00430"></a>00430        <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">then</span>
    531. 

  531. <a name="l00431"></a>00431           <span class="keyword">write</span>(ktape) ihead
    532. 

  532. <a name="l00432"></a>00432           zp(:,:)=p(:,:)
    533. 

  533. <a name="l00433"></a>00433           <span class="keyword">write</span>(ktape) zp(1:NLON*NLAT,:)
    534. 

  534. <a name="l00434"></a>00434        <span class="keyword">endif</span>
    535. 

  535. <a name="l00435"></a>00435       <span class="keyword">endif</span>
    536. 

  536. <a name="l00436"></a>00436 
    537. 

  537. <a name="l00437"></a>00437       return
    538. 

  538. <a name="l00438"></a>00438 <span class="keyword">      end subroutine mpwritegph</span>
    539. 

  539. <a name="l00439"></a>00439 
    540. 

  540. <a name="l00440"></a>00440 <span class="comment">!     ===================</span>
    541. 

  541. <a name="l00441"></a>00441 <span class="comment">!     SUBROUTINE MPREADSP</span>
    542. 

  542. <a name="l00442"></a>00442 <span class="comment">!     ===================</span>
    543. 

  543. <a name="l00443"></a>00443 
    544. 

  544. <a name="l00444"></a><a class="code" href="mpimod_8f90.html#a4aceba15459fefd864a0ed3313b0073d">00444</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a4aceba15459fefd864a0ed3313b0073d">mpreadsp</a>(ktape,p,kdim,klev)
    545. 

  545. <a name="l00445"></a>00445       use <span class="keywordflow">mpimod</span>
    546. 

  546. <a name="l00446"></a>00446 
    547. 

  547. <a name="l00447"></a>00447       <span class="keywordtype">real</span> p(kdim,klev)
    548. 

  548. <a name="l00448"></a>00448       <span class="keywordtype">real</span> z(NESP,klev)
    549. 

  549. <a name="l00449"></a>00449 
    550. 

  550. <a name="l00450"></a>00450       z = 0.0
    551. 

  551. <a name="l00451"></a>00451       <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">read</span>(ktape) z(1:NRSP,:)
    552. 

  552. <a name="l00452"></a>00452       <span class="keyword">if</span> (kdim == NSPP) <span class="keyword">then</span>
    553. 

  553. <a name="l00453"></a>00453          call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(z,p,klev)
    554. 

  554. <a name="l00454"></a>00454       <span class="keyword">else</span>
    555. 

  555. <a name="l00455"></a>00455          <span class="keyword">if</span> (mypid == NROOT) p = z
    556. 

  556. <a name="l00456"></a>00456       <span class="keyword">endif</span>
    557. 

  557. <a name="l00457"></a>00457 
    558. 

  558. <a name="l00458"></a>00458       return
    559. 

  559. <a name="l00459"></a>00459 <span class="keyword">      end subroutine mpreadsp</span>
    560. 

  560. <a name="l00460"></a>00460 
    561. 

  561. <a name="l00461"></a>00461 <span class="comment">!     ====================</span>
    562. 

  562. <a name="l00462"></a>00462 <span class="comment">!     SUBROUTINE MPWRITESP</span>
    563. 

  563. <a name="l00463"></a>00463 <span class="comment">!     ====================</span>
    564. 

  564. <a name="l00464"></a>00464 
    565. 

  565. <a name="l00465"></a><a class="code" href="mpimod_8f90.html#aca5ad2279542f783c1d862333da96744">00465</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#aca5ad2279542f783c1d862333da96744">mpwritesp</a>(ktape,p,kdim,klev)
    566. 

  566. <a name="l00466"></a>00466       use <span class="keywordflow">mpimod</span>
    567. 

  567. <a name="l00467"></a>00467 
    568. 

  568. <a name="l00468"></a>00468       <span class="keywordtype">real</span> p(kdim,klev)
    569. 

  569. <a name="l00469"></a>00469       <span class="keywordtype">real</span> z(NESP,klev)
    570. 

  570. <a name="l00470"></a>00470 
    571. 

  571. <a name="l00471"></a>00471       <span class="keyword">if</span> (kdim == NSPP) <span class="keyword">then</span>
    572. 

  572. <a name="l00472"></a>00472          call <a class="code" href="mpimod_8f90.html#ac053a575b1230f8e4a296164dba5ab27">mpgasp</a>(z,p,klev)
    573. 

  573. <a name="l00473"></a>00473          <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">write</span>(ktape) z(1:NRSP,:)
    574. 

  574. <a name="l00474"></a>00474       <span class="keyword">else</span>
    575. 

  575. <a name="l00475"></a>00475          <span class="keyword">if</span> (mypid == NROOT) <span class="keyword">write</span>(ktape) p(1:NRSP,:)
    576. 

  576. <a name="l00476"></a>00476       <span class="keyword">endif</span>
    577. 

  577. <a name="l00477"></a>00477 
    578. 

  578. <a name="l00478"></a>00478       return
    579. 

  579. <a name="l00479"></a>00479 <span class="keyword">      end subroutine mpwritesp</span>
    580. 

  580. <a name="l00480"></a>00480 
    581. 

  581. <a name="l00481"></a>00481 
    582. 

  582. <a name="l00482"></a>00482 <span class="comment">!     ===================</span>
    583. 

  583. <a name="l00483"></a>00483 <span class="comment">!     SUBROUTINE MPI_INFO</span>
    584. 

  584. <a name="l00484"></a>00484 <span class="comment">!     ===================</span>
    585. 

  585. <a name="l00485"></a>00485 
    586. 

  586. <a name="l00486"></a><a class="code" href="mpimod_8f90.html#aa6e5f06de5db1764ec5ee24c21bae378">00486</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#aa6e5f06de5db1764ec5ee24c21bae378">mpi_info</a>(nprocess,npid)    ! get nproc and pid
    587. 

  587. <a name="l00487"></a>00487       use <span class="keywordflow">mpimod</span>
    588. 

  588. <a name="l00488"></a>00488 
    589. 

  589. <a name="l00489"></a>00489       myworld=MPI_COMM_WORLD
    590. 

  590. <a name="l00490"></a>00490 
    591. 

  591. <a name="l00491"></a>00491       call mpi_comm_size(myworld,nprocess,mpinfo)
    592. 

  592. <a name="l00492"></a>00492       call mpi_comm_rank(myworld,npid,mpinfo)
    593. 

  593. <a name="l00493"></a>00493 
    594. 

  594. <a name="l00494"></a>00494       return
    595. 

  595. <a name="l00495"></a>00495 <span class="keyword">      end subroutine mpi_info</span>
    596. 

  596. <a name="l00496"></a>00496 
    597. 

  597. <a name="l00497"></a>00497 
    598. 

  598. <a name="l00498"></a>00498 <span class="comment">!     ==================</span>
    599. 

  599. <a name="l00499"></a>00499 <span class="comment">!     SUBROUTINE MPGETSP</span>
    600. 

  600. <a name="l00500"></a>00500 <span class="comment">!     ==================</span>
    601. 

  601. <a name="l00501"></a>00501 
    602. 

  602. <a name="l00502"></a><a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">00502</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#acf82ae878fff75151cab59cdd0925ae0">mpgetsp</a>(yn,p,kdim,klev)
    603. 

  603. <a name="l00503"></a>00503       use <span class="keywordflow">mpimod</span>
    604. 

  604. <a name="l00504"></a>00504 
    605. 

  605. <a name="l00505"></a>00505       <span class="keywordtype">character (len=*)</span> :: yn
    606. 

  606. <a name="l00506"></a>00506       <span class="keywordtype">real</span> :: p(kdim,klev)
    607. 

  607. <a name="l00507"></a>00507       <span class="keywordtype">real</span> :: z(NESP,klev)
    608. 

  608. <a name="l00508"></a>00508 
    609. 

  609. <a name="l00509"></a>00509       z(:,:) = 0.0
    610. 

  610. <a name="l00510"></a>00510       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(yn,z,NRSP,NESP,klev)
    611. 

  611. <a name="l00511"></a>00511       call <a class="code" href="mpimod_8f90.html#a0c5adf4e8c7e39cf5a1038a1d34ebf30">mpscsp</a>(z,p,klev)
    612. 

  612. <a name="l00512"></a>00512 
    613. 

  613. <a name="l00513"></a>00513       return
    614. 

  614. <a name="l00514"></a>00514 <span class="keyword">      end subroutine mpgetsp</span>
    615. 

  615. <a name="l00515"></a>00515 
    616. 

  616. <a name="l00516"></a>00516 
    617. 

  617. <a name="l00517"></a>00517 <span class="comment">!     ==================</span>
    618. 

  618. <a name="l00518"></a>00518 <span class="comment">!     SUBROUTINE MPGETGP</span>
    619. 

  619. <a name="l00519"></a>00519 <span class="comment">!     ==================</span>
    620. 

  620. <a name="l00520"></a>00520 
    621. 

  621. <a name="l00521"></a><a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">00521</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a58d54c2e0590e63a7459417831afe5cf">mpgetgp</a>(yn,p,kdim,klev)
    622. 

  622. <a name="l00522"></a>00522       use <span class="keywordflow">mpimod</span>
    623. 

  623. <a name="l00523"></a>00523 
    624. 

  624. <a name="l00524"></a>00524       <span class="keywordtype">character (len=*)</span> :: yn
    625. 

  625. <a name="l00525"></a>00525       <span class="keywordtype">real</span> :: p(kdim,klev)
    626. 

  626. <a name="l00526"></a>00526       <span class="keywordtype">real</span> :: z(NUGP,klev)
    627. 

  627. <a name="l00527"></a>00527 
    628. 

  628. <a name="l00528"></a>00528       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#af0f1ce9b6762aa2537cc22d5fc319b7c">get_restart_array</a>(yn,z,NUGP,NUGP,klev)
    629. 

  629. <a name="l00529"></a>00529       call <a class="code" href="mpimod_8f90.html#ac66e76c6144dfeadbc03bc5817553250">mpscgp</a>(z,p,klev)
    630. 

  630. <a name="l00530"></a>00530 
    631. 

  631. <a name="l00531"></a>00531       return
    632. 

  632. <a name="l00532"></a>00532 <span class="keyword">      end subroutine mpgetgp</span>
    633. 

  633. <a name="l00533"></a>00533 
    634. 

  634. <a name="l00534"></a>00534 
    635. 

  635. <a name="l00535"></a>00535 <span class="comment">!     ==================</span>
    636. 

  636. <a name="l00536"></a>00536 <span class="comment">!     SUBROUTINE MPPUTSP</span>
    637. 

  637. <a name="l00537"></a>00537 <span class="comment">!     ==================</span>
    638. 

  638. <a name="l00538"></a>00538 
    639. 

  639. <a name="l00539"></a><a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">00539</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a79c341b7b52bf44470898581072660b8">mpputsp</a>(yn,p,kdim,klev)
    640. 

  640. <a name="l00540"></a>00540       use <span class="keywordflow">mpimod</span>
    641. 

  641. <a name="l00541"></a>00541 
    642. 

  642. <a name="l00542"></a>00542       <span class="keywordtype">character (len=*)</span> :: yn
    643. 

  643. <a name="l00543"></a>00543       <span class="keywordtype">real</span> :: p(kdim,klev)
    644. 

  644. <a name="l00544"></a>00544       <span class="keywordtype">real</span> :: z(NESP,klev)
    645. 

  645. <a name="l00545"></a>00545 
    646. 

  646. <a name="l00546"></a>00546       call <a class="code" href="mpimod_8f90.html#ac053a575b1230f8e4a296164dba5ab27">mpgasp</a>(z,p,klev)
    647. 

  647. <a name="l00547"></a>00547       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(yn,z,NRSP,NESP,klev)
    648. 

  648. <a name="l00548"></a>00548 
    649. 

  649. <a name="l00549"></a>00549       return
    650. 

  650. <a name="l00550"></a>00550 <span class="keyword">      end subroutine mpputsp</span>
    651. 

  651. <a name="l00551"></a>00551 
    652. 

  652. <a name="l00552"></a>00552 
    653. 

  653. <a name="l00553"></a>00553 <span class="comment">!     ==================</span>
    654. 

  654. <a name="l00554"></a>00554 <span class="comment">!     SUBROUTINE MPPUTGP</span>
    655. 

  655. <a name="l00555"></a>00555 <span class="comment">!     ==================</span>
    656. 

  656. <a name="l00556"></a>00556 
    657. 

  657. <a name="l00557"></a><a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">00557</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a7e675330db7b46cf0bf0cc8edd2d413c">mpputgp</a>(yn,p,kdim,klev)
    658. 

  658. <a name="l00558"></a>00558       use <span class="keywordflow">mpimod</span>
    659. 

  659. <a name="l00559"></a>00559 
    660. 

  660. <a name="l00560"></a>00560       <span class="keywordtype">character (len=*)</span> :: yn
    661. 

  661. <a name="l00561"></a>00561       <span class="keywordtype">real</span> :: p(kdim,klev)
    662. 

  662. <a name="l00562"></a>00562       <span class="keywordtype">real</span> :: z(NUGP,klev)
    663. 

  663. <a name="l00563"></a>00563 
    664. 

  664. <a name="l00564"></a>00564       call <a class="code" href="mpimod_8f90.html#aaa1210298789f4fd7b7702c276eb80a9">mpgagp</a>(z,p,klev)
    665. 

  665. <a name="l00565"></a>00565       <span class="keyword">if</span> (mypid == NROOT) call <a class="code" href="restartmod_8f90.html#a52485001dbbaed032e48d894e6302c22">put_restart_array</a>(yn,z,NUGP,NUGP,klev)
    666. 

  666. <a name="l00566"></a>00566 
    667. 

  667. <a name="l00567"></a>00567       return
    668. 

  668. <a name="l00568"></a>00568 <span class="keyword">      end subroutine mpputgp</span>
    669. 

  669. <a name="l00569"></a>00569 
    670. 

  670. <a name="l00570"></a>00570 
    671. 

  671. <a name="l00571"></a>00571 <span class="comment">!!     ===================</span>
    672. 

  672. <a name="l00572"></a>00572 <span class="comment">!!     SUBROUTINE MPSURFGP</span>
    673. 

  673. <a name="l00573"></a>00573 <span class="comment">!!     ===================</span>
    674. 

  674. <a name="l00574"></a>00574 <span class="comment">!</span>
    675. 

  675. <a name="l00575"></a>00575 <span class="comment">!      subroutine mpsurfgp(yn,p,kdim,klev)</span>
    676. 

  676. <a name="l00576"></a>00576 <span class="comment">!      use mpimod</span>
    677. 

  677. <a name="l00577"></a>00577 <span class="comment">!</span>
    678. 

  678. <a name="l00578"></a>00578 <span class="comment">!      character (len=*) :: yn</span>
    679. 

  679. <a name="l00579"></a>00579 <span class="comment">!      real :: p(kdim,klev)</span>
    680. 

  680. <a name="l00580"></a>00580 <span class="comment">!      real :: z(NUGP,klev)</span>
    681. 

  681. <a name="l00581"></a>00581 <span class="comment">!</span>
    682. 

  682. <a name="l00582"></a>00582 <span class="comment">!      if (mypid == NROOT) call get_surf_array(yn,z,NUGP,NUGP,klev,iread)</span>
    683. 

  683. <a name="l00583"></a>00583 <span class="comment">!      call mpbci(iread)</span>
    684. 

  684. <a name="l00584"></a>00584 <span class="comment">!      if (iread == 1) call mpscgp(z,p,klev)</span>
    685. 

  685. <a name="l00585"></a>00585 <span class="comment">!</span>
    686. 

  686. <a name="l00586"></a>00586 <span class="comment">!      return</span>
    687. 

  687. <a name="l00587"></a>00587 <span class="comment">!      end subroutine mpsurfgp</span>
    688. 

  688. <a name="l00588"></a>00588 <span class="comment">!</span>
    689. 

  689. <a name="l00589"></a>00589 <span class="comment">!</span>
    690. 

  690. <a name="l00590"></a>00590 <span class="comment">!!     =====================</span>
    691. 

  691. <a name="l00591"></a>00591 <span class="comment">!!     SUBROUTINE MPSURFYEAR</span>
    692. 

  692. <a name="l00592"></a>00592 <span class="comment">!!     =====================</span>
    693. 

  693. <a name="l00593"></a>00593 <span class="comment">!</span>
    694. 

  694. <a name="l00594"></a>00594 <span class="comment">!      subroutine mpsurfyear(yn,p,kdim,kmon)</span>
    695. 

  695. <a name="l00595"></a>00595 <span class="comment">!      use mpimod</span>
    696. 

  696. <a name="l00596"></a>00596 <span class="comment">!</span>
    697. 

  697. <a name="l00597"></a>00597 <span class="comment">!      character (len=*) :: yn</span>
    698. 

  698. <a name="l00598"></a>00598 <span class="comment">!      real :: p(kdim,kmon)</span>
    699. 

  699. <a name="l00599"></a>00599 <span class="comment">!      real :: z(NUGP,kmon)</span>
    700. 

  700. <a name="l00600"></a>00600 <span class="comment">!</span>
    701. 

  701. <a name="l00601"></a>00601 <span class="comment">!      if (mypid == NROOT) call get_surf_year(yn,z,NUGP,kmon,iread)</span>
    702. 

  702. <a name="l00602"></a>00602 <span class="comment">!      call mpbci(iread)</span>
    703. 

  703. <a name="l00603"></a>00603 <span class="comment">!      if (iread == 1) call mpscgp(z,p,kmon)</span>
    704. 

  704. <a name="l00604"></a>00604 <span class="comment">!</span>
    705. 

  705. <a name="l00605"></a>00605 <span class="comment">!      return</span>
    706. 

  706. <a name="l00606"></a>00606 <span class="comment">!      end subroutine mpsurfyear</span>
    707. 

  707. <a name="l00607"></a>00607 <span class="comment">!</span>
    708. 

  708. <a name="l00608"></a>00608 <span class="comment">!</span>
    709. 

  709. <a name="l00609"></a>00609 <span class="comment">!!     =====================</span>
    710. 

  710. <a name="l00610"></a>00610 <span class="comment">!!     SUBROUTINE MP3DYEAR</span>
    711. 

  711. <a name="l00611"></a>00611 <span class="comment">!!     =====================</span>
    712. 

  712. <a name="l00612"></a>00612 <span class="comment">!</span>
    713. 

  713. <a name="l00613"></a>00613 <span class="comment">!      subroutine mp3dyear(yn,p,kdim,klev,kmon)</span>
    714. 

  714. <a name="l00614"></a>00614 <span class="comment">!      use mpimod</span>
    715. 

  715. <a name="l00615"></a>00615 <span class="comment">!</span>
    716. 

  716. <a name="l00616"></a>00616 <span class="comment">!      character (len=*) :: yn</span>
    717. 

  717. <a name="l00617"></a>00617 <span class="comment">!      real :: p(kdim,klev,kmon)</span>
    718. 

  718. <a name="l00618"></a>00618 <span class="comment">!      real :: z(NUGP,klev,kmon)</span>
    719. 

  719. <a name="l00619"></a>00619 <span class="comment">!</span>
    720. 

  720. <a name="l00620"></a>00620 <span class="comment">!      if (mypid == NROOT) call get_3d_year(yn,z,NUGP,klev,kmon,iread)</span>
    721. 

  721. <a name="l00621"></a>00621 <span class="comment">!      call mpbci(iread)</span>
    722. 

  722. <a name="l00622"></a>00622 <span class="comment">!      if (iread == 1) call mpscgp(z,p,klev*kmon)</span>
    723. 

  723. <a name="l00623"></a>00623 <span class="comment">!</span>
    724. 

  724. <a name="l00624"></a>00624 <span class="comment">!      return</span>
    725. 

  725. <a name="l00625"></a>00625 <span class="comment">!      end subroutine mp3dyear</span>
    726. 

  726. <a name="l00626"></a>00626 
    727. 

  727. <a name="l00627"></a>00627 
    728. 

  728. <a name="l00628"></a>00628 <span class="comment">!     ===================</span>
    729. 

  729. <a name="l00629"></a>00629 <span class="comment">!     SUBROUTINE MPMAXVAL</span>
    730. 

  730. <a name="l00630"></a>00630 <span class="comment">!     ===================</span>
    731. 

  731. <a name="l00631"></a>00631 
    732. 

  732. <a name="l00632"></a><a class="code" href="mpimod_8f90.html#a1b6ac2b98059a43359ac0edfeb9c2ad7">00632</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a1b6ac2b98059a43359ac0edfeb9c2ad7">mpmaxval</a>(p,kdim,klev,pmax)
    733. 

  733. <a name="l00633"></a>00633       use <span class="keywordflow">mpimod</span>
    734. 

  734. <a name="l00634"></a>00634 
    735. 

  735. <a name="l00635"></a>00635       <span class="keywordtype">real</span> :: p(kdim,klev)
    736. 

  736. <a name="l00636"></a>00636 
    737. 

  737. <a name="l00637"></a>00637       zmax = maxval(p(:,:))
    738. 

  738. <a name="l00638"></a>00638       call mpi_allreduce(zmax,pmax,1,mpi_rtype,MPI_MAX,myworld,mpinfo)
    739. 

  739. <a name="l00639"></a>00639 
    740. 

  740. <a name="l00640"></a>00640       return
    741. 

  741. <a name="l00641"></a>00641 <span class="keyword">      end subroutine mpmaxval</span>
    742. 

  742. <a name="l00642"></a>00642 
    743. 

  743. <a name="l00643"></a>00643 
    744. 

  744. <a name="l00644"></a>00644 <span class="comment">!     ===================</span>
    745. 

  745. <a name="l00645"></a>00645 <span class="comment">!     SUBROUTINE MPSUMVAL</span>
    746. 

  746. <a name="l00646"></a>00646 <span class="comment">!     ===================</span>
    747. 

  747. <a name="l00647"></a>00647 
    748. 

  748. <a name="l00648"></a><a class="code" href="mpimod_8f90.html#ac1dfb34daad89cf72ff04b6a58919b2b">00648</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#ac1dfb34daad89cf72ff04b6a58919b2b">mpsumval</a>(p,kdim,klev,psum)
    749. 

  749. <a name="l00649"></a>00649       use <span class="keywordflow">mpimod</span>
    750. 

  750. <a name="l00650"></a>00650 
    751. 

  751. <a name="l00651"></a>00651       <span class="keywordtype">real</span> :: p(kdim,klev)
    752. 

  752. <a name="l00652"></a>00652 
    753. 

  753. <a name="l00653"></a>00653       zsum = sum(p(:,:))
    754. 

  754. <a name="l00654"></a>00654       call mpi_allreduce(zsum,psum,1,mpi_rtype,MPI_SUM,myworld,mpinfo)
    755. 

  755. <a name="l00655"></a>00655 
    756. 

  756. <a name="l00656"></a>00656       return
    757. 

  757. <a name="l00657"></a>00657 <span class="keyword">      end subroutine mpsumval</span>
    758. 

  758. <a name="l00658"></a>00658 
    759. 

  759. <a name="l00659"></a>00659 <span class="comment">!     Some dummy declarations that are use in multirun mode only</span>
    760. 

  760. <a name="l00660"></a>00660 
    761. 

  761. <a name="l00661"></a><a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">00661</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#af3212261e3ce775f26d09859c337b760">mrdiff</a>(p,d,n)
    762. 

  762. <a name="l00662"></a>00662       <span class="keywordtype">real</span> :: p(n)
    763. 

  763. <a name="l00663"></a>00663       <span class="keywordtype">real</span> :: d(n)
    764. 

  764. <a name="l00664"></a>00664       return
    765. 

  765. <a name="l00665"></a>00665 <span class="keyword">      end</span>
    766. 

  766. <a name="l00666"></a>00666 
    767. 

  767. <a name="l00667"></a><a class="code" href="mpimod_8f90.html#a5d2bb9cfe68e5feb6de6b359f04398e3">00667</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#a5d2bb9cfe68e5feb6de6b359f04398e3">mrsum</a>(k) ! sum up 1 integer
    768. 

  768. <a name="l00668"></a>00668       return
    769. 

  769. <a name="l00669"></a>00669 <span class="keyword">      end</span>
    770. 

  770. <a name="l00670"></a>00670 
    771. 

  771. <a name="l00671"></a><a class="code" href="mpimod_8f90.html#ab1311e17e35732047db4b93e1bb6c984">00671</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#ab1311e17e35732047db4b93e1bb6c984">mrbci</a>(k) ! broadcast 1 integer
    772. 

  772. <a name="l00672"></a>00672       return
    773. 

  773. <a name="l00673"></a>00673 <span class="keyword">      end</span>
    774. 

  774. <a name="l00674"></a>00674 
    775. 

  775. <a name="l00675"></a><a class="code" href="mpimod_8f90.html#acb4a2403b5f65a70e7e5ff01ea4577f7">00675</a>       <span class="keyword">subroutine </span><a class="code" href="mpimod_8f90.html#acb4a2403b5f65a70e7e5ff01ea4577f7">mrdimensions</a>
    776. 

  776. <a name="l00676"></a>00676       return
    777. 

  777. <a name="l00677"></a>00677 <span class="keyword">      end </span>
    778. 

  778. <a name="l00678"></a>00678 
    779. 

  779. <a name="l00679"></a>00679 
    780. 

  780. </pre></div></div>
    781. 

  781. </div>
    782. 

  782.   <div id="nav-path" class="navpath">
    783. 

  783.     <ul>
    784. 

  784.       <li class="navelem"><a class="el" href="mpimod_8f90.html">mpimod.f90</a>      </li>
    785. 

  785. <!-- window showing the filter options -->
    786. 

  786. <div id="MSearchSelectWindow"
    787. 

  787.      onmouseover="return searchBox.OnSearchSelectShow()"
    788. 

  788.      onmouseout="return searchBox.OnSearchSelectHide()"
    789. 

  789.      onkeydown="return searchBox.OnSearchSelectKey(event)">
    790. 

  790. <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>
    791. 

  791. 

  792. <!-- iframe showing the search results (closed by default) -->
    793. 

  793. <div id="MSearchResultsWindow">
    794. 

  794. <iframe src="javascript:void(0)" frameborder="0" 
    795. 

  795.         name="MSearchResults" id="MSearchResults">
    796. 

  796. </iframe>
    797. 

  797. </div>
    798. 

  798. 

  799. 

  800.     <li class="footer">Generated on Wed Sep 21 2011 12:35:46 for PUMA by
    801. 

  801.     <a href="http://www.doxygen.org/index.html">
    802. 

  802.     <img class="footer" src="doxygen.png" alt="doxygen"/></a> 1.7.5.1 </li>
    803. 

  803.    </ul>
    804. 

  804.  </div>
    805. 

  805. 

  806. 

  807. </body>
    808. 

  808. </html>
    809.