123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215 |
- <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
- <html xmlns="http://www.w3.org/1999/xhtml">
- <head>
- <meta http-equiv="Content-Type" content="text/xhtml;charset=UTF-8"/>
- <title>PUMA: /Users/home/WC/puma/src/gaussmod.f90 Source File</title>
- <link href="tabs.css" rel="stylesheet" type="text/css"/>
- <link href="doxygen.css" rel="stylesheet" type="text/css" />
- <link href="navtree.css" rel="stylesheet" type="text/css"/>
- <script type="text/javascript" src="jquery.js"></script>
- <script type="text/javascript" src="resize.js"></script>
- <script type="text/javascript" src="navtree.js"></script>
- <script type="text/javascript">
- $(document).ready(initResizable);
- </script>
- <link href="search/search.css" rel="stylesheet" type="text/css"/>
- <script type="text/javascript" src="search/search.js"></script>
- <script type="text/javascript">
- $(document).ready(function() { searchBox.OnSelectItem(0); });
- </script>
- </head>
- <body>
- <div id="top"><!-- do not remove this div! -->
- <div id="titlearea">
- <table cellspacing="0" cellpadding="0">
- <tbody>
- <tr style="height: 56px;">
-
- <td id="projectlogo"><img alt="Logo" src="puma103.jpg"/></td>
-
-
- <td style="padding-left: 0.5em;">
- <div id="projectname">PUMA
-  <span id="projectnumber">219</span>
- </div>
- <div id="projectbrief">Portable University Model of the Atmosphere</div>
- </td>
-
-
-
- </tr>
- </tbody>
- </table>
- </div>
- <!-- Generated by Doxygen 1.7.5.1 -->
- <script type="text/javascript">
- var searchBox = new SearchBox("searchBox", "search",false,'Search');
- </script>
- <div id="navrow1" class="tabs">
- <ul class="tablist">
- <li><a href="index.html"><span>Main Page</span></a></li>
- <li><a href="annotated.html"><span>Data Types List</span></a></li>
- <li class="current"><a href="files.html"><span>Files</span></a></li>
- <li>
- <div id="MSearchBox" class="MSearchBoxInactive">
- <span class="left">
- <img id="MSearchSelect" src="search/mag_sel.png"
- onmouseover="return searchBox.OnSearchSelectShow()"
- onmouseout="return searchBox.OnSearchSelectHide()"
- alt=""/>
- <input type="text" id="MSearchField" value="Search" accesskey="S"
- onfocus="searchBox.OnSearchFieldFocus(true)"
- onblur="searchBox.OnSearchFieldFocus(false)"
- onkeyup="searchBox.OnSearchFieldChange(event)"/>
- </span><span class="right">
- <a id="MSearchClose" href="javascript:searchBox.CloseResultsWindow()"><img id="MSearchCloseImg" border="0" src="search/close.png" alt=""/></a>
- </span>
- </div>
- </li>
- </ul>
- </div>
- <div id="navrow2" class="tabs2">
- <ul class="tablist">
- <li><a href="files.html"><span>File List</span></a></li>
- <li><a href="globals.html"><span>File Members</span></a></li>
- </ul>
- </div>
- </div>
- <div id="side-nav" class="ui-resizable side-nav-resizable">
- <div id="nav-tree">
- <div id="nav-tree-contents">
- </div>
- </div>
- <div id="splitbar" style="-moz-user-select:none;"
- class="ui-resizable-handle">
- </div>
- </div>
- <script type="text/javascript">
- initNavTree('gaussmod_8f90.html','');
- </script>
- <div id="doc-content">
- <div class="header">
- <div class="headertitle">
- <div class="title">/Users/home/WC/puma/src/gaussmod.f90</div> </div>
- </div>
- <div class="contents">
- <a href="gaussmod_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>
- <a name="l00002"></a>00002 <span class="comment">! SUBROUTINE INIGAU</span>
- <a name="l00003"></a>00003 <span class="comment">! =================</span>
- <a name="l00004"></a>00004
- <a name="l00005"></a><a class="code" href="gaussmod_8f90.html#a841a2f8e9025371eddc985235e1831ab">00005</a> <span class="keyword">subroutine </span><a class="code" href="gaussmod_8f90.html#a841a2f8e9025371eddc985235e1831ab">inigau</a>(klat,pz0,pzw) ! pz0 & pzw are (kind=8) reals !!!
- <a name="l00006"></a>00006 <span class="keyword">implicit none</span>
- <a name="l00007"></a>00007 <span class="keywordtype">integer</span> :: klat <span class="comment">! Number of Gaussian latitudes</span>
- <a name="l00008"></a>00008 <span class="keywordtype">real (kind=8)</span> :: pz0(klat) <span class="comment">! Gaussian abscissas</span>
- <a name="l00009"></a>00009 <span class="keywordtype">real (kind=8)</span> :: pzw(klat) <span class="comment">! Gaussian weights</span>
- <a name="l00010"></a>00010 <span class="keywordtype">integer</span> :: jlat <span class="comment">! Latitudinal loop index</span>
- <a name="l00011"></a>00011 <span class="keywordtype">integer</span> :: jiter <span class="comment">! Iteration loop index</span>
- <a name="l00012"></a>00012 <span class="keywordtype">integer</span> , <span class="keywordtype">parameter</span> :: NITER = 50 <span class="comment">! Maximum # of iterations</span>
- <a name="l00013"></a>00013 <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">parameter</span> :: PI = 3.14159265358979_8
- <a name="l00014"></a>00014 <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">parameter</span> :: ZEPS = 1.0e-16 <span class="comment">! Convergence criterion</span>
- <a name="l00015"></a>00015 <span class="keywordtype">real (kind=8)</span> :: z0,z1,z2,z3,z4,z5
- <a name="l00016"></a>00016 <span class="keywordtype">real (kind=8)</span> :: ql,qld
- <a name="l00017"></a>00017
- <a name="l00018"></a>00018 <span class="comment">! Compute Gaussian abscissas & weights</span>
- <a name="l00019"></a>00019
- <a name="l00020"></a>00020 z0 = PI / (2*klat+1)
- <a name="l00021"></a>00021 z1 = 1.0_8 / (klat*klat*8)
- <a name="l00022"></a>00022 z4 = 2.0_8 / (klat*klat)
- <a name="l00023"></a>00023
- <a name="l00024"></a>00024 <span class="keyword">do</span> jlat = 1 , klat/2
- <a name="l00025"></a>00025 z2 = z0 * (2*jlat - 0.5_8)
- <a name="l00026"></a>00026 z2 = cos(z2 + z1 / tan(z2))
- <a name="l00027"></a>00027 <span class="keyword">do</span> jiter = 1 , NITER
- <a name="l00028"></a>00028 z3 = ql(klat,z2) * qld(klat,z2)
- <a name="l00029"></a>00029 z2 = z2 - z3
- <a name="l00030"></a>00030 <span class="keyword">if</span> (abs(z3) < ZEPS) exit <span class="comment">! converged</span>
- <a name="l00031"></a>00031 <span class="keyword">enddo</span> <span class="comment">! jiter</span>
- <a name="l00032"></a>00032 z5 = ql(klat-1,z2) / sqrt(klat - 0.5_8)
- <a name="l00033"></a>00033 pz0(jlat) = z2
- <a name="l00034"></a>00034 pzw(jlat) = z4 * (1.0_8 - z2 * z2) / (z5 * z5)
- <a name="l00035"></a>00035 pz0(klat-jlat+1) = -z2
- <a name="l00036"></a>00036 pzw(klat-jlat+1) = pzw(jlat)
- <a name="l00037"></a>00037 <span class="keyword">enddo</span> <span class="comment">! jlat</span>
- <a name="l00038"></a>00038
- <a name="l00039"></a>00039 return
- <a name="l00040"></a>00040 <span class="keyword">end subroutine inigau</span>
- <a name="l00041"></a>00041
- <a name="l00042"></a>00042 <span class="comment">! ===========</span>
- <a name="l00043"></a>00043 <span class="comment">! FUNCTION QL</span>
- <a name="l00044"></a>00044 <span class="comment">! ===========</span>
- <a name="l00045"></a>00045
- <a name="l00046"></a><a class="code" href="gaussmod_8f90.html#a278a9f628839bb589bfb00f5ece28891">00046</a> <span class="keyword">real (kind=8) </span><span class="keyword">function </span><a class="code" href="gaussmod_8f90.html#a278a9f628839bb589bfb00f5ece28891">ql</a>(k,p)
- <a name="l00047"></a>00047 <span class="keyword">implicit none</span>
- <a name="l00048"></a>00048 <span class="keywordtype">integer</span> , <span class="keywordtype">intent(IN)</span> :: k
- <a name="l00049"></a>00049 <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">intent(IN)</span> :: p
- <a name="l00050"></a>00050 <span class="keywordtype">real (kind=8)</span> :: z0,z1,z2,z3,z4
- <a name="l00051"></a>00051 <span class="keywordtype">integer</span> :: j
- <a name="l00052"></a>00052 z0 = acos(p)
- <a name="l00053"></a>00053 z1 = 1.0
- <a name="l00054"></a>00054 z2 = 0.0
- <a name="l00055"></a>00055 <span class="keyword">do</span> j = k , 0 , -2
- <a name="l00056"></a>00056 z3 = z1 * cos(z0 * j)
- <a name="l00057"></a>00057 z2 = z2 + z3
- <a name="l00058"></a>00058 z4 = (k-j+1) * (k+j) * 0.5_8
- <a name="l00059"></a>00059 z1 = z1 * z4 / (z4 + (j-1))
- <a name="l00060"></a>00060 <span class="keyword">enddo</span> <span class="comment">! j</span>
- <a name="l00061"></a>00061 <span class="keyword">if</span> (mod(k,2) == 0) z2 = z2 - 0.5_8 * z3
- <a name="l00062"></a>00062
- <a name="l00063"></a>00063 z0 = sqrt(2.0_8)
- <a name="l00064"></a>00064 <span class="keyword">do</span> j = 1 ,k
- <a name="l00065"></a>00065 z0 = z0 * sqrt(1.0_8 - 0.25_8 / (j*j))
- <a name="l00066"></a>00066 <span class="keyword">enddo</span> <span class="comment">! j</span>
- <a name="l00067"></a>00067 <a class="code" href="gaussmod_8f90.html#a278a9f628839bb589bfb00f5ece28891">ql</a> = z0 * z2
- <a name="l00068"></a>00068 return
- <a name="l00069"></a>00069 <span class="keyword">end function ql</span>
- <a name="l00070"></a>00070
- <a name="l00071"></a>00071 <span class="comment">! ============</span>
- <a name="l00072"></a>00072 <span class="comment">! FUNCTION QLD</span>
- <a name="l00073"></a>00073 <span class="comment">! ============</span>
- <a name="l00074"></a>00074
- <a name="l00075"></a><a class="code" href="gaussmod_8f90.html#a8911e98641c97beec648f8d593306b39">00075</a> <span class="keyword">real (kind=8) </span><span class="keyword">function </span><a class="code" href="gaussmod_8f90.html#a8911e98641c97beec648f8d593306b39">qld</a>(k,p)
- <a name="l00076"></a>00076 <span class="keyword">implicit none</span>
- <a name="l00077"></a>00077 <span class="keywordtype">integer</span> , <span class="keywordtype">intent(IN)</span> :: k
- <a name="l00078"></a>00078 <span class="keywordtype">real (kind=8)</span>, <span class="keywordtype">intent(IN)</span> :: p
- <a name="l00079"></a>00079 <span class="keywordtype">real (kind=8)</span> :: z
- <a name="l00080"></a>00080 <span class="keywordtype">real (kind=8)</span> :: ql
- <a name="l00081"></a>00081
- <a name="l00082"></a>00082 z = p * ql(k,p) - sqrt((k + k + 1.0_8) / (k + k - 1.0_8)) * ql(k-1,p)
- <a name="l00083"></a>00083 <a class="code" href="gaussmod_8f90.html#a8911e98641c97beec648f8d593306b39">qld</a> = (p * p - 1.0_8) / (k * z)
- <a name="l00084"></a>00084
- <a name="l00085"></a>00085 return
- <a name="l00086"></a>00086 <span class="keyword">end function qld</span>
- </pre></div></div>
- </div>
- <div id="nav-path" class="navpath">
- <ul>
- <li class="navelem"><a class="el" href="gaussmod_8f90.html">gaussmod.f90</a> </li>
- <!-- window showing the filter options -->
- <div id="MSearchSelectWindow"
- onmouseover="return searchBox.OnSearchSelectShow()"
- onmouseout="return searchBox.OnSearchSelectHide()"
- onkeydown="return searchBox.OnSearchSelectKey(event)">
- <a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(0)"><span class="SelectionMark"> </span>All</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(1)"><span class="SelectionMark"> </span>Classes</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(2)"><span class="SelectionMark"> </span>Files</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(3)"><span class="SelectionMark"> </span>Functions</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(4)"><span class="SelectionMark"> </span>Variables</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(5)"><span class="SelectionMark"> </span>Defines</a></div>
- <!-- iframe showing the search results (closed by default) -->
- <div id="MSearchResultsWindow">
- <iframe src="javascript:void(0)" frameborder="0"
- name="MSearchResults" id="MSearchResults">
- </iframe>
- </div>
- <li class="footer">Generated on Wed Sep 21 2011 12:35:46 for PUMA by
- <a href="http://www.doxygen.org/index.html">
- <img class="footer" src="doxygen.png" alt="doxygen"/></a> 1.7.5.1 </li>
- </ul>
- </div>
- </body>
- </html>
|