Home Explore Help
Sign In
TECLIM
/
PlaSim
3
0
Fork 0
Files Issues 0 Pull Requests 0 Wiki
Branch: master
Branches Tags
PlaSim
/
puma
/
dox
/
html
/
fftmod_8f90_source.html

fftmod_8f90_source.html 45 KB
Permalink History Raw

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748 
  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/fftmod.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('fftmod_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/fftmod.f90</div>  </div>
    99. 

  99. </div>
    100. 

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

  101. <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>
    102. 

  102. <a name="l00002"></a>00002 <span class="comment">!     MODULE FFTMOD</span>
    103. 

  103. <a name="l00003"></a>00003 <span class="comment">!     =============</span>
    104. 

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

  105. <a name="l00005"></a>00005       <span class="keyword">module</span> <a class="code" href="classfftmod.html">fftmod</a>
    106. 

  106. <a name="l00006"></a>00006       parameter(NRES = 12)
    107. 

  107. <a name="l00007"></a>00007       <span class="keywordtype">integer</span> :: nallowed(NRES) = (/16,32,48,64,96,128,256,384,512,1024,2048,4096/)
    108. 

  108. <a name="l00008"></a>00008 <span class="comment">!     T3    - N16   : 8-2</span>
    109. 

  109. <a name="l00009"></a>00009 <span class="comment">!     T10   - N32   : 8-2-2</span>
    110. 

  110. <a name="l00010"></a>00010 <span class="comment">!     T15   - N48   : 8-3-2</span>
    111. 

  111. <a name="l00011"></a>00011 <span class="comment">!     T21   - N64   : 8-4-2</span>
    112. 

  112. <a name="l00012"></a>00012 <span class="comment">!     T31   - N96   : 8-4-3</span>
    113. 

  113. <a name="l00013"></a>00013 <span class="comment">!     T42   - N128  : 8-4-4</span>
    114. 

  114. <a name="l00014"></a>00014 <span class="comment">!     T85   - N256  : 8-4-4-2</span>
    115. 

  115. <a name="l00015"></a>00015 <span class="comment">!     T127  - N384  : 8-4-4-3</span>
    116. 

  116. <a name="l00016"></a>00016 <span class="comment">!     T170  - N512  : 8-4-4-4</span>
    117. 

  117. <a name="l00017"></a>00017 <span class="comment">!     T341  - N1024 : 8-4-4-4-2</span>
    118. 

  118. <a name="l00018"></a>00018 <span class="comment">!     T682  - N2048 : 8-4-4-4-4</span>
    119. 

  119. <a name="l00019"></a>00019 <span class="comment">!     T1365 - N4096 : 8-4-4-4-4-2</span>
    120. 

  120. <a name="l00020"></a>00020 
    121. 

  121. <a name="l00021"></a>00021       <span class="keywordtype">integer</span> :: lastn = 0
    122. 

  122. <a name="l00022"></a>00022       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: trigs(:)
    123. 

  123. <a name="l00023"></a>00023 <span class="keyword">      end module fftmod</span>
    124. 

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

  125. <a name="l00025"></a>00025 <span class="comment">!     ================</span>
    126. 

  126. <a name="l00026"></a>00026 <span class="comment">!     SUBROUTINE GP2FC</span>
    127. 

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

  128. <a name="l00028"></a>00028 
    129. 

  129. <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)
    130. 

  130. <a name="l00030"></a>00030       use <span class="keywordflow">fftmod</span>
    131. 

  131. <a name="l00031"></a>00031       <span class="keywordtype">real</span> a(n,lot)
    132. 

  132. <a name="l00032"></a>00032 
    133. 

  133. <a name="l00033"></a>00033       <span class="keyword">if</span> (n /= lastn) <span class="keyword">then</span>
    134. 

  134. <a name="l00034"></a>00034          <span class="keyword">if</span> (<span class="keyword">allocated</span>(trigs)) <span class="keyword">deallocate</span>(trigs)
    135. 

  135. <a name="l00035"></a>00035          <span class="keyword">allocate</span>(trigs(n))
    136. 

  136. <a name="l00036"></a>00036          lastn = n
    137. 

  137. <a name="l00037"></a>00037          call <a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
    138. 

  138. <a name="l00038"></a>00038       <span class="keyword">endif</span>
    139. 

  139. <a name="l00039"></a>00039 
    140. 

  140. <a name="l00040"></a>00040       call <a class="code" href="fftmod_8f90.html#ad824fc1d5775104962b9b77142e909a3">dfft8</a>(a,a,n,lot)
    141. 

  141. <a name="l00041"></a>00041       la = n / 8
    142. 

  142. <a name="l00042"></a>00042       <span class="keyword">do</span> <span class="keyword">while</span> (la &gt;= 4)
    143. 

  143. <a name="l00043"></a>00043          call <a class="code" href="fftmod_8f90.html#a016c6910afcaeee463180fcc1d24297a">dfft4</a>(a,trigs,n,lot,la)
    144. 

  144. <a name="l00044"></a>00044       <span class="keyword">enddo</span>
    145. 

  145. <a name="l00045"></a>00045 
    146. 

  146. <a name="l00046"></a>00046       <span class="keyword">if</span> (la == 3) <span class="keyword">then</span>
    147. 

  147. <a name="l00047"></a>00047          <span class="keyword">do</span> l = 1 , lot
    148. 

  148. <a name="l00048"></a>00048             call <a class="code" href="fftmod_8f90.html#a1d7e74baca7896477fb2e32b73ccab37">dfft3</a>(a(1,l),trigs,n)
    149. 

  149. <a name="l00049"></a>00049          <span class="keyword">enddo</span>
    150. 

  150. <a name="l00050"></a>00050       <span class="keyword">endif</span>
    151. 

  151. <a name="l00051"></a>00051 
    152. 

  152. <a name="l00052"></a>00052       <span class="keyword">if</span> (la == 2) <span class="keyword">then</span>
    153. 

  153. <a name="l00053"></a>00053          <span class="keyword">do</span> l = 1 , lot
    154. 

  154. <a name="l00054"></a>00054             call <a class="code" href="fftmod_8f90.html#a6d2dbc83ff732343036d20cc9625cb98">dfft2</a>(a(1,l),trigs,n)
    155. 

  155. <a name="l00055"></a>00055          <span class="keyword">enddo</span>
    156. 

  156. <a name="l00056"></a>00056       <span class="keyword">endif</span>
    157. 

  157. <a name="l00057"></a>00057       return
    158. 

  158. <a name="l00058"></a>00058 <span class="keyword">      end subroutine gp2fc</span>
    159. 

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

  160. <a name="l00060"></a>00060 <span class="comment">!     ================</span>
    161. 

  161. <a name="l00061"></a>00061 <span class="comment">!     SUBROUTINE FC2GP</span>
    162. 

  162. <a name="l00062"></a>00062 <span class="comment">!     ================</span>
    163. 

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

  164. <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)
    165. 

  165. <a name="l00065"></a>00065       use <span class="keywordflow">fftmod</span>
    166. 

  166. <a name="l00066"></a>00066       <span class="keywordtype">real</span> a(n,lot)
    167. 

  167. <a name="l00067"></a>00067 
    168. 

  168. <a name="l00068"></a>00068       <span class="keyword">if</span> (n /= lastn) <span class="keyword">then</span>
    169. 

  169. <a name="l00069"></a>00069          <span class="keyword">if</span> (<span class="keyword">allocated</span>(trigs)) <span class="keyword">deallocate</span>(trigs)
    170. 

  170. <a name="l00070"></a>00070          <span class="keyword">allocate</span>(trigs(n))
    171. 

  171. <a name="l00071"></a>00071          lastn = n
    172. 

  172. <a name="l00072"></a>00072          call <a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
    173. 

  173. <a name="l00073"></a>00073       <span class="keyword">endif</span>
    174. 

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

  175. <a name="l00075"></a>00075       nf = n/8
    176. 

  176. <a name="l00076"></a>00076       <span class="keyword">do</span> <span class="keyword">while</span> (nf &gt;= 4)
    177. 

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

  178. <a name="l00078"></a>00078       <span class="keyword">enddo</span>
    179. 

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

  180. <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)
    181. 

  181. <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)
    182. 

  182. <a name="l00082"></a>00082       <span class="keyword">do</span> <span class="keyword">while</span> (la &lt; n/8)
    183. 

  183. <a name="l00083"></a>00083          call <a class="code" href="fftmod_8f90.html#aa4540793d1039abfdcc4512f4aacc8a0">ifft4</a>(a,trigs,n,lot,la)
    184. 

  184. <a name="l00084"></a>00084       <span class="keyword">enddo</span>
    185. 

  185. <a name="l00085"></a>00085       call <a class="code" href="fftmod_8f90.html#a4c6991cf5c64fa6c35c4d42ff48a3574">ifft8</a>(a,a,n,lot)
    186. 

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

  187. <a name="l00087"></a>00087 <span class="keyword">      end subroutine fc2gp</span>
    188. 

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

  189. <a name="l00089"></a>00089 <span class="comment">!     =================</span>
    190. 

  190. <a name="l00090"></a>00090 <span class="comment">!     SUBROUTINE FFTINI</span>
    191. 

  191. <a name="l00091"></a>00091 <span class="comment">!     =================</span>
    192. 

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

  193. <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)
    194. 

  194. <a name="l00094"></a>00094       use <span class="keywordflow">fftmod</span>
    195. 

  195. <a name="l00095"></a>00095       <span class="keywordtype">logical</span> labort
    196. 

  196. <a name="l00096"></a>00096 
    197. 

  197. <a name="l00097"></a>00097 <span class="comment">!     check for allowed values of n</span>
    198. 

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

  199. <a name="l00099"></a>00099       labort = .true.
    200. 

  200. <a name="l00100"></a>00100       <span class="keyword">do</span> j = 1 , NRES
    201. 

  201. <a name="l00101"></a>00101          <span class="keyword">if</span> (n == nallowed(j)) labort = .false.
    202. 

  202. <a name="l00102"></a>00102       <span class="keyword">enddo</span>
    203. 

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

  204. <a name="l00104"></a>00104       <span class="keyword">if</span> (labort) <span class="keyword">then</span>
    205. 

  205. <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>
    206. 

  206. <a name="l00106"></a>00106          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;Following resolutions may be used:&#39;</span>
    207. 

  207. <a name="l00107"></a>00107          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;----------------------------------&#39;</span>
    208. 

  208. <a name="l00108"></a>00108          <span class="keyword">do</span> j = 1 , NRES
    209. 

  209. <a name="l00109"></a>00109             <span class="keyword">write</span> (*,1000) nallowed(j), nallowed(j)/2, nallowed(j)/3
    210. 

  210. <a name="l00110"></a>00110          <span class="keyword">enddo</span>
    211. 

  211. <a name="l00111"></a>00111          stop
    212. 

  212. <a name="l00112"></a>00112       <span class="keyword">endif</span>
    213. 

  213. <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)
    214. 

  214. <a name="l00114"></a>00114 
    215. 

  215. <a name="l00115"></a>00115       del = 4.0 * asin(1.0) / n
    216. 

  216. <a name="l00116"></a>00116       <span class="keyword">do</span> k=0,n/2-1
    217. 

  217. <a name="l00117"></a>00117         angle = k * del
    218. 

  218. <a name="l00118"></a>00118         trigs(2*k+1) = cos(angle)
    219. 

  219. <a name="l00119"></a>00119         trigs(2*k+2) = sin(angle)
    220. 

  220. <a name="l00120"></a>00120       <span class="keyword">enddo</span>
    221. 

  221. <a name="l00121"></a>00121       return
    222. 

  222. <a name="l00122"></a>00122 <span class="keyword">      end subroutine fftini</span>
    223. 

  223. <a name="l00123"></a>00123 
    224. 

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

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

  226. <a name="l00126"></a>00126 <span class="comment">!     ================</span>
    227. 

  227. <a name="l00127"></a>00127 
    228. 

  228. <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)
    229. 

  229. <a name="l00129"></a>00129       dimension a(n),c(n),trigs(n)
    230. 

  230. <a name="l00130"></a>00130 
    231. 

  231. <a name="l00131"></a>00131       c(1) = a(1) + a(2)
    232. 

  232. <a name="l00132"></a>00132       c(2) = 0.0
    233. 

  233. <a name="l00133"></a>00133 
    234. 

  234. <a name="l00134"></a>00134       ja = 3
    235. 

  235. <a name="l00135"></a>00135       jb = n - 1
    236. 

  236. <a name="l00136"></a>00136 
    237. 

  237. <a name="l00137"></a>00137       <span class="keyword">do</span> i=3,n-5,4
    238. 

  238. <a name="l00138"></a>00138          c1 = trigs(ja  )
    239. 

  239. <a name="l00139"></a>00139          s1 = trigs(ja+1)
    240. 

  240. <a name="l00140"></a>00140          a1p3 = c1 * a(i+1) + s1 * a(i+3)
    241. 

  241. <a name="l00141"></a>00141          a3m1 = c1 * a(i+3) - s1 * a(i+1)
    242. 

  242. <a name="l00142"></a>00142          c(ja  ) = a(i) + a1p3
    243. 

  243. <a name="l00143"></a>00143          c(jb  ) = a(i) - a1p3
    244. 

  244. <a name="l00144"></a>00144          c(ja+1) = a3m1 + a(i+2)
    245. 

  245. <a name="l00145"></a>00145          c(jb+1) = a3m1 - a(i+2)
    246. 

  246. <a name="l00146"></a>00146          ja = ja + 2
    247. 

  247. <a name="l00147"></a>00147          jb = jb - 2
    248. 

  248. <a name="l00148"></a>00148       <span class="keyword">enddo</span>
    249. 

  249. <a name="l00149"></a>00149 
    250. 

  250. <a name="l00150"></a>00150       c(ja  ) =  a(n-1)
    251. 

  251. <a name="l00151"></a>00151       c(ja+1) = -a(n  )
    252. 

  252. <a name="l00152"></a>00152 
    253. 

  253. <a name="l00153"></a>00153       a = c
    254. 

  254. <a name="l00154"></a>00154       return
    255. 

  255. <a name="l00155"></a>00155 <span class="keyword">      end subroutine dfft2</span>
    256. 

  256. <a name="l00156"></a>00156 
    257. 

  257. <a name="l00157"></a>00157 <span class="comment">!     ================</span>
    258. 

  258. <a name="l00158"></a>00158 <span class="comment">!     SUBROUTINE DFFT3</span>
    259. 

  259. <a name="l00159"></a>00159 <span class="comment">!     ================</span>
    260. 

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

  261. <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)
    262. 

  262. <a name="l00162"></a>00162       parameter(SIN60 = 0.866025403784438D0)
    263. 

  263. <a name="l00163"></a>00163       dimension a(n),c(n),trigs(n)
    264. 

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

  265. <a name="l00165"></a>00165       ja = 1              <span class="comment">!  1</span>
    266. 

  266. <a name="l00166"></a>00166       jb = 2 * (n/3)  + 1 <span class="comment">! 65</span>
    267. 

  267. <a name="l00167"></a>00167       jc = jb             <span class="comment">! 65</span>
    268. 

  268. <a name="l00168"></a>00168 
    269. 

  269. <a name="l00169"></a>00169       c(ja  ) = a(1) + a(2) + a(3)
    270. 

  270. <a name="l00170"></a>00170       c(ja+1) = 0.0
    271. 

  271. <a name="l00171"></a>00171       c(jb  ) = a(1) - 0.5 * (a(2) + a(3))
    272. 

  272. <a name="l00172"></a>00172       c(jb+1) =      SIN60 * (a(3) - a(2))
    273. 

  273. <a name="l00173"></a>00173 
    274. 

  274. <a name="l00174"></a>00174       ja = 3         <span class="comment">!  3, 5, 7, ... ,31</span>
    275. 

  275. <a name="l00175"></a>00175       jb = jb + 2    <span class="comment">! 67,69,71, ... ,95</span>
    276. 

  276. <a name="l00176"></a>00176       jc = jc - 2    <span class="comment">! 63,61,59, ... ,35</span>
    277. 

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

  278. <a name="l00178"></a>00178       <span class="keyword">do</span> i = 4 , n-8 , 6 <span class="comment">! 88</span>
    279. 

  279. <a name="l00179"></a>00179          c1 = trigs(ja  )
    280. 

  280. <a name="l00180"></a>00180          s1 = trigs(ja+1)
    281. 

  281. <a name="l00181"></a>00181          c2 = trigs(ja+ja-1)
    282. 

  282. <a name="l00182"></a>00182          s2 = trigs(ja+ja  )
    283. 

  283. <a name="l00183"></a>00183          a1 = (c1*a(i+1)+s1*a(i+4))+(c2*a(i+2)+s2*a(i+5))
    284. 

  284. <a name="l00184"></a>00184          b1 = (c1*a(i+4)-s1*a(i+1))+(c2*a(i+5)-s2*a(i+2))
    285. 

  285. <a name="l00185"></a>00185          a2 = a(i  ) - 0.5 * a1
    286. 

  286. <a name="l00186"></a>00186          b2 = a(i+3) - 0.5 * b1
    287. 

  287. <a name="l00187"></a>00187          a3 = SIN60*((c1*a(i+1)+s1*a(i+4))-(c2*a(i+2)+s2*a(i+5)))
    288. 

  288. <a name="l00188"></a>00188          b3 = SIN60*((c1*a(i+4)-s1*A(i+1))-(c2*a(i+5)-s2*a(i+2)))
    289. 

  289. <a name="l00189"></a>00189          c(ja  ) = a(i  ) + a1
    290. 

  290. <a name="l00190"></a>00190          c(ja+1) = a(i+3) + b1
    291. 

  291. <a name="l00191"></a>00191          c(jb  ) = a2 + b3
    292. 

  292. <a name="l00192"></a>00192          c(jb+1) = b2 - a3
    293. 

  293. <a name="l00193"></a>00193          c(jc  ) = a2 - b3
    294. 

  294. <a name="l00194"></a>00194          c(jc+1) =-b2 - a3
    295. 

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

  296. <a name="l00196"></a>00196          jb = jb + 2
    297. 

  297. <a name="l00197"></a>00197          jc = jc - 2
    298. 

  298. <a name="l00198"></a>00198       <span class="keyword">enddo</span>
    299. 

  299. <a name="l00199"></a>00199 
    300. 

  300. <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>
    301. 

  301. <a name="l00201"></a>00201          c(ja  ) = a(n-2) + 0.5 * (a(n-1) - a(n)) <span class="comment">! 33</span>
    302. 

  302. <a name="l00202"></a>00202          c(ja+1) =       -SIN60 * (a(n-1) + a(n)) <span class="comment">! 34</span>
    303. 

  303. <a name="l00203"></a>00203       <span class="keyword">endif</span>
    304. 

  304. <a name="l00204"></a>00204       a(:) = c(:)
    305. 

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

  306. <a name="l00206"></a>00206 <span class="keyword">      end subroutine dfft3</span>
    307. 

  307. <a name="l00207"></a>00207 
    308. 

  308. <a name="l00208"></a>00208 <span class="comment">!     ================</span>
    309. 

  309. <a name="l00209"></a>00209 <span class="comment">!     SUBROUTINE DFFT4</span>
    310. 

  310. <a name="l00210"></a>00210 <span class="comment">!     ================</span>
    311. 

  311. <a name="l00211"></a>00211 
    312. 

  312. <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)
    313. 

  313. <a name="l00213"></a>00213       dimension a(n,lot),c(n,lot),trigs(n)
    314. 

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

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

  316. <a name="l00216"></a>00216       i1 = la
    317. 

  317. <a name="l00217"></a>00217       i2 = la + i1
    318. 

  318. <a name="l00218"></a>00218       i3 = la + i2
    319. 

  319. <a name="l00219"></a>00219       i4 = la + i3
    320. 

  320. <a name="l00220"></a>00220       i5 = la + i4
    321. 

  321. <a name="l00221"></a>00221       i6 = la + i5
    322. 

  322. <a name="l00222"></a>00222       i7 = la + i6
    323. 

  323. <a name="l00223"></a>00223 
    324. 

  324. <a name="l00224"></a>00224       j1 = n/2 - la
    325. 

  325. <a name="l00225"></a>00225       j2 = n - la
    326. 

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

  327. <a name="l00227"></a>00227       j5 = j1 + la
    328. 

  328. <a name="l00228"></a>00228 
    329. 

  329. <a name="l00229"></a>00229       <span class="keyword">do</span> i=1,la
    330. 

  330. <a name="l00230"></a>00230          <span class="keyword">do</span> l=1,lot
    331. 

  331. <a name="l00231"></a>00231          a0p2 = a(i   ,l) + a(i2+i,l)
    332. 

  332. <a name="l00232"></a>00232          a1p3 = a(i1+i,l) + a(i3+i,l)
    333. 

  333. <a name="l00233"></a>00233          c(   i,l) = a0p2 + a1p3
    334. 

  334. <a name="l00234"></a>00234          c(j2+i,l) = a0p2 - a1p3
    335. 

  335. <a name="l00235"></a>00235          c(j1+i,l) = a(   i,l) - a(i2+i,l)
    336. 

  336. <a name="l00236"></a>00236          c(j5+i,l) = a(i3+i,l) - a(i1+i,l)
    337. 

  337. <a name="l00237"></a>00237          <span class="keyword">enddo</span>
    338. 

  338. <a name="l00238"></a>00238       <span class="keyword">enddo</span>
    339. 

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

  340. <a name="l00240"></a>00240       jink = 2 * la
    341. 

  341. <a name="l00241"></a>00241       j0 = la
    342. 

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

  343. <a name="l00243"></a>00243       j2 = j2 - jink
    344. 

  344. <a name="l00244"></a>00244       j3 = j3 - jink
    345. 

  345. <a name="l00245"></a>00245       j4 = j0 + la
    346. 

  346. <a name="l00246"></a>00246       j5 = j1 + la
    347. 

  347. <a name="l00247"></a>00247       j6 = j2 + la
    348. 

  348. <a name="l00248"></a>00248       j7 = j3 + la
    349. 

  349. <a name="l00249"></a>00249 
    350. 

  350. <a name="l00250"></a>00250       ibase=4*la
    351. 

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

  352. <a name="l00252"></a>00252       <span class="keyword">do</span> 450 k=la,(n-4)/8,la
    353. 

  353. <a name="l00253"></a>00253          kb=k+k
    354. 

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

  355. <a name="l00255"></a>00255          kd=kc+kb
    356. 

  356. <a name="l00256"></a>00256          c1=trigs(kb+1)
    357. 

  357. <a name="l00257"></a>00257          s1=trigs(kb+2)
    358. 

  358. <a name="l00258"></a>00258          c2=trigs(kc+1)
    359. 

  359. <a name="l00259"></a>00259          s2=trigs(kc+2)
    360. 

  360. <a name="l00260"></a>00260          c3=trigs(kd+1)
    361. 

  361. <a name="l00261"></a>00261          s3=trigs(kd+2)
    362. 

  362. <a name="l00262"></a>00262 
    363. 

  363. <a name="l00263"></a>00263          i=ibase+1
    364. 

  364. <a name="l00264"></a>00264          <span class="keyword">do</span> j=1,la
    365. 

  365. <a name="l00265"></a>00265             <span class="keyword">do</span> l=1,lot
    366. 

  366. <a name="l00266"></a>00266             a1p5 = c1 * a(i1+i,l) + s1 * a(i5+i,l)
    367. 

  367. <a name="l00267"></a>00267             a2p6 = c2 * a(i2+i,l) + s2 * a(i6+i,l)
    368. 

  368. <a name="l00268"></a>00268             a3p7 = c3 * a(i3+i,l) + s3 * a(i7+i,l)
    369. 

  369. <a name="l00269"></a>00269             a5m1 = c1 * a(i5+i,l) - s1 * a(i1+i,l)
    370. 

  370. <a name="l00270"></a>00270             a6m2 = c2 * a(i6+i,l) - s2 * a(i2+i,l)
    371. 

  371. <a name="l00271"></a>00271             a7m3 = c3 * a(i7+i,l) - s3 * a(i3+i,l)
    372. 

  372. <a name="l00272"></a>00272             a0 = a(i,l) + a2p6
    373. 

  373. <a name="l00273"></a>00273             a2 = a(i,l) - a2p6
    374. 

  374. <a name="l00274"></a>00274             a1 = a1p5 + a3p7
    375. 

  375. <a name="l00275"></a>00275             a3 = a3p7 - a1p5
    376. 

  376. <a name="l00276"></a>00276             b0 = a(i4+i,l) + a6m2
    377. 

  377. <a name="l00277"></a>00277             b2 = a(i4+i,l) - a6m2
    378. 

  378. <a name="l00278"></a>00278             b1 = a5m1 + a7m3
    379. 

  379. <a name="l00279"></a>00279             b3 = a5m1 - a7m3
    380. 

  380. <a name="l00280"></a>00280             c(j0+j,l) = a0+a1
    381. 

  381. <a name="l00281"></a>00281             c(j2+j,l) = a0-a1
    382. 

  382. <a name="l00282"></a>00282             c(j4+j,l) = b0+b1
    383. 

  383. <a name="l00283"></a>00283             c(j6+j,l) = b1-b0
    384. 

  384. <a name="l00284"></a>00284             c(j1+j,l) = a2+b3
    385. 

  385. <a name="l00285"></a>00285             c(j3+j,l) = a2-b3
    386. 

  386. <a name="l00286"></a>00286             c(j5+j,l) = a3+b2
    387. 

  387. <a name="l00287"></a>00287             c(j7+j,l) = a3-b2
    388. 

  388. <a name="l00288"></a>00288             <span class="keyword">enddo</span>
    389. 

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

  390. <a name="l00290"></a>00290          <span class="keyword">enddo</span>
    391. 

  391. <a name="l00291"></a>00291 
    392. 

  392. <a name="l00292"></a>00292         ibase=ibase+8*la
    393. 

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

  394. <a name="l00294"></a>00294         j1 = j1 + jink
    395. 

  395. <a name="l00295"></a>00295         j2 = j2 - jink
    396. 

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

  397. <a name="l00297"></a>00297         j4 = j0 + la
    398. 

  398. <a name="l00298"></a>00298         j5 = j1 + la
    399. 

  399. <a name="l00299"></a>00299         j6 = j2 + la
    400. 

  400. <a name="l00300"></a>00300         j7 = j3 + la
    401. 

  401. <a name="l00301"></a>00301 450   continue
    402. 

  402. <a name="l00302"></a>00302       <span class="keyword">if</span> (j1 &lt;= j2) <span class="keyword">then</span>
    403. 

  403. <a name="l00303"></a>00303          sin45=sqrt(0.5)
    404. 

  404. <a name="l00304"></a>00304          i=ibase+1
    405. 

  405. <a name="l00305"></a>00305          <span class="keyword">do</span> j=1,la
    406. 

  406. <a name="l00306"></a>00306             <span class="keyword">do</span> l=1,lot
    407. 

  407. <a name="l00307"></a>00307             a1p3 = sin45 * (a(i1+i,l) + a(i3+i,l))
    408. 

  408. <a name="l00308"></a>00308             a1m3 = sin45 * (a(i1+i,l) - a(i3+i,l))
    409. 

  409. <a name="l00309"></a>00309             c(j0+j,l) =  a(   i,l) + a1m3
    410. 

  410. <a name="l00310"></a>00310             c(j1+j,l) =  a(   i,l) - a1m3
    411. 

  411. <a name="l00311"></a>00311             c(j4+j,l) = -a(i2+i,l) - a1p3
    412. 

  412. <a name="l00312"></a>00312             c(j5+j,l) =  a(i2+i,l) - a1p3
    413. 

  413. <a name="l00313"></a>00313             <span class="keyword">enddo</span>
    414. 

  414. <a name="l00314"></a>00314             i=i+1
    415. 

  415. <a name="l00315"></a>00315          <span class="keyword">enddo</span>
    416. 

  416. <a name="l00316"></a>00316       <span class="keyword">endif</span>
    417. 

  417. <a name="l00317"></a>00317       <span class="keyword">if</span> (la == 1) <span class="keyword">then</span>
    418. 

  418. <a name="l00318"></a>00318          <span class="keyword">do</span> l=1,lot
    419. 

  419. <a name="l00319"></a>00319          a(1,l) = c(1,l)
    420. 

  420. <a name="l00320"></a>00320          a(2,l) = 0.0
    421. 

  421. <a name="l00321"></a>00321          a(3:n,l) = c(2:n-1,l)
    422. 

  422. <a name="l00322"></a>00322          <span class="keyword">enddo</span>
    423. 

  423. <a name="l00323"></a>00323       <span class="keyword">else</span>
    424. 

  424. <a name="l00324"></a>00324          a = c
    425. 

  425. <a name="l00325"></a>00325       <span class="keyword">endif</span>
    426. 

  426. <a name="l00326"></a>00326       return
    427. 

  427. <a name="l00327"></a>00327 <span class="keyword">      end subroutine dfft4</span>
    428. 

  428. <a name="l00328"></a>00328 
    429. 

  429. <a name="l00329"></a>00329 <span class="comment">!     ================</span>
    430. 

  430. <a name="l00330"></a>00330 <span class="comment">!     SUBROUTINE DFFT8</span>
    431. 

  431. <a name="l00331"></a>00331 <span class="comment">!     ================</span>
    432. 

  432. <a name="l00332"></a>00332 
    433. 

  433. <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)
    434. 

  434. <a name="l00334"></a>00334       <span class="keywordtype">real</span> a(n*lot),c(n*lot)
    435. 

  435. <a name="l00335"></a>00335       la = n / 8
    436. 

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

  437. <a name="l00337"></a>00337       zsin45 = z * sqrt(0.5)
    438. 

  438. <a name="l00338"></a>00338 
    439. 

  439. <a name="l00339"></a>00339       <span class="keyword">do</span> i=0,la*lot-1
    440. 

  440. <a name="l00340"></a>00340          i0 = (i/la) * n + mod(i,la) + 1
    441. 

  441. <a name="l00341"></a>00341          i1 = i0 + la
    442. 

  442. <a name="l00342"></a>00342          i2 = i1 + la
    443. 

  443. <a name="l00343"></a>00343          i3 = i2 + la
    444. 

  444. <a name="l00344"></a>00344          i4 = i3 + la
    445. 

  445. <a name="l00345"></a>00345          i5 = i4 + la
    446. 

  446. <a name="l00346"></a>00346          i6 = i5 + la
    447. 

  447. <a name="l00347"></a>00347          i7 = i6 + la
    448. 

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

  449. <a name="l00349"></a>00349          a0p4 =  a(i0) + a(i4)
    450. 

  450. <a name="l00350"></a>00350          a1p5 =  a(i1) + a(i5)
    451. 

  451. <a name="l00351"></a>00351          a2p6 =  a(i2) + a(i6)
    452. 

  452. <a name="l00352"></a>00352          a3p7 =  a(i3) + a(i7)
    453. 

  453. <a name="l00353"></a>00353          a5m1 =  a(i5) - a(i1)
    454. 

  454. <a name="l00354"></a>00354          a7m3 =  a(i7) - a(i3)
    455. 

  455. <a name="l00355"></a>00355          a0m4 = (a(i0) - a(i4)) * z
    456. 

  456. <a name="l00356"></a>00356          a6m2 = (a(i6) - a(i2)) * z
    457. 

  457. <a name="l00357"></a>00357 
    458. 

  458. <a name="l00358"></a>00358          a0p4p2p6 = a0p4 + a2p6
    459. 

  459. <a name="l00359"></a>00359          a1p5p3p7 = a1p5 + a3p7
    460. 

  460. <a name="l00360"></a>00360          a7m3p5m1 = (a7m3 + a5m1) * zsin45
    461. 

  461. <a name="l00361"></a>00361          a7m3m5m1 = (a7m3 - a5m1) * zsin45
    462. 

  462. <a name="l00362"></a>00362 
    463. 

  463. <a name="l00363"></a>00363          c(i0) = z * (a0p4p2p6 + a1p5p3p7)
    464. 

  464. <a name="l00364"></a>00364          c(i7) = z * (a0p4p2p6 - a1p5p3p7)
    465. 

  465. <a name="l00365"></a>00365          c(i3) = z * (a0p4 - a2p6)
    466. 

  466. <a name="l00366"></a>00366          c(i4) = z * (a3p7 - a1p5)
    467. 

  467. <a name="l00367"></a>00367          c(i1) = a0m4 + a7m3m5m1
    468. 

  468. <a name="l00368"></a>00368          c(i5) = a0m4 - a7m3m5m1
    469. 

  469. <a name="l00369"></a>00369          c(i2) = a7m3p5m1 + a6m2
    470. 

  470. <a name="l00370"></a>00370          c(i6) = a7m3p5m1 - a6m2
    471. 

  471. <a name="l00371"></a>00371       <span class="keyword">enddo</span>
    472. 

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

  473. <a name="l00373"></a>00373 <span class="keyword">      end subroutine dfft8</span>
    474. 

  474. <a name="l00374"></a>00374 
    475. 

  475. <a name="l00375"></a>00375 <span class="comment">!     ================</span>
    476. 

  476. <a name="l00376"></a>00376 <span class="comment">!     SUBROUTINE IFFT4</span>
    477. 

  477. <a name="l00377"></a>00377 <span class="comment">!     ================</span>
    478. 

  478. <a name="l00378"></a>00378 
    479. 

  479. <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)
    480. 

  480. <a name="l00380"></a>00380       dimension a(n,lot),c(n,lot),trigs(n)
    481. 

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

  482. <a name="l00382"></a>00382       <span class="keyword">if</span> (la == 1) <span class="keyword">then</span>
    483. 

  483. <a name="l00383"></a>00383          a(1,:) = 0.5 * c(1,:)
    484. 

  484. <a name="l00384"></a>00384          a(n,:) = 0.0
    485. 

  485. <a name="l00385"></a>00385          a(2:n-1,:) = c(3:n,:)
    486. 

  486. <a name="l00386"></a>00386       <span class="keyword">else</span>
    487. 

  487. <a name="l00387"></a>00387          a = c
    488. 

  488. <a name="l00388"></a>00388       <span class="keyword">endif</span>
    489. 

  489. <a name="l00389"></a>00389 
    490. 

  490. <a name="l00390"></a>00390       m=n/4
    491. 

  491. <a name="l00391"></a>00391       kstop=(n-4)/8
    492. 

  492. <a name="l00392"></a>00392 
    493. 

  493. <a name="l00393"></a>00393       i1 = n/2 - la
    494. 

  494. <a name="l00394"></a>00394       i2 = n   - la
    495. 

  495. <a name="l00395"></a>00395       i5 = i1  + la
    496. 

  496. <a name="l00396"></a>00396 
    497. 

  497. <a name="l00397"></a>00397       j1 = la
    498. 

  498. <a name="l00398"></a>00398       j2 = la+j1
    499. 

  499. <a name="l00399"></a>00399       j3 = la+j2
    500. 

  500. <a name="l00400"></a>00400       j4 = la+j3
    501. 

  501. <a name="l00401"></a>00401       j5 = la+j4
    502. 

  502. <a name="l00402"></a>00402       j6 = la+j5
    503. 

  503. <a name="l00403"></a>00403       j7 = la+j6
    504. 

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

  505. <a name="l00405"></a>00405       <span class="keyword">do</span> i=1,la
    506. 

  506. <a name="l00406"></a>00406       <span class="keyword">do</span> l=1,lot
    507. 

  507. <a name="l00407"></a>00407          c(   i,l) = a(i,l) + a(i2+i,l) + a(i1+i,l)
    508. 

  508. <a name="l00408"></a>00408          c(j1+i,l) = a(i,l) - a(i2+i,l) - a(i5+i,l)
    509. 

  509. <a name="l00409"></a>00409          c(j2+i,l) = a(i,l) + a(i2+i,l) - a(i1+i,l)
    510. 

  510. <a name="l00410"></a>00410          c(j3+i,l) = a(i,l) - a(i2+i,l) + a(i5+i,l)
    511. 

  511. <a name="l00411"></a>00411       <span class="keyword">enddo</span>
    512. 

  512. <a name="l00412"></a>00412       <span class="keyword">enddo</span>
    513. 

  513. <a name="l00413"></a>00413 
    514. 

  514. <a name="l00414"></a>00414       iink  = 2 * la
    515. 

  515. <a name="l00415"></a>00415       jbase = 4 * la + 1
    516. 

  516. <a name="l00416"></a>00416       i0    = la
    517. 

  517. <a name="l00417"></a>00417       i1    = i0 + n/2
    518. 

  518. <a name="l00418"></a>00418       i2    = n - 3 * la
    519. 

  519. <a name="l00419"></a>00419       i3    = i2 - n/2
    520. 

  520. <a name="l00420"></a>00420       i4    = i0 + la
    521. 

  521. <a name="l00421"></a>00421       i5    = i1 + la
    522. 

  522. <a name="l00422"></a>00422       i6    = i2 + la
    523. 

  523. <a name="l00423"></a>00423       i7    = i3 + la
    524. 

  524. <a name="l00424"></a>00424 
    525. 

  525. <a name="l00425"></a>00425       <span class="keyword">do</span> 450 k=la,kstop,la
    526. 

  526. <a name="l00426"></a>00426         kb=k+k
    527. 

  527. <a name="l00427"></a>00427         kc=kb+kb
    528. 

  528. <a name="l00428"></a>00428         kd=kc+kb
    529. 

  529. <a name="l00429"></a>00429         c1=trigs(kb+1)
    530. 

  530. <a name="l00430"></a>00430         s1=trigs(kb+2)
    531. 

  531. <a name="l00431"></a>00431         c2=trigs(kc+1)
    532. 

  532. <a name="l00432"></a>00432         s2=trigs(kc+2)
    533. 

  533. <a name="l00433"></a>00433         c3=trigs(kd+1)
    534. 

  534. <a name="l00434"></a>00434         s3=trigs(kd+2)
    535. 

  535. <a name="l00435"></a>00435         <span class="keyword">do</span> i = 1 , la
    536. 

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

  537. <a name="l00437"></a>00437            <span class="keyword">do</span> l=1,lot
    538. 

  538. <a name="l00438"></a>00438            a0p2 = a(i0+i,l) + a(i2+i,l)
    539. 

  539. <a name="l00439"></a>00439            a0m2 = a(i0+i,l) - a(i2+i,l)
    540. 

  540. <a name="l00440"></a>00440            a1p3 = a(i1+i,l) + a(i3+i,l)
    541. 

  541. <a name="l00441"></a>00441            a1m3 = a(i1+i,l) - a(i3+i,l)
    542. 

  542. <a name="l00442"></a>00442            a4p6 = a(i4+i,l) + a(i6+i,l)
    543. 

  543. <a name="l00443"></a>00443            a4m6 = a(i4+i,l) - a(i6+i,l)
    544. 

  544. <a name="l00444"></a>00444            a5p7 = a(i5+i,l) + a(i7+i,l)
    545. 

  545. <a name="l00445"></a>00445            a5m7 = a(i5+i,l) - a(i7+i,l)
    546. 

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

  547. <a name="l00447"></a>00447            a0p2m1p3 = a0p2 - a1p3
    548. 

  548. <a name="l00448"></a>00448            a4m6m5m7 = a4m6 - a5m7
    549. 

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

  550. <a name="l00450"></a>00450            c(   j,l) = a0p2 + a1p3
    551. 

  551. <a name="l00451"></a>00451            c(j4+j,l) = a4m6 + a5m7
    552. 

  552. <a name="l00452"></a>00452            c(j2+j,l) = c2 * a0p2m1p3 - s2 * a4m6m5m7
    553. 

  553. <a name="l00453"></a>00453            c(j6+j,l) = s2 * a0p2m1p3 + c2 * a4m6m5m7
    554. 

  554. <a name="l00454"></a>00454            c(j1+j,l) = c1*(a0m2-a5p7)-s1*(a4p6+a1m3)
    555. 

  555. <a name="l00455"></a>00455            c(j5+j,l) = s1*(a0m2-a5p7)+c1*(a4p6+a1m3)
    556. 

  556. <a name="l00456"></a>00456            c(j3+j,l) = c3*(a0m2+a5p7)-s3*(a4p6-a1m3)
    557. 

  557. <a name="l00457"></a>00457            c(j7+j,l) = s3*(a0m2+a5p7)+c3*(a4p6-a1m3)
    558. 

  558. <a name="l00458"></a>00458            <span class="keyword">enddo</span>
    559. 

  559. <a name="l00459"></a>00459            jbase=jbase+1
    560. 

  560. <a name="l00460"></a>00460         <span class="keyword">enddo</span>
    561. 

  561. <a name="l00461"></a>00461         i0 = i0 + iink
    562. 

  562. <a name="l00462"></a>00462         i1 = i1 + iink
    563. 

  563. <a name="l00463"></a>00463         i2 = i2 - iink
    564. 

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

  565. <a name="l00465"></a>00465         i4 = i4 + iink
    566. 

  566. <a name="l00466"></a>00466         i5 = i5 + iink
    567. 

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

  568. <a name="l00468"></a>00468         i7 = i7 - iink
    569. 

  569. <a name="l00469"></a>00469         jbase=jbase+7*la
    570. 

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

  571. <a name="l00471"></a>00471 
    572. 

  572. <a name="l00472"></a>00472       <span class="keyword">if</span> (i1 &lt;= i2) <span class="keyword">then</span>
    573. 

  573. <a name="l00473"></a>00473          sin45=sqrt(0.5)
    574. 

  574. <a name="l00474"></a>00474          <span class="keyword">do</span> i=1,la
    575. 

  575. <a name="l00475"></a>00475             j=jbase
    576. 

  576. <a name="l00476"></a>00476             <span class="keyword">do</span> l=1,lot
    577. 

  577. <a name="l00477"></a>00477             c(   j,l)=a(i0+i,l)+a(i1+i,l)
    578. 

  578. <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)))
    579. 

  579. <a name="l00479"></a>00479             c(j2+j,l)=a(la+i1+i,l)-a(la+i0+i,l)
    580. 

  580. <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)))
    581. 

  581. <a name="l00481"></a>00481             <span class="keyword">enddo</span>
    582. 

  582. <a name="l00482"></a>00482             jbase=jbase+1
    583. 

  583. <a name="l00483"></a>00483          <span class="keyword">enddo</span>
    584. 

  584. <a name="l00484"></a>00484       <span class="keyword">endif</span>
    585. 

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

  586. <a name="l00486"></a>00486       return
    587. 

  587. <a name="l00487"></a>00487 <span class="keyword">      end subroutine ifft4</span>
    588. 

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

  589. <a name="l00489"></a>00489 <span class="comment">!     ================</span>
    590. 

  590. <a name="l00490"></a>00490 <span class="comment">!     SUBROUTINE IFFT2</span>
    591. 

  591. <a name="l00491"></a>00491 <span class="comment">!     ================</span>
    592. 

  592. <a name="l00492"></a>00492 
    593. 

  593. <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)
    594. 

  594. <a name="l00494"></a>00494       dimension a(n,lot),c(n,lot),trigs(n)
    595. 

  595. <a name="l00495"></a>00495 
    596. 

  596. <a name="l00496"></a>00496       c(1,:) = 0.5 * a(1,:)
    597. 

  597. <a name="l00497"></a>00497       c(2,:) = c(1,:)
    598. 

  598. <a name="l00498"></a>00498 
    599. 

  599. <a name="l00499"></a>00499       ia    =   3
    600. 

  600. <a name="l00500"></a>00500       ib    = n-1
    601. 

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

  602. <a name="l00502"></a>00502       <span class="keyword">do</span> j = 3 , n-5 , 4
    603. 

  603. <a name="l00503"></a>00503          c1 = trigs(ia  )
    604. 

  604. <a name="l00504"></a>00504          s1 = trigs(ia+1)
    605. 

  605. <a name="l00505"></a>00505          <span class="keyword">do</span> l=1,lot
    606. 

  606. <a name="l00506"></a>00506          amb = a(ia  ,l) - a(ib  ,l)
    607. 

  607. <a name="l00507"></a>00507          apb = a(ia+1,l) + a(ib+1,l)
    608. 

  608. <a name="l00508"></a>00508          c(j  ,l) = a(ia  ,l) + a(ib  ,l)
    609. 

  609. <a name="l00509"></a>00509          c(j+2,l) = a(ia+1,l) - a(ib+1,l)
    610. 

  610. <a name="l00510"></a>00510          c(j+1,l) = c1 * amb - s1 * apb
    611. 

  611. <a name="l00511"></a>00511          c(j+3,l) = s1 * amb + c1 * apb
    612. 

  612. <a name="l00512"></a>00512          <span class="keyword">enddo</span>
    613. 

  613. <a name="l00513"></a>00513          ia = ia + 2
    614. 

  614. <a name="l00514"></a>00514          ib = ib - 2
    615. 

  615. <a name="l00515"></a>00515       <span class="keyword">enddo</span>
    616. 

  616. <a name="l00516"></a>00516       c(n-1,:) =  a(ia  ,:)
    617. 

  617. <a name="l00517"></a>00517       c(n  ,:) = -a(ia+1,:)
    618. 

  618. <a name="l00518"></a>00518 
    619. 

  619. <a name="l00519"></a>00519       a(:,:) = c(:,:)
    620. 

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

  621. <a name="l00521"></a>00521       return
    622. 

  622. <a name="l00522"></a>00522 <span class="keyword">      end subroutine ifft2</span>
    623. 

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

  624. <a name="l00524"></a>00524 <span class="comment">!     ================</span>
    625. 

  625. <a name="l00525"></a>00525 <span class="comment">!     SUBROUTINE IFFT3</span>
    626. 

  626. <a name="l00526"></a>00526 <span class="comment">!     ================</span>
    627. 

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

  628. <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)
    629. 

  629. <a name="l00529"></a>00529       dimension a(n,lot),c(n,lot),trigs(n)
    630. 

  630. <a name="l00530"></a>00530       parameter(SIN60 = 0.866025403784438D0)
    631. 

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

  632. <a name="l00532"></a>00532       ib = 2 * (n/3) + 1
    633. 

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

  634. <a name="l00534"></a>00534       c(1,:) = 0.5 * a(1,:) + a(ib,:)
    635. 

  635. <a name="l00535"></a>00535       c(2,:) = 0.5 * a(1,:) - 0.5 * a(ib,:) - SIN60 * a(ib+1,:)
    636. 

  636. <a name="l00536"></a>00536       c(3,:) = 0.5 * a(1,:) - 0.5 * a(ib,:) + SIN60 * a(ib+1,:)
    637. 

  637. <a name="l00537"></a>00537 
    638. 

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

  639. <a name="l00539"></a>00539       ic = ib - 2
    640. 

  640. <a name="l00540"></a>00540       ib = ib + 2
    641. 

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

  642. <a name="l00542"></a>00542       <span class="keyword">do</span> j = 4 , n-8 , 6
    643. 

  643. <a name="l00543"></a>00543          c1 = trigs(ia  )
    644. 

  644. <a name="l00544"></a>00544          s1 = trigs(ia+1)
    645. 

  645. <a name="l00545"></a>00545          c2 = trigs(ia+ia-1)
    646. 

  646. <a name="l00546"></a>00546          s2 = trigs(ia+ia  )
    647. 

  647. <a name="l00547"></a>00547 
    648. 

  648. <a name="l00548"></a>00548          <span class="keyword">do</span> l = 1 , lot
    649. 

  649. <a name="l00549"></a>00549             hbpc = a(ia  ,l) - 0.5 * (a(ib  ,l) + a(ic  ,l))
    650. 

  650. <a name="l00550"></a>00550             hbmc = a(ia+1,l) - 0.5 * (a(ib+1,l) - a(ic+1,l))
    651. 

  651. <a name="l00551"></a>00551             sbmc = SIN60 * (a(ib  ,l) - a(ic  ,l))
    652. 

  652. <a name="l00552"></a>00552             sbpc = SIN60 * (a(ib+1,l) + a(ic+1,l))
    653. 

  653. <a name="l00553"></a>00553 
    654. 

  654. <a name="l00554"></a>00554             c(j  ,l) = a(ia  ,l) + a(ib  ,l) + a(ic  ,l)
    655. 

  655. <a name="l00555"></a>00555             c(j+3,l) = a(ia+1,l) + a(ib+1,l) - a(ic+1,l)
    656. 

  656. <a name="l00556"></a>00556             c(j+1,l) = c1 * (hbpc-sbpc) - s1 * (hbmc+sbmc)
    657. 

  657. <a name="l00557"></a>00557             c(j+4,l) = s1 * (hbpc-sbpc) + c1 * (hbmc+sbmc)
    658. 

  658. <a name="l00558"></a>00558             c(j+2,l) = c2 * (hbpc+sbpc) - s2 * (hbmc-sbmc)
    659. 

  659. <a name="l00559"></a>00559             c(j+5,l) = s2 * (hbpc+sbpc) + c2 * (hbmc-sbmc)
    660. 

  660. <a name="l00560"></a>00560          <span class="keyword">enddo</span>
    661. 

  661. <a name="l00561"></a>00561          ia = ia + 2
    662. 

  662. <a name="l00562"></a>00562          ib = ib + 2
    663. 

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

  664. <a name="l00564"></a>00564       <span class="keyword">enddo</span>
    665. 

  665. <a name="l00565"></a>00565 
    666. 

  666. <a name="l00566"></a>00566       c(n-2,:) = a(ia,:)
    667. 

  667. <a name="l00567"></a>00567       c(n-1,:) =   0.5 * a(ia,:) - SIN60 * a(ia+1,:)
    668. 

  668. <a name="l00568"></a>00568       c(n  ,:) = - 0.5 * a(ia,:) - SIN60 * a(ia+1,:)
    669. 

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

  670. <a name="l00570"></a>00570       a(:,:)  = c(:,:)
    671. 

  671. <a name="l00571"></a>00571       la = 3
    672. 

  672. <a name="l00572"></a>00572       return
    673. 

  673. <a name="l00573"></a>00573 <span class="keyword">      end subroutine ifft3</span>
    674. 

  674. <a name="l00574"></a>00574 
    675. 

  675. <a name="l00575"></a>00575 <span class="comment">!     ================</span>
    676. 

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

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

  678. <a name="l00578"></a>00578 
    679. 

  679. <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)
    680. 

  680. <a name="l00580"></a>00580       parameter(SQRT2 = 1.414213562373095D0)
    681. 

  681. <a name="l00581"></a>00581       dimension a(n*lot),c(n*lot)
    682. 

  682. <a name="l00582"></a>00582       la = n / 8
    683. 

  683. <a name="l00583"></a>00583 
    684. 

  684. <a name="l00584"></a>00584       <span class="keyword">do</span> i=0,la*lot-1
    685. 

  685. <a name="l00585"></a>00585          i0 = (i/la) * n + mod(i,la) + 1
    686. 

  686. <a name="l00586"></a>00586          i1 = i0 + la
    687. 

  687. <a name="l00587"></a>00587          i2 = i1 + la
    688. 

  688. <a name="l00588"></a>00588          i3 = i2 + la
    689. 

  689. <a name="l00589"></a>00589          i4 = i3 + la
    690. 

  690. <a name="l00590"></a>00590          i5 = i4 + la
    691. 

  691. <a name="l00591"></a>00591          i6 = i5 + la
    692. 

  692. <a name="l00592"></a>00592          i7 = i6 + la
    693. 

  693. <a name="l00593"></a>00593 
    694. 

  694. <a name="l00594"></a>00594          a0p7 = a(i0) + a(i7)
    695. 

  695. <a name="l00595"></a>00595          a0m7 = a(i0) - a(i7)
    696. 

  696. <a name="l00596"></a>00596          a1p5 = a(i1) + a(i5)
    697. 

  697. <a name="l00597"></a>00597          a1m5 = a(i1) - a(i5)
    698. 

  698. <a name="l00598"></a>00598          a2p6 = a(i2) + a(i6)
    699. 

  699. <a name="l00599"></a>00599          a2m6 = a(i2) - a(i6)
    700. 

  700. <a name="l00600"></a>00600 
    701. 

  701. <a name="l00601"></a>00601          a0p7p3   = a0p7 + a(i3)
    702. 

  702. <a name="l00602"></a>00602          a0p7m3   = a0p7 - a(i3)
    703. 

  703. <a name="l00603"></a>00603          a0m7p4   = 2.0 * (a0m7 + a(i4))
    704. 

  704. <a name="l00604"></a>00604          a0m7m4   = 2.0 * (a0m7 - a(i4))
    705. 

  705. <a name="l00605"></a>00605          a1m5p2p6 = SQRT2 * (a1m5 + a2p6)
    706. 

  706. <a name="l00606"></a>00606          a1m5m2p6 = SQRT2 * (a1m5 - a2p6)
    707. 

  707. <a name="l00607"></a>00607 
    708. 

  708. <a name="l00608"></a>00608          c(i0)  = 2.0 * (a0p7p3 + a1p5)
    709. 

  709. <a name="l00609"></a>00609          c(i2)  = 2.0 * (a0p7m3 - a2m6)
    710. 

  710. <a name="l00610"></a>00610          c(i4)  = 2.0 * (a0p7p3 - a1p5)
    711. 

  711. <a name="l00611"></a>00611          c(i6)  = 2.0 * (a0p7m3 + a2m6)
    712. 

  712. <a name="l00612"></a>00612 
    713. 

  713. <a name="l00613"></a>00613          c(i1)  = a0m7m4 + a1m5m2p6
    714. 

  714. <a name="l00614"></a>00614          c(i3)  = a0m7p4 - a1m5p2p6
    715. 

  715. <a name="l00615"></a>00615          c(i5)  = a0m7m4 - a1m5m2p6
    716. 

  716. <a name="l00616"></a>00616          c(i7)  = a0m7p4 + a1m5p2p6
    717. 

  717. <a name="l00617"></a>00617       <span class="keyword">enddo</span>
    718. 

  718. <a name="l00618"></a>00618       return
    719. 

  719. <a name="l00619"></a>00619 <span class="keyword">      end</span>
    720. 

  720. </pre></div></div>
    721. 

  721. </div>
    722. 

  722.   <div id="nav-path" class="navpath">
    723. 

  723.     <ul>
    724. 

  724.       <li class="navelem"><a class="el" href="fftmod_8f90.html">fftmod.f90</a>      </li>
    725. 

  725. <!-- window showing the filter options -->
    726. 

  726. <div id="MSearchSelectWindow"
    727. 

  727.      onmouseover="return searchBox.OnSearchSelectShow()"
    728. 

  728.      onmouseout="return searchBox.OnSearchSelectHide()"
    729. 

  729.      onkeydown="return searchBox.OnSearchSelectKey(event)">
    730. 

  730. <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>
    731. 

  731. 

  732. <!-- iframe showing the search results (closed by default) -->
    733. 

  733. <div id="MSearchResultsWindow">
    734. 

  734. <iframe src="javascript:void(0)" frameborder="0" 
    735. 

  735.         name="MSearchResults" id="MSearchResults">
    736. 

  736. </iframe>
    737. 

  737. </div>
    738. 

  738. 

  739. 

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

  741.     <a href="http://www.doxygen.org/index.html">
    742. 

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

  743.    </ul>
    744. 

  744.  </div>
    745. 

  745. 

  746. 

  747. </body>
    748. 

  748. </html>
    749.