TECLIM
/
PlaSim


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748
							<!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/fftmod.f90 Source File</title>

<link href="tabs.css" rel="stylesheet" type="text/css"/>
<link href="doxygen.css" rel="stylesheet" type="text/css" />
<link href="navtree.css" rel="stylesheet" type="text/css"/>
<script type="text/javascript" src="jquery.js"></script>
<script type="text/javascript" src="resize.js"></script>
<script type="text/javascript" src="navtree.js"></script>
<script type="text/javascript">
  $(document).ready(initResizable);
</script>
<link href="search/search.css" rel="stylesheet" type="text/css"/>
<script type="text/javascript" src="search/search.js"></script>
<script type="text/javascript">
  $(document).ready(function() { searchBox.OnSelectItem(0); });
</script>

</head>
<body>
<div id="top"><!-- do not remove this div! -->


<div id="titlearea">
<table cellspacing="0" cellpadding="0">
 <tbody>
 <tr style="height: 56px;">
  
  <td id="projectlogo"><img alt="Logo" src="puma103.jpg"/></td>
  
  
  <td style="padding-left: 0.5em;">
   <div id="projectname">PUMA
   &#160;<span id="projectnumber">219</span>
   </div>
   <div id="projectbrief">Portable University Model of the Atmosphere</div>
  </td>
  
  
 </tr>
 </tbody>
</table>
</div>

<!-- Generated by Doxygen 1.7.5.1 -->
<script type="text/javascript">
var searchBox = new SearchBox("searchBox", "search",false,'Search');
</script>
  <div id="navrow1" class="tabs">
    <ul class="tablist">
      <li><a href="index.html"><span>Main&#160;Page</span></a></li>
      <li><a href="annotated.html"><span>Data&#160;Types&#160;List</span></a></li>
      <li class="current"><a href="files.html"><span>Files</span></a></li>
      <li>
        <div id="MSearchBox" class="MSearchBoxInactive">
        <span class="left">
          <img id="MSearchSelect" src="search/mag_sel.png"
               onmouseover="return searchBox.OnSearchSelectShow()"
               onmouseout="return searchBox.OnSearchSelectHide()"
               alt=""/>
          <input type="text" id="MSearchField" value="Search" accesskey="S"
               onfocus="searchBox.OnSearchFieldFocus(true)" 
               onblur="searchBox.OnSearchFieldFocus(false)" 
               onkeyup="searchBox.OnSearchFieldChange(event)"/>
          </span><span class="right">
            <a id="MSearchClose" href="javascript:searchBox.CloseResultsWindow()"><img id="MSearchCloseImg" border="0" src="search/close.png" alt=""/></a>
          </span>
        </div>
      </li>
    </ul>
  </div>
  <div id="navrow2" class="tabs2">
    <ul class="tablist">
      <li><a href="files.html"><span>File&#160;List</span></a></li>
      <li><a href="globals.html"><span>File&#160;Members</span></a></li>
    </ul>
  </div>
</div>
<div id="side-nav" class="ui-resizable side-nav-resizable">
  <div id="nav-tree">
    <div id="nav-tree-contents">
    </div>
  </div>
  <div id="splitbar" style="-moz-user-select:none;" 
       class="ui-resizable-handle">
  </div>
</div>
<script type="text/javascript">
  initNavTree('fftmod_8f90.html','');
</script>
<div id="doc-content">
<div class="header">
  <div class="headertitle">
<div class="title">/Users/home/WC/puma/src/fftmod.f90</div>  </div>
</div>
<div class="contents">
<a href="fftmod_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">!     MODULE FFTMOD</span>
<a name="l00003"></a>00003 <span class="comment">!     =============</span>
<a name="l00004"></a>00004 
<a name="l00005"></a>00005       <span class="keyword">module</span> <a class="code" href="classfftmod.html">fftmod</a>
<a name="l00006"></a>00006       parameter(NRES = 12)
<a name="l00007"></a>00007       <span class="keywordtype">integer</span> :: nallowed(NRES) = (/16,32,48,64,96,128,256,384,512,1024,2048,4096/)
<a name="l00008"></a>00008 <span class="comment">!     T3    - N16   : 8-2</span>
<a name="l00009"></a>00009 <span class="comment">!     T10   - N32   : 8-2-2</span>
<a name="l00010"></a>00010 <span class="comment">!     T15   - N48   : 8-3-2</span>
<a name="l00011"></a>00011 <span class="comment">!     T21   - N64   : 8-4-2</span>
<a name="l00012"></a>00012 <span class="comment">!     T31   - N96   : 8-4-3</span>
<a name="l00013"></a>00013 <span class="comment">!     T42   - N128  : 8-4-4</span>
<a name="l00014"></a>00014 <span class="comment">!     T85   - N256  : 8-4-4-2</span>
<a name="l00015"></a>00015 <span class="comment">!     T127  - N384  : 8-4-4-3</span>
<a name="l00016"></a>00016 <span class="comment">!     T170  - N512  : 8-4-4-4</span>
<a name="l00017"></a>00017 <span class="comment">!     T341  - N1024 : 8-4-4-4-2</span>
<a name="l00018"></a>00018 <span class="comment">!     T682  - N2048 : 8-4-4-4-4</span>
<a name="l00019"></a>00019 <span class="comment">!     T1365 - N4096 : 8-4-4-4-4-2</span>
<a name="l00020"></a>00020 
<a name="l00021"></a>00021       <span class="keywordtype">integer</span> :: lastn = 0
<a name="l00022"></a>00022       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: trigs(:)
<a name="l00023"></a>00023 <span class="keyword">      end module fftmod</span>
<a name="l00024"></a>00024 
<a name="l00025"></a>00025 <span class="comment">!     ================</span>
<a name="l00026"></a>00026 <span class="comment">!     SUBROUTINE GP2FC</span>
<a name="l00027"></a>00027 <span class="comment">!     ================</span>
<a name="l00028"></a>00028 
<a name="l00029"></a><a class="code" href="fftmod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">00029</a>       <span class="keyword">subroutine </span><a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(a,n,lot)
<a name="l00030"></a>00030       use <span class="keywordflow">fftmod</span>
<a name="l00031"></a>00031       <span class="keywordtype">real</span> a(n,lot)
<a name="l00032"></a>00032 
<a name="l00033"></a>00033       <span class="keyword">if</span> (n /= lastn) <span class="keyword">then</span>
<a name="l00034"></a>00034          <span class="keyword">if</span> (<span class="keyword">allocated</span>(trigs)) <span class="keyword">deallocate</span>(trigs)
<a name="l00035"></a>00035          <span class="keyword">allocate</span>(trigs(n))
<a name="l00036"></a>00036          lastn = n
<a name="l00037"></a>00037          call <a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
<a name="l00038"></a>00038       <span class="keyword">endif</span>
<a name="l00039"></a>00039 
<a name="l00040"></a>00040       call <a class="code" href="fftmod_8f90.html#ad824fc1d5775104962b9b77142e909a3">dfft8</a>(a,a,n,lot)
<a name="l00041"></a>00041       la = n / 8
<a name="l00042"></a>00042       <span class="keyword">do</span> <span class="keyword">while</span> (la &gt;= 4)
<a name="l00043"></a>00043          call <a class="code" href="fftmod_8f90.html#a016c6910afcaeee463180fcc1d24297a">dfft4</a>(a,trigs,n,lot,la)
<a name="l00044"></a>00044       <span class="keyword">enddo</span>
<a name="l00045"></a>00045 
<a name="l00046"></a>00046       <span class="keyword">if</span> (la == 3) <span class="keyword">then</span>
<a name="l00047"></a>00047          <span class="keyword">do</span> l = 1 , lot
<a name="l00048"></a>00048             call <a class="code" href="fftmod_8f90.html#a1d7e74baca7896477fb2e32b73ccab37">dfft3</a>(a(1,l),trigs,n)
<a name="l00049"></a>00049          <span class="keyword">enddo</span>
<a name="l00050"></a>00050       <span class="keyword">endif</span>
<a name="l00051"></a>00051 
<a name="l00052"></a>00052       <span class="keyword">if</span> (la == 2) <span class="keyword">then</span>
<a name="l00053"></a>00053          <span class="keyword">do</span> l = 1 , lot
<a name="l00054"></a>00054             call <a class="code" href="fftmod_8f90.html#a6d2dbc83ff732343036d20cc9625cb98">dfft2</a>(a(1,l),trigs,n)
<a name="l00055"></a>00055          <span class="keyword">enddo</span>
<a name="l00056"></a>00056       <span class="keyword">endif</span>
<a name="l00057"></a>00057       return
<a name="l00058"></a>00058 <span class="keyword">      end subroutine gp2fc</span>
<a name="l00059"></a>00059 
<a name="l00060"></a>00060 <span class="comment">!     ================</span>
<a name="l00061"></a>00061 <span class="comment">!     SUBROUTINE FC2GP</span>
<a name="l00062"></a>00062 <span class="comment">!     ================</span>
<a name="l00063"></a>00063 
<a name="l00064"></a><a class="code" href="fftmod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">00064</a>       <span class="keyword">subroutine </span><a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(a,n,lot)
<a name="l00065"></a>00065       use <span class="keywordflow">fftmod</span>
<a name="l00066"></a>00066       <span class="keywordtype">real</span> a(n,lot)
<a name="l00067"></a>00067 
<a name="l00068"></a>00068       <span class="keyword">if</span> (n /= lastn) <span class="keyword">then</span>
<a name="l00069"></a>00069          <span class="keyword">if</span> (<span class="keyword">allocated</span>(trigs)) <span class="keyword">deallocate</span>(trigs)
<a name="l00070"></a>00070          <span class="keyword">allocate</span>(trigs(n))
<a name="l00071"></a>00071          lastn = n
<a name="l00072"></a>00072          call <a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
<a name="l00073"></a>00073       <span class="keyword">endif</span>
<a name="l00074"></a>00074 
<a name="l00075"></a>00075       nf = n/8
<a name="l00076"></a>00076       <span class="keyword">do</span> <span class="keyword">while</span> (nf &gt;= 4)
<a name="l00077"></a>00077          nf = nf/4
<a name="l00078"></a>00078       <span class="keyword">enddo</span>
<a name="l00079"></a>00079       la = 1
<a name="l00080"></a>00080       <span class="keyword">if</span> (nf == 2) call <a class="code" href="fftmod_8f90.html#a5f8dd5758a7e842f97b8492e7633a1b8">ifft2</a>(a,trigs,n,lot,la)
<a name="l00081"></a>00081       <span class="keyword">if</span> (nf == 3) call <a class="code" href="fftmod_8f90.html#a43856abf5ad7775f9454dd090e74e444">ifft3</a>(a,trigs,n,lot,la)
<a name="l00082"></a>00082       <span class="keyword">do</span> <span class="keyword">while</span> (la &lt; n/8)
<a name="l00083"></a>00083          call <a class="code" href="fftmod_8f90.html#aa4540793d1039abfdcc4512f4aacc8a0">ifft4</a>(a,trigs,n,lot,la)
<a name="l00084"></a>00084       <span class="keyword">enddo</span>
<a name="l00085"></a>00085       call <a class="code" href="fftmod_8f90.html#a4c6991cf5c64fa6c35c4d42ff48a3574">ifft8</a>(a,a,n,lot)
<a name="l00086"></a>00086       return
<a name="l00087"></a>00087 <span class="keyword">      end subroutine fc2gp</span>
<a name="l00088"></a>00088 
<a name="l00089"></a>00089 <span class="comment">!     =================</span>
<a name="l00090"></a>00090 <span class="comment">!     SUBROUTINE FFTINI</span>
<a name="l00091"></a>00091 <span class="comment">!     =================</span>
<a name="l00092"></a>00092 
<a name="l00093"></a><a class="code" href="fftmod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">00093</a>       <span class="keyword">subroutine </span><a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
<a name="l00094"></a>00094       use <span class="keywordflow">fftmod</span>
<a name="l00095"></a>00095       <span class="keywordtype">logical</span> labort
<a name="l00096"></a>00096 
<a name="l00097"></a>00097 <span class="comment">!     check for allowed values of n</span>
<a name="l00098"></a>00098 
<a name="l00099"></a>00099       labort = .true.
<a name="l00100"></a>00100       <span class="keyword">do</span> j = 1 , NRES
<a name="l00101"></a>00101          <span class="keyword">if</span> (n == nallowed(j)) labort = .false.
<a name="l00102"></a>00102       <span class="keyword">enddo</span>
<a name="l00103"></a>00103 
<a name="l00104"></a>00104       <span class="keyword">if</span> (labort) <span class="keyword">then</span>
<a name="l00105"></a>00105          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;*** FFT does not support n = &#39;</span>,n,<span class="stringliteral">&#39; ***&#39;</span>
<a name="l00106"></a>00106          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;Following resolutions may be used:&#39;</span>
<a name="l00107"></a>00107          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;----------------------------------&#39;</span>
<a name="l00108"></a>00108          <span class="keyword">do</span> j = 1 , NRES
<a name="l00109"></a>00109             <span class="keyword">write</span> (*,1000) nallowed(j), nallowed(j)/2, nallowed(j)/3
<a name="l00110"></a>00110          <span class="keyword">enddo</span>
<a name="l00111"></a>00111          stop
<a name="l00112"></a>00112       <span class="keyword">endif</span>
<a name="l00113"></a>00113  1000 format(<span class="stringliteral">&#39; NLON=&#39;</span>,I5,<span class="stringliteral">&#39;  NLAT=&#39;</span>,I5,<span class="stringliteral">&#39;  NTRU=&#39;</span>,I5)
<a name="l00114"></a>00114 
<a name="l00115"></a>00115       del = 4.0 * asin(1.0) / n
<a name="l00116"></a>00116       <span class="keyword">do</span> k=0,n/2-1
<a name="l00117"></a>00117         angle = k * del
<a name="l00118"></a>00118         trigs(2*k+1) = cos(angle)
<a name="l00119"></a>00119         trigs(2*k+2) = sin(angle)
<a name="l00120"></a>00120       <span class="keyword">enddo</span>
<a name="l00121"></a>00121       return
<a name="l00122"></a>00122 <span class="keyword">      end subroutine fftini</span>
<a name="l00123"></a>00123 
<a name="l00124"></a>00124 <span class="comment">!     ================</span>
<a name="l00125"></a>00125 <span class="comment">!     SUBROUTINE DFFT2</span>
<a name="l00126"></a>00126 <span class="comment">!     ================</span>
<a name="l00127"></a>00127 
<a name="l00128"></a><a class="code" href="fftmod_8f90.html#a6d2dbc83ff732343036d20cc9625cb98">00128</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#a6d2dbc83ff732343036d20cc9625cb98">dfft2</a>(a,trigs,n)
<a name="l00129"></a>00129       dimension a(n),c(n),trigs(n)
<a name="l00130"></a>00130 
<a name="l00131"></a>00131       c(1) = a(1) + a(2)
<a name="l00132"></a>00132       c(2) = 0.0
<a name="l00133"></a>00133 
<a name="l00134"></a>00134       ja = 3
<a name="l00135"></a>00135       jb = n - 1
<a name="l00136"></a>00136 
<a name="l00137"></a>00137       <span class="keyword">do</span> i=3,n-5,4
<a name="l00138"></a>00138          c1 = trigs(ja  )
<a name="l00139"></a>00139          s1 = trigs(ja+1)
<a name="l00140"></a>00140          a1p3 = c1 * a(i+1) + s1 * a(i+3)
<a name="l00141"></a>00141          a3m1 = c1 * a(i+3) - s1 * a(i+1)
<a name="l00142"></a>00142          c(ja  ) = a(i) + a1p3
<a name="l00143"></a>00143          c(jb  ) = a(i) - a1p3
<a name="l00144"></a>00144          c(ja+1) = a3m1 + a(i+2)
<a name="l00145"></a>00145          c(jb+1) = a3m1 - a(i+2)
<a name="l00146"></a>00146          ja = ja + 2
<a name="l00147"></a>00147          jb = jb - 2
<a name="l00148"></a>00148       <span class="keyword">enddo</span>
<a name="l00149"></a>00149 
<a name="l00150"></a>00150       c(ja  ) =  a(n-1)
<a name="l00151"></a>00151       c(ja+1) = -a(n  )
<a name="l00152"></a>00152 
<a name="l00153"></a>00153       a = c
<a name="l00154"></a>00154       return
<a name="l00155"></a>00155 <span class="keyword">      end subroutine dfft2</span>
<a name="l00156"></a>00156 
<a name="l00157"></a>00157 <span class="comment">!     ================</span>
<a name="l00158"></a>00158 <span class="comment">!     SUBROUTINE DFFT3</span>
<a name="l00159"></a>00159 <span class="comment">!     ================</span>
<a name="l00160"></a>00160 
<a name="l00161"></a><a class="code" href="fftmod_8f90.html#a1d7e74baca7896477fb2e32b73ccab37">00161</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#a1d7e74baca7896477fb2e32b73ccab37">dfft3</a>(a,trigs,n)
<a name="l00162"></a>00162       parameter(SIN60 = 0.866025403784438D0)
<a name="l00163"></a>00163       dimension a(n),c(n),trigs(n)
<a name="l00164"></a>00164 
<a name="l00165"></a>00165       ja = 1              <span class="comment">!  1</span>
<a name="l00166"></a>00166       jb = 2 * (n/3)  + 1 <span class="comment">! 65</span>
<a name="l00167"></a>00167       jc = jb             <span class="comment">! 65</span>
<a name="l00168"></a>00168 
<a name="l00169"></a>00169       c(ja  ) = a(1) + a(2) + a(3)
<a name="l00170"></a>00170       c(ja+1) = 0.0
<a name="l00171"></a>00171       c(jb  ) = a(1) - 0.5 * (a(2) + a(3))
<a name="l00172"></a>00172       c(jb+1) =      SIN60 * (a(3) - a(2))
<a name="l00173"></a>00173 
<a name="l00174"></a>00174       ja = 3         <span class="comment">!  3, 5, 7, ... ,31</span>
<a name="l00175"></a>00175       jb = jb + 2    <span class="comment">! 67,69,71, ... ,95</span>
<a name="l00176"></a>00176       jc = jc - 2    <span class="comment">! 63,61,59, ... ,35</span>
<a name="l00177"></a>00177 
<a name="l00178"></a>00178       <span class="keyword">do</span> i = 4 , n-8 , 6 <span class="comment">! 88</span>
<a name="l00179"></a>00179          c1 = trigs(ja  )
<a name="l00180"></a>00180          s1 = trigs(ja+1)
<a name="l00181"></a>00181          c2 = trigs(ja+ja-1)
<a name="l00182"></a>00182          s2 = trigs(ja+ja  )
<a name="l00183"></a>00183          a1 = (c1*a(i+1)+s1*a(i+4))+(c2*a(i+2)+s2*a(i+5))
<a name="l00184"></a>00184          b1 = (c1*a(i+4)-s1*a(i+1))+(c2*a(i+5)-s2*a(i+2))
<a name="l00185"></a>00185          a2 = a(i  ) - 0.5 * a1
<a name="l00186"></a>00186          b2 = a(i+3) - 0.5 * b1
<a name="l00187"></a>00187          a3 = SIN60*((c1*a(i+1)+s1*a(i+4))-(c2*a(i+2)+s2*a(i+5)))
<a name="l00188"></a>00188          b3 = SIN60*((c1*a(i+4)-s1*A(i+1))-(c2*a(i+5)-s2*a(i+2)))
<a name="l00189"></a>00189          c(ja  ) = a(i  ) + a1
<a name="l00190"></a>00190          c(ja+1) = a(i+3) + b1
<a name="l00191"></a>00191          c(jb  ) = a2 + b3
<a name="l00192"></a>00192          c(jb+1) = b2 - a3
<a name="l00193"></a>00193          c(jc  ) = a2 - b3
<a name="l00194"></a>00194          c(jc+1) =-b2 - a3
<a name="l00195"></a>00195          ja = ja + 2
<a name="l00196"></a>00196          jb = jb + 2
<a name="l00197"></a>00197          jc = jc - 2
<a name="l00198"></a>00198       <span class="keyword">enddo</span>
<a name="l00199"></a>00199 
<a name="l00200"></a>00200       <span class="keyword">if</span> (ja &lt;= jc) <span class="keyword">then</span> <span class="comment">! ja=33  jc=33</span>
<a name="l00201"></a>00201          c(ja  ) = a(n-2) + 0.5 * (a(n-1) - a(n)) <span class="comment">! 33</span>
<a name="l00202"></a>00202          c(ja+1) =       -SIN60 * (a(n-1) + a(n)) <span class="comment">! 34</span>
<a name="l00203"></a>00203       <span class="keyword">endif</span>
<a name="l00204"></a>00204       a(:) = c(:)
<a name="l00205"></a>00205       return
<a name="l00206"></a>00206 <span class="keyword">      end subroutine dfft3</span>
<a name="l00207"></a>00207 
<a name="l00208"></a>00208 <span class="comment">!     ================</span>
<a name="l00209"></a>00209 <span class="comment">!     SUBROUTINE DFFT4</span>
<a name="l00210"></a>00210 <span class="comment">!     ================</span>
<a name="l00211"></a>00211 
<a name="l00212"></a><a class="code" href="fftmod_8f90.html#a016c6910afcaeee463180fcc1d24297a">00212</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#a016c6910afcaeee463180fcc1d24297a">dfft4</a>(a,trigs,n,lot,la)
<a name="l00213"></a>00213       dimension a(n,lot),c(n,lot),trigs(n)
<a name="l00214"></a>00214       la = la / 4
<a name="l00215"></a>00215 
<a name="l00216"></a>00216       i1 = la
<a name="l00217"></a>00217       i2 = la + i1
<a name="l00218"></a>00218       i3 = la + i2
<a name="l00219"></a>00219       i4 = la + i3
<a name="l00220"></a>00220       i5 = la + i4
<a name="l00221"></a>00221       i6 = la + i5
<a name="l00222"></a>00222       i7 = la + i6
<a name="l00223"></a>00223 
<a name="l00224"></a>00224       j1 = n/2 - la
<a name="l00225"></a>00225       j2 = n - la
<a name="l00226"></a>00226       j3 = j1
<a name="l00227"></a>00227       j5 = j1 + la
<a name="l00228"></a>00228 
<a name="l00229"></a>00229       <span class="keyword">do</span> i=1,la
<a name="l00230"></a>00230          <span class="keyword">do</span> l=1,lot
<a name="l00231"></a>00231          a0p2 = a(i   ,l) + a(i2+i,l)
<a name="l00232"></a>00232          a1p3 = a(i1+i,l) + a(i3+i,l)
<a name="l00233"></a>00233          c(   i,l) = a0p2 + a1p3
<a name="l00234"></a>00234          c(j2+i,l) = a0p2 - a1p3
<a name="l00235"></a>00235          c(j1+i,l) = a(   i,l) - a(i2+i,l)
<a name="l00236"></a>00236          c(j5+i,l) = a(i3+i,l) - a(i1+i,l)
<a name="l00237"></a>00237          <span class="keyword">enddo</span>
<a name="l00238"></a>00238       <span class="keyword">enddo</span>
<a name="l00239"></a>00239 
<a name="l00240"></a>00240       jink = 2 * la
<a name="l00241"></a>00241       j0 = la
<a name="l00242"></a>00242       j1 = j1 + jink
<a name="l00243"></a>00243       j2 = j2 - jink
<a name="l00244"></a>00244       j3 = j3 - jink
<a name="l00245"></a>00245       j4 = j0 + la
<a name="l00246"></a>00246       j5 = j1 + la
<a name="l00247"></a>00247       j6 = j2 + la
<a name="l00248"></a>00248       j7 = j3 + la
<a name="l00249"></a>00249 
<a name="l00250"></a>00250       ibase=4*la
<a name="l00251"></a>00251 
<a name="l00252"></a>00252       <span class="keyword">do</span> 450 k=la,(n-4)/8,la
<a name="l00253"></a>00253          kb=k+k
<a name="l00254"></a>00254          kc=kb+kb
<a name="l00255"></a>00255          kd=kc+kb
<a name="l00256"></a>00256          c1=trigs(kb+1)
<a name="l00257"></a>00257          s1=trigs(kb+2)
<a name="l00258"></a>00258          c2=trigs(kc+1)
<a name="l00259"></a>00259          s2=trigs(kc+2)
<a name="l00260"></a>00260          c3=trigs(kd+1)
<a name="l00261"></a>00261          s3=trigs(kd+2)
<a name="l00262"></a>00262 
<a name="l00263"></a>00263          i=ibase+1
<a name="l00264"></a>00264          <span class="keyword">do</span> j=1,la
<a name="l00265"></a>00265             <span class="keyword">do</span> l=1,lot
<a name="l00266"></a>00266             a1p5 = c1 * a(i1+i,l) + s1 * a(i5+i,l)
<a name="l00267"></a>00267             a2p6 = c2 * a(i2+i,l) + s2 * a(i6+i,l)
<a name="l00268"></a>00268             a3p7 = c3 * a(i3+i,l) + s3 * a(i7+i,l)
<a name="l00269"></a>00269             a5m1 = c1 * a(i5+i,l) - s1 * a(i1+i,l)
<a name="l00270"></a>00270             a6m2 = c2 * a(i6+i,l) - s2 * a(i2+i,l)
<a name="l00271"></a>00271             a7m3 = c3 * a(i7+i,l) - s3 * a(i3+i,l)
<a name="l00272"></a>00272             a0 = a(i,l) + a2p6
<a name="l00273"></a>00273             a2 = a(i,l) - a2p6
<a name="l00274"></a>00274             a1 = a1p5 + a3p7
<a name="l00275"></a>00275             a3 = a3p7 - a1p5
<a name="l00276"></a>00276             b0 = a(i4+i,l) + a6m2
<a name="l00277"></a>00277             b2 = a(i4+i,l) - a6m2
<a name="l00278"></a>00278             b1 = a5m1 + a7m3
<a name="l00279"></a>00279             b3 = a5m1 - a7m3
<a name="l00280"></a>00280             c(j0+j,l) = a0+a1
<a name="l00281"></a>00281             c(j2+j,l) = a0-a1
<a name="l00282"></a>00282             c(j4+j,l) = b0+b1
<a name="l00283"></a>00283             c(j6+j,l) = b1-b0
<a name="l00284"></a>00284             c(j1+j,l) = a2+b3
<a name="l00285"></a>00285             c(j3+j,l) = a2-b3
<a name="l00286"></a>00286             c(j5+j,l) = a3+b2
<a name="l00287"></a>00287             c(j7+j,l) = a3-b2
<a name="l00288"></a>00288             <span class="keyword">enddo</span>
<a name="l00289"></a>00289             i=i+1
<a name="l00290"></a>00290          <span class="keyword">enddo</span>
<a name="l00291"></a>00291 
<a name="l00292"></a>00292         ibase=ibase+8*la
<a name="l00293"></a>00293         j0 = j0 + jink
<a name="l00294"></a>00294         j1 = j1 + jink
<a name="l00295"></a>00295         j2 = j2 - jink
<a name="l00296"></a>00296         j3 = j3 - jink
<a name="l00297"></a>00297         j4 = j0 + la
<a name="l00298"></a>00298         j5 = j1 + la
<a name="l00299"></a>00299         j6 = j2 + la
<a name="l00300"></a>00300         j7 = j3 + la
<a name="l00301"></a>00301 450   continue
<a name="l00302"></a>00302       <span class="keyword">if</span> (j1 &lt;= j2) <span class="keyword">then</span>
<a name="l00303"></a>00303          sin45=sqrt(0.5)
<a name="l00304"></a>00304          i=ibase+1
<a name="l00305"></a>00305          <span class="keyword">do</span> j=1,la
<a name="l00306"></a>00306             <span class="keyword">do</span> l=1,lot
<a name="l00307"></a>00307             a1p3 = sin45 * (a(i1+i,l) + a(i3+i,l))
<a name="l00308"></a>00308             a1m3 = sin45 * (a(i1+i,l) - a(i3+i,l))
<a name="l00309"></a>00309             c(j0+j,l) =  a(   i,l) + a1m3
<a name="l00310"></a>00310             c(j1+j,l) =  a(   i,l) - a1m3
<a name="l00311"></a>00311             c(j4+j,l) = -a(i2+i,l) - a1p3
<a name="l00312"></a>00312             c(j5+j,l) =  a(i2+i,l) - a1p3
<a name="l00313"></a>00313             <span class="keyword">enddo</span>
<a name="l00314"></a>00314             i=i+1
<a name="l00315"></a>00315          <span class="keyword">enddo</span>
<a name="l00316"></a>00316       <span class="keyword">endif</span>
<a name="l00317"></a>00317       <span class="keyword">if</span> (la == 1) <span class="keyword">then</span>
<a name="l00318"></a>00318          <span class="keyword">do</span> l=1,lot
<a name="l00319"></a>00319          a(1,l) = c(1,l)
<a name="l00320"></a>00320          a(2,l) = 0.0
<a name="l00321"></a>00321          a(3:n,l) = c(2:n-1,l)
<a name="l00322"></a>00322          <span class="keyword">enddo</span>
<a name="l00323"></a>00323       <span class="keyword">else</span>
<a name="l00324"></a>00324          a = c
<a name="l00325"></a>00325       <span class="keyword">endif</span>
<a name="l00326"></a>00326       return
<a name="l00327"></a>00327 <span class="keyword">      end subroutine dfft4</span>
<a name="l00328"></a>00328 
<a name="l00329"></a>00329 <span class="comment">!     ================</span>
<a name="l00330"></a>00330 <span class="comment">!     SUBROUTINE DFFT8</span>
<a name="l00331"></a>00331 <span class="comment">!     ================</span>
<a name="l00332"></a>00332 
<a name="l00333"></a><a class="code" href="fftmod_8f90.html#ad824fc1d5775104962b9b77142e909a3">00333</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#ad824fc1d5775104962b9b77142e909a3">dfft8</a>(a,c,n,lot)
<a name="l00334"></a>00334       <span class="keywordtype">real</span> a(n*lot),c(n*lot)
<a name="l00335"></a>00335       la = n / 8
<a name="l00336"></a>00336       z  = 1.0 / n
<a name="l00337"></a>00337       zsin45 = z * sqrt(0.5)
<a name="l00338"></a>00338 
<a name="l00339"></a>00339       <span class="keyword">do</span> i=0,la*lot-1
<a name="l00340"></a>00340          i0 = (i/la) * n + mod(i,la) + 1
<a name="l00341"></a>00341          i1 = i0 + la
<a name="l00342"></a>00342          i2 = i1 + la
<a name="l00343"></a>00343          i3 = i2 + la
<a name="l00344"></a>00344          i4 = i3 + la
<a name="l00345"></a>00345          i5 = i4 + la
<a name="l00346"></a>00346          i6 = i5 + la
<a name="l00347"></a>00347          i7 = i6 + la
<a name="l00348"></a>00348 
<a name="l00349"></a>00349          a0p4 =  a(i0) + a(i4)
<a name="l00350"></a>00350          a1p5 =  a(i1) + a(i5)
<a name="l00351"></a>00351          a2p6 =  a(i2) + a(i6)
<a name="l00352"></a>00352          a3p7 =  a(i3) + a(i7)
<a name="l00353"></a>00353          a5m1 =  a(i5) - a(i1)
<a name="l00354"></a>00354          a7m3 =  a(i7) - a(i3)
<a name="l00355"></a>00355          a0m4 = (a(i0) - a(i4)) * z
<a name="l00356"></a>00356          a6m2 = (a(i6) - a(i2)) * z
<a name="l00357"></a>00357 
<a name="l00358"></a>00358          a0p4p2p6 = a0p4 + a2p6
<a name="l00359"></a>00359          a1p5p3p7 = a1p5 + a3p7
<a name="l00360"></a>00360          a7m3p5m1 = (a7m3 + a5m1) * zsin45
<a name="l00361"></a>00361          a7m3m5m1 = (a7m3 - a5m1) * zsin45
<a name="l00362"></a>00362 
<a name="l00363"></a>00363          c(i0) = z * (a0p4p2p6 + a1p5p3p7)
<a name="l00364"></a>00364          c(i7) = z * (a0p4p2p6 - a1p5p3p7)
<a name="l00365"></a>00365          c(i3) = z * (a0p4 - a2p6)
<a name="l00366"></a>00366          c(i4) = z * (a3p7 - a1p5)
<a name="l00367"></a>00367          c(i1) = a0m4 + a7m3m5m1
<a name="l00368"></a>00368          c(i5) = a0m4 - a7m3m5m1
<a name="l00369"></a>00369          c(i2) = a7m3p5m1 + a6m2
<a name="l00370"></a>00370          c(i6) = a7m3p5m1 - a6m2
<a name="l00371"></a>00371       <span class="keyword">enddo</span>
<a name="l00372"></a>00372       return
<a name="l00373"></a>00373 <span class="keyword">      end subroutine dfft8</span>
<a name="l00374"></a>00374 
<a name="l00375"></a>00375 <span class="comment">!     ================</span>
<a name="l00376"></a>00376 <span class="comment">!     SUBROUTINE IFFT4</span>
<a name="l00377"></a>00377 <span class="comment">!     ================</span>
<a name="l00378"></a>00378 
<a name="l00379"></a><a class="code" href="fftmod_8f90.html#aa4540793d1039abfdcc4512f4aacc8a0">00379</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#aa4540793d1039abfdcc4512f4aacc8a0">ifft4</a>(c,trigs,n,lot,la)
<a name="l00380"></a>00380       dimension a(n,lot),c(n,lot),trigs(n)
<a name="l00381"></a>00381 
<a name="l00382"></a>00382       <span class="keyword">if</span> (la == 1) <span class="keyword">then</span>
<a name="l00383"></a>00383          a(1,:) = 0.5 * c(1,:)
<a name="l00384"></a>00384          a(n,:) = 0.0
<a name="l00385"></a>00385          a(2:n-1,:) = c(3:n,:)
<a name="l00386"></a>00386       <span class="keyword">else</span>
<a name="l00387"></a>00387          a = c
<a name="l00388"></a>00388       <span class="keyword">endif</span>
<a name="l00389"></a>00389 
<a name="l00390"></a>00390       m=n/4
<a name="l00391"></a>00391       kstop=(n-4)/8
<a name="l00392"></a>00392 
<a name="l00393"></a>00393       i1 = n/2 - la
<a name="l00394"></a>00394       i2 = n   - la
<a name="l00395"></a>00395       i5 = i1  + la
<a name="l00396"></a>00396 
<a name="l00397"></a>00397       j1 = la
<a name="l00398"></a>00398       j2 = la+j1
<a name="l00399"></a>00399       j3 = la+j2
<a name="l00400"></a>00400       j4 = la+j3
<a name="l00401"></a>00401       j5 = la+j4
<a name="l00402"></a>00402       j6 = la+j5
<a name="l00403"></a>00403       j7 = la+j6
<a name="l00404"></a>00404 
<a name="l00405"></a>00405       <span class="keyword">do</span> i=1,la
<a name="l00406"></a>00406       <span class="keyword">do</span> l=1,lot
<a name="l00407"></a>00407          c(   i,l) = a(i,l) + a(i2+i,l) + a(i1+i,l)
<a name="l00408"></a>00408          c(j1+i,l) = a(i,l) - a(i2+i,l) - a(i5+i,l)
<a name="l00409"></a>00409          c(j2+i,l) = a(i,l) + a(i2+i,l) - a(i1+i,l)
<a name="l00410"></a>00410          c(j3+i,l) = a(i,l) - a(i2+i,l) + a(i5+i,l)
<a name="l00411"></a>00411       <span class="keyword">enddo</span>
<a name="l00412"></a>00412       <span class="keyword">enddo</span>
<a name="l00413"></a>00413 
<a name="l00414"></a>00414       iink  = 2 * la
<a name="l00415"></a>00415       jbase = 4 * la + 1
<a name="l00416"></a>00416       i0    = la
<a name="l00417"></a>00417       i1    = i0 + n/2
<a name="l00418"></a>00418       i2    = n - 3 * la
<a name="l00419"></a>00419       i3    = i2 - n/2
<a name="l00420"></a>00420       i4    = i0 + la
<a name="l00421"></a>00421       i5    = i1 + la
<a name="l00422"></a>00422       i6    = i2 + la
<a name="l00423"></a>00423       i7    = i3 + la
<a name="l00424"></a>00424 
<a name="l00425"></a>00425       <span class="keyword">do</span> 450 k=la,kstop,la
<a name="l00426"></a>00426         kb=k+k
<a name="l00427"></a>00427         kc=kb+kb
<a name="l00428"></a>00428         kd=kc+kb
<a name="l00429"></a>00429         c1=trigs(kb+1)
<a name="l00430"></a>00430         s1=trigs(kb+2)
<a name="l00431"></a>00431         c2=trigs(kc+1)
<a name="l00432"></a>00432         s2=trigs(kc+2)
<a name="l00433"></a>00433         c3=trigs(kd+1)
<a name="l00434"></a>00434         s3=trigs(kd+2)
<a name="l00435"></a>00435         <span class="keyword">do</span> i = 1 , la
<a name="l00436"></a>00436            j = jbase
<a name="l00437"></a>00437            <span class="keyword">do</span> l=1,lot
<a name="l00438"></a>00438            a0p2 = a(i0+i,l) + a(i2+i,l)
<a name="l00439"></a>00439            a0m2 = a(i0+i,l) - a(i2+i,l)
<a name="l00440"></a>00440            a1p3 = a(i1+i,l) + a(i3+i,l)
<a name="l00441"></a>00441            a1m3 = a(i1+i,l) - a(i3+i,l)
<a name="l00442"></a>00442            a4p6 = a(i4+i,l) + a(i6+i,l)
<a name="l00443"></a>00443            a4m6 = a(i4+i,l) - a(i6+i,l)
<a name="l00444"></a>00444            a5p7 = a(i5+i,l) + a(i7+i,l)
<a name="l00445"></a>00445            a5m7 = a(i5+i,l) - a(i7+i,l)
<a name="l00446"></a>00446 
<a name="l00447"></a>00447            a0p2m1p3 = a0p2 - a1p3
<a name="l00448"></a>00448            a4m6m5m7 = a4m6 - a5m7
<a name="l00449"></a>00449 
<a name="l00450"></a>00450            c(   j,l) = a0p2 + a1p3
<a name="l00451"></a>00451            c(j4+j,l) = a4m6 + a5m7
<a name="l00452"></a>00452            c(j2+j,l) = c2 * a0p2m1p3 - s2 * a4m6m5m7
<a name="l00453"></a>00453            c(j6+j,l) = s2 * a0p2m1p3 + c2 * a4m6m5m7
<a name="l00454"></a>00454            c(j1+j,l) = c1*(a0m2-a5p7)-s1*(a4p6+a1m3)
<a name="l00455"></a>00455            c(j5+j,l) = s1*(a0m2-a5p7)+c1*(a4p6+a1m3)
<a name="l00456"></a>00456            c(j3+j,l) = c3*(a0m2+a5p7)-s3*(a4p6-a1m3)
<a name="l00457"></a>00457            c(j7+j,l) = s3*(a0m2+a5p7)+c3*(a4p6-a1m3)
<a name="l00458"></a>00458            <span class="keyword">enddo</span>
<a name="l00459"></a>00459            jbase=jbase+1
<a name="l00460"></a>00460         <span class="keyword">enddo</span>
<a name="l00461"></a>00461         i0 = i0 + iink
<a name="l00462"></a>00462         i1 = i1 + iink
<a name="l00463"></a>00463         i2 = i2 - iink
<a name="l00464"></a>00464         i3 = i3 - iink
<a name="l00465"></a>00465         i4 = i4 + iink
<a name="l00466"></a>00466         i5 = i5 + iink
<a name="l00467"></a>00467         i6 = i6 - iink
<a name="l00468"></a>00468         i7 = i7 - iink
<a name="l00469"></a>00469         jbase=jbase+7*la
<a name="l00470"></a>00470 450     continue
<a name="l00471"></a>00471 
<a name="l00472"></a>00472       <span class="keyword">if</span> (i1 &lt;= i2) <span class="keyword">then</span>
<a name="l00473"></a>00473          sin45=sqrt(0.5)
<a name="l00474"></a>00474          <span class="keyword">do</span> i=1,la
<a name="l00475"></a>00475             j=jbase
<a name="l00476"></a>00476             <span class="keyword">do</span> l=1,lot
<a name="l00477"></a>00477             c(   j,l)=a(i0+i,l)+a(i1+i,l)
<a name="l00478"></a>00478             c(j1+j,l)=sin45*((a(i0+i,l)-a(i1+i,l))-(a(la+i0+i,l)+a(la+i1+i,l)))
<a name="l00479"></a>00479             c(j2+j,l)=a(la+i1+i,l)-a(la+i0+i,l)
<a name="l00480"></a>00480             c(j3+j,l)=-sin45*((a(i0+i,l)-a(i1+i,l))+(a(la+i0+i,l)+a(la+i1+i,l)))
<a name="l00481"></a>00481             <span class="keyword">enddo</span>
<a name="l00482"></a>00482             jbase=jbase+1
<a name="l00483"></a>00483          <span class="keyword">enddo</span>
<a name="l00484"></a>00484       <span class="keyword">endif</span>
<a name="l00485"></a>00485       la = la * 4
<a name="l00486"></a>00486       return
<a name="l00487"></a>00487 <span class="keyword">      end subroutine ifft4</span>
<a name="l00488"></a>00488 
<a name="l00489"></a>00489 <span class="comment">!     ================</span>
<a name="l00490"></a>00490 <span class="comment">!     SUBROUTINE IFFT2</span>
<a name="l00491"></a>00491 <span class="comment">!     ================</span>
<a name="l00492"></a>00492 
<a name="l00493"></a><a class="code" href="fftmod_8f90.html#a5f8dd5758a7e842f97b8492e7633a1b8">00493</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#a5f8dd5758a7e842f97b8492e7633a1b8">ifft2</a>(a,trigs,n,lot,la)
<a name="l00494"></a>00494       dimension a(n,lot),c(n,lot),trigs(n)
<a name="l00495"></a>00495 
<a name="l00496"></a>00496       c(1,:) = 0.5 * a(1,:)
<a name="l00497"></a>00497       c(2,:) = c(1,:)
<a name="l00498"></a>00498 
<a name="l00499"></a>00499       ia    =   3
<a name="l00500"></a>00500       ib    = n-1
<a name="l00501"></a>00501 
<a name="l00502"></a>00502       <span class="keyword">do</span> j = 3 , n-5 , 4
<a name="l00503"></a>00503          c1 = trigs(ia  )
<a name="l00504"></a>00504          s1 = trigs(ia+1)
<a name="l00505"></a>00505          <span class="keyword">do</span> l=1,lot
<a name="l00506"></a>00506          amb = a(ia  ,l) - a(ib  ,l)
<a name="l00507"></a>00507          apb = a(ia+1,l) + a(ib+1,l)
<a name="l00508"></a>00508          c(j  ,l) = a(ia  ,l) + a(ib  ,l)
<a name="l00509"></a>00509          c(j+2,l) = a(ia+1,l) - a(ib+1,l)
<a name="l00510"></a>00510          c(j+1,l) = c1 * amb - s1 * apb
<a name="l00511"></a>00511          c(j+3,l) = s1 * amb + c1 * apb
<a name="l00512"></a>00512          <span class="keyword">enddo</span>
<a name="l00513"></a>00513          ia = ia + 2
<a name="l00514"></a>00514          ib = ib - 2
<a name="l00515"></a>00515       <span class="keyword">enddo</span>
<a name="l00516"></a>00516       c(n-1,:) =  a(ia  ,:)
<a name="l00517"></a>00517       c(n  ,:) = -a(ia+1,:)
<a name="l00518"></a>00518 
<a name="l00519"></a>00519       a(:,:) = c(:,:)
<a name="l00520"></a>00520       la = 2
<a name="l00521"></a>00521       return
<a name="l00522"></a>00522 <span class="keyword">      end subroutine ifft2</span>
<a name="l00523"></a>00523 
<a name="l00524"></a>00524 <span class="comment">!     ================</span>
<a name="l00525"></a>00525 <span class="comment">!     SUBROUTINE IFFT3</span>
<a name="l00526"></a>00526 <span class="comment">!     ================</span>
<a name="l00527"></a>00527 
<a name="l00528"></a><a class="code" href="fftmod_8f90.html#a43856abf5ad7775f9454dd090e74e444">00528</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#a43856abf5ad7775f9454dd090e74e444">ifft3</a>(a,trigs,n,lot,la)
<a name="l00529"></a>00529       dimension a(n,lot),c(n,lot),trigs(n)
<a name="l00530"></a>00530       parameter(SIN60 = 0.866025403784438D0)
<a name="l00531"></a>00531 
<a name="l00532"></a>00532       ib = 2 * (n/3) + 1
<a name="l00533"></a>00533 
<a name="l00534"></a>00534       c(1,:) = 0.5 * a(1,:) + a(ib,:)
<a name="l00535"></a>00535       c(2,:) = 0.5 * a(1,:) - 0.5 * a(ib,:) - SIN60 * a(ib+1,:)
<a name="l00536"></a>00536       c(3,:) = 0.5 * a(1,:) - 0.5 * a(ib,:) + SIN60 * a(ib+1,:)
<a name="l00537"></a>00537 
<a name="l00538"></a>00538       ia = 3
<a name="l00539"></a>00539       ic = ib - 2
<a name="l00540"></a>00540       ib = ib + 2
<a name="l00541"></a>00541 
<a name="l00542"></a>00542       <span class="keyword">do</span> j = 4 , n-8 , 6
<a name="l00543"></a>00543          c1 = trigs(ia  )
<a name="l00544"></a>00544          s1 = trigs(ia+1)
<a name="l00545"></a>00545          c2 = trigs(ia+ia-1)
<a name="l00546"></a>00546          s2 = trigs(ia+ia  )
<a name="l00547"></a>00547 
<a name="l00548"></a>00548          <span class="keyword">do</span> l = 1 , lot
<a name="l00549"></a>00549             hbpc = a(ia  ,l) - 0.5 * (a(ib  ,l) + a(ic  ,l))
<a name="l00550"></a>00550             hbmc = a(ia+1,l) - 0.5 * (a(ib+1,l) - a(ic+1,l))
<a name="l00551"></a>00551             sbmc = SIN60 * (a(ib  ,l) - a(ic  ,l))
<a name="l00552"></a>00552             sbpc = SIN60 * (a(ib+1,l) + a(ic+1,l))
<a name="l00553"></a>00553 
<a name="l00554"></a>00554             c(j  ,l) = a(ia  ,l) + a(ib  ,l) + a(ic  ,l)
<a name="l00555"></a>00555             c(j+3,l) = a(ia+1,l) + a(ib+1,l) - a(ic+1,l)
<a name="l00556"></a>00556             c(j+1,l) = c1 * (hbpc-sbpc) - s1 * (hbmc+sbmc)
<a name="l00557"></a>00557             c(j+4,l) = s1 * (hbpc-sbpc) + c1 * (hbmc+sbmc)
<a name="l00558"></a>00558             c(j+2,l) = c2 * (hbpc+sbpc) - s2 * (hbmc-sbmc)
<a name="l00559"></a>00559             c(j+5,l) = s2 * (hbpc+sbpc) + c2 * (hbmc-sbmc)
<a name="l00560"></a>00560          <span class="keyword">enddo</span>
<a name="l00561"></a>00561          ia = ia + 2
<a name="l00562"></a>00562          ib = ib + 2
<a name="l00563"></a>00563          ic = ic - 2
<a name="l00564"></a>00564       <span class="keyword">enddo</span>
<a name="l00565"></a>00565 
<a name="l00566"></a>00566       c(n-2,:) = a(ia,:)
<a name="l00567"></a>00567       c(n-1,:) =   0.5 * a(ia,:) - SIN60 * a(ia+1,:)
<a name="l00568"></a>00568       c(n  ,:) = - 0.5 * a(ia,:) - SIN60 * a(ia+1,:)
<a name="l00569"></a>00569 
<a name="l00570"></a>00570       a(:,:)  = c(:,:)
<a name="l00571"></a>00571       la = 3
<a name="l00572"></a>00572       return
<a name="l00573"></a>00573 <span class="keyword">      end subroutine ifft3</span>
<a name="l00574"></a>00574 
<a name="l00575"></a>00575 <span class="comment">!     ================</span>
<a name="l00576"></a>00576 <span class="comment">!     SUBROUTINE IFFT8</span>
<a name="l00577"></a>00577 <span class="comment">!     ================</span>
<a name="l00578"></a>00578 
<a name="l00579"></a><a class="code" href="fftmod_8f90.html#a4c6991cf5c64fa6c35c4d42ff48a3574">00579</a>       <span class="keyword">subroutine </span><a class="code" href="fftmod_8f90.html#a4c6991cf5c64fa6c35c4d42ff48a3574">ifft8</a>(a,c,n,lot)
<a name="l00580"></a>00580       parameter(SQRT2 = 1.414213562373095D0)
<a name="l00581"></a>00581       dimension a(n*lot),c(n*lot)
<a name="l00582"></a>00582       la = n / 8
<a name="l00583"></a>00583 
<a name="l00584"></a>00584       <span class="keyword">do</span> i=0,la*lot-1
<a name="l00585"></a>00585          i0 = (i/la) * n + mod(i,la) + 1
<a name="l00586"></a>00586          i1 = i0 + la
<a name="l00587"></a>00587          i2 = i1 + la
<a name="l00588"></a>00588          i3 = i2 + la
<a name="l00589"></a>00589          i4 = i3 + la
<a name="l00590"></a>00590          i5 = i4 + la
<a name="l00591"></a>00591          i6 = i5 + la
<a name="l00592"></a>00592          i7 = i6 + la
<a name="l00593"></a>00593 
<a name="l00594"></a>00594          a0p7 = a(i0) + a(i7)
<a name="l00595"></a>00595          a0m7 = a(i0) - a(i7)
<a name="l00596"></a>00596          a1p5 = a(i1) + a(i5)
<a name="l00597"></a>00597          a1m5 = a(i1) - a(i5)
<a name="l00598"></a>00598          a2p6 = a(i2) + a(i6)
<a name="l00599"></a>00599          a2m6 = a(i2) - a(i6)
<a name="l00600"></a>00600 
<a name="l00601"></a>00601          a0p7p3   = a0p7 + a(i3)
<a name="l00602"></a>00602          a0p7m3   = a0p7 - a(i3)
<a name="l00603"></a>00603          a0m7p4   = 2.0 * (a0m7 + a(i4))
<a name="l00604"></a>00604          a0m7m4   = 2.0 * (a0m7 - a(i4))
<a name="l00605"></a>00605          a1m5p2p6 = SQRT2 * (a1m5 + a2p6)
<a name="l00606"></a>00606          a1m5m2p6 = SQRT2 * (a1m5 - a2p6)
<a name="l00607"></a>00607 
<a name="l00608"></a>00608          c(i0)  = 2.0 * (a0p7p3 + a1p5)
<a name="l00609"></a>00609          c(i2)  = 2.0 * (a0p7m3 - a2m6)
<a name="l00610"></a>00610          c(i4)  = 2.0 * (a0p7p3 - a1p5)
<a name="l00611"></a>00611          c(i6)  = 2.0 * (a0p7m3 + a2m6)
<a name="l00612"></a>00612 
<a name="l00613"></a>00613          c(i1)  = a0m7m4 + a1m5m2p6
<a name="l00614"></a>00614          c(i3)  = a0m7p4 - a1m5p2p6
<a name="l00615"></a>00615          c(i5)  = a0m7m4 - a1m5m2p6
<a name="l00616"></a>00616          c(i7)  = a0m7p4 + a1m5p2p6
<a name="l00617"></a>00617       <span class="keyword">enddo</span>
<a name="l00618"></a>00618       return
<a name="l00619"></a>00619 <span class="keyword">      end</span>
</pre></div></div>
</div>
  <div id="nav-path" class="navpath">
    <ul>
      <li class="navelem"><a class="el" href="fftmod_8f90.html">fftmod.f90</a>      </li>
<!-- window showing the filter options -->
<div id="MSearchSelectWindow"
     onmouseover="return searchBox.OnSearchSelectShow()"
     onmouseout="return searchBox.OnSearchSelectHide()"
     onkeydown="return searchBox.OnSearchSelectKey(event)">
<a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(0)"><span class="SelectionMark">&#160;</span>All</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(1)"><span class="SelectionMark">&#160;</span>Classes</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(2)"><span class="SelectionMark">&#160;</span>Files</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(3)"><span class="SelectionMark">&#160;</span>Functions</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(4)"><span class="SelectionMark">&#160;</span>Variables</a><a class="SelectItem" href="javascript:void(0)" onclick="searchBox.OnSelectItem(5)"><span class="SelectionMark">&#160;</span>Defines</a></div>

<!-- iframe showing the search results (closed by default) -->
<div id="MSearchResultsWindow">
<iframe src="javascript:void(0)" frameborder="0" 
        name="MSearchResults" id="MSearchResults">
</iframe>
</div>


    <li class="footer">Generated on Wed Sep 21 2011 12:35:46 for PUMA by
    <a href="http://www.doxygen.org/index.html">
    <img class="footer" src="doxygen.png" alt="doxygen"/></a> 1.7.5.1 </li>
   </ul>
 </div>


</body>
</html>