TECLIM
/
PlaSim


			
							12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991
							<!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/fft991mod.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('fft991mod_8f90.html','');
</script>
<div id="doc-content">
<div class="header">
  <div class="headertitle">
<div class="title">/Users/home/WC/puma/src/fft991mod.f90</div>  </div>
</div>
<div class="contents">
<a href="fft991mod_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="comment">!     alternate module with factors 2, 3, 4, 5, 6, 8</span>
<a name="l00006"></a>00006 <span class="comment">!     this is a FORTRAN-90 version of the old FFT991 package</span>
<a name="l00007"></a>00007 <span class="comment">!     use this for resolutions not supported by the &lt;fftmod&gt;,</span>
<a name="l00008"></a>00008 <span class="comment">!     e.g. T63 (NLAT=96), T106 (NLAT=160)</span>
<a name="l00009"></a>00009 
<a name="l00010"></a><a class="code" href="classfftmod.html">00010</a>       <span class="keyword">module</span> <a class="code" href="classfftmod.html">fftmod</a>
<a name="l00011"></a>00011       parameter(NRES = 8)
<a name="l00012"></a><a class="code" href="classfftmod.html#a6d025a16cb8a864a12a875409fa6cc5b">00012</a>       <span class="keywordtype">integer</span> :: nallowed(NRES) = (/ 64, 96, 128, 192, 256, 320, 384, 512 /)
<a name="l00013"></a>00013 <span class="comment">!     T21  - N64  : 8-4-2</span>
<a name="l00014"></a>00014 <span class="comment">!     T31  - N96  : 8-4-3</span>
<a name="l00015"></a>00015 <span class="comment">!     T42  - N128 : 8-4-4</span>
<a name="l00016"></a>00016 <span class="comment">!     T63  - N192 : 8-6-4</span>
<a name="l00017"></a>00017 <span class="comment">!     T85  - N256 : 8-4-4-2</span>
<a name="l00018"></a>00018 <span class="comment">!     T106 - N320 : 8-5-4-2</span>
<a name="l00019"></a>00019 <span class="comment">!     T127 - N384 : 8-4-4-3</span>
<a name="l00020"></a>00020 <span class="comment">!     T170 - N512 : 8-4-4-4</span>
<a name="l00021"></a><a class="code" href="classfftmod.html#a23a4e596501c593aa5cccdd3009dd6e9">00021</a>       <span class="keywordtype">integer</span> :: lastn = 0
<a name="l00022"></a><a class="code" href="classfftmod.html#a1d920757f133f3f5fe62c647f0313e6a">00022</a>       <span class="keywordtype">integer</span> :: ifax(10)
<a name="l00023"></a><a class="code" href="classfftmod.html#ab67bfe78645c286a8d39d9b8fd10ce0a">00023</a>       <span class="keywordtype">real</span>,<span class="keywordtype">allocatable</span> :: trigs(:)
<a name="l00024"></a>00024 <span class="keyword">      end module fftmod</span>
<a name="l00025"></a>00025 
<a name="l00026"></a>00026 
<a name="l00027"></a>00027 <span class="comment">!     ================</span>
<a name="l00028"></a>00028 <span class="comment">!     SUBROUTINE GP2FC</span>
<a name="l00029"></a>00029 <span class="comment">!     ================</span>
<a name="l00030"></a>00030 
<a name="l00031"></a><a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">00031</a>       <span class="keyword">subroutine </span><a class="code" href="fft991mod_8f90.html#a8b611c69cc0d4f2c29a543e7903cb495">gp2fc</a>(a,n,lot)
<a name="l00032"></a>00032       use <span class="keywordflow">fftmod</span>
<a name="l00033"></a>00033       <span class="keywordtype">real</span> :: a(n,lot)
<a name="l00034"></a>00034       <span class="keywordtype">real</span> :: worka(n+2,lot)
<a name="l00035"></a>00035       <span class="keywordtype">real</span> :: workb(n+2,lot)
<a name="l00036"></a>00036 
<a name="l00037"></a>00037       <span class="keyword">if</span> (n /= lastn) <span class="keyword">then</span>
<a name="l00038"></a>00038          <span class="keyword">if</span> (<span class="keyword">allocated</span>(trigs)) <span class="keyword">deallocate</span>(trigs)
<a name="l00039"></a>00039          <span class="keyword">allocate</span>(trigs(n))
<a name="l00040"></a>00040          lastn = n
<a name="l00041"></a>00041          call <a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
<a name="l00042"></a>00042       <span class="keyword">endif</span>
<a name="l00043"></a>00043 
<a name="l00044"></a>00044       worka(1:n,:) = a(:,:)
<a name="l00045"></a>00045       worka(n+1:n+2,:) = 0.0
<a name="l00046"></a>00046 
<a name="l00047"></a>00047       call fft991(worka,workb,trigs,ifax,1,n+2,n,lot,-1)
<a name="l00048"></a>00048 
<a name="l00049"></a>00049       a(:,:) = worka(1:n,:)
<a name="l00050"></a>00050 
<a name="l00051"></a>00051       return
<a name="l00052"></a>00052 <span class="keyword">      end subroutine gp2fc</span>
<a name="l00053"></a>00053 
<a name="l00054"></a>00054 
<a name="l00055"></a>00055 <span class="comment">!     ================</span>
<a name="l00056"></a>00056 <span class="comment">!     SUBROUTINE FC2GP</span>
<a name="l00057"></a>00057 <span class="comment">!     ================</span>
<a name="l00058"></a>00058 
<a name="l00059"></a><a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">00059</a>       <span class="keyword">subroutine </span><a class="code" href="fft991mod_8f90.html#aa0cf4000171aaaf40d5e9850f73703db">fc2gp</a>(a,n,lot)
<a name="l00060"></a>00060       use <span class="keywordflow">fftmod</span>
<a name="l00061"></a>00061       <span class="keywordtype">real</span> :: a(n,lot)
<a name="l00062"></a>00062       <span class="keywordtype">real</span> :: worka(n+2,lot)
<a name="l00063"></a>00063       <span class="keywordtype">real</span> :: workb(n+2,lot)
<a name="l00064"></a>00064 
<a name="l00065"></a>00065       <span class="keyword">if</span> (n /= lastn) <span class="keyword">then</span>
<a name="l00066"></a>00066          <span class="keyword">if</span> (<span class="keyword">allocated</span>(trigs)) <span class="keyword">deallocate</span>(trigs)
<a name="l00067"></a>00067          <span class="keyword">allocate</span>(trigs(n))
<a name="l00068"></a>00068          lastn = n
<a name="l00069"></a>00069          call <a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
<a name="l00070"></a>00070       <span class="keyword">endif</span>
<a name="l00071"></a>00071 
<a name="l00072"></a>00072       worka(1:n,:) = a(:,:)
<a name="l00073"></a>00073       worka(n+1:n+2,:) = 0.0
<a name="l00074"></a>00074 
<a name="l00075"></a>00075       call fft991(worka,workb,trigs,ifax,1,n+2,n,lot,1)
<a name="l00076"></a>00076 
<a name="l00077"></a>00077       a(:,:) = worka(1:n,:)
<a name="l00078"></a>00078 
<a name="l00079"></a>00079 <span class="keyword">      end subroutine fc2gp</span>
<a name="l00080"></a>00080 
<a name="l00081"></a>00081 
<a name="l00082"></a>00082 <span class="comment">!     =================</span>
<a name="l00083"></a>00083 <span class="comment">!     SUBROUTINE FFTINI</span>
<a name="l00084"></a>00084 <span class="comment">!     =================</span>
<a name="l00085"></a>00085 
<a name="l00086"></a><a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">00086</a>       <span class="keyword">subroutine </span><a class="code" href="fft991mod_8f90.html#a8263c4f24b36fe62f88ab2fb4e1d2152">fftini</a>(n)
<a name="l00087"></a>00087       use <span class="keywordflow">fftmod</span>
<a name="l00088"></a>00088       <span class="keywordtype">logical</span> labort
<a name="l00089"></a>00089 
<a name="l00090"></a>00090 <span class="comment">!     check for allowed values of n</span>
<a name="l00091"></a>00091 
<a name="l00092"></a>00092       labort = .true.
<a name="l00093"></a>00093       <span class="keyword">do</span> j = 1 , NRES
<a name="l00094"></a>00094          <span class="keyword">if</span> (n == nallowed(j)) labort = .false.
<a name="l00095"></a>00095       <span class="keyword">enddo</span>
<a name="l00096"></a>00096 
<a name="l00097"></a>00097       <span class="keyword">if</span> (labort) <span class="keyword">then</span>
<a name="l00098"></a>00098          <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="l00099"></a>00099          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;Following resolutions may be used:&#39;</span>
<a name="l00100"></a>00100          <span class="keyword">write</span> (*,*) <span class="stringliteral">&#39;----------------------------------&#39;</span>
<a name="l00101"></a>00101          <span class="keyword">do</span> j = 1 , NRES
<a name="l00102"></a>00102             <span class="keyword">write</span> (*,1000) nallowed(j), nallowed(j)/2, nallowed(j)/3
<a name="l00103"></a>00103          <span class="keyword">enddo</span>
<a name="l00104"></a>00104          stop
<a name="l00105"></a>00105       <span class="keyword">endif</span>
<a name="l00106"></a>00106  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="l00107"></a>00107 
<a name="l00108"></a>00108       call set99(trigs,ifax,n) <span class="comment">! Factorization of n and sine/cosine values</span>
<a name="l00109"></a>00109 
<a name="l00110"></a>00110       return
<a name="l00111"></a>00111 <span class="keyword">      end subroutine fftini</span>
<a name="l00112"></a>00112 
<a name="l00113"></a>00113 
<a name="l00114"></a>00114 
<a name="l00115"></a>00115 
<a name="l00116"></a><a class="code" href="fft991mod_8f90.html#a4208e70973023c12c32e4cab13081adb">00116</a>       <span class="keyword">SUBROUTINE </span><a class="code" href="fft991mod_8f90.html#a4208e70973023c12c32e4cab13081adb">FFT991</a>(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
<a name="l00117"></a>00117 <span class="comment">!     SUBROUTINE FFT991 - MULTIPLE FAST REAL PERIODIC TRANSFORM</span>
<a name="l00118"></a>00118 <span class="comment">!     SUPERSEDES PREVIOUS ROUTINE &#39;FFT991&#39;</span>
<a name="l00119"></a>00119 <span class="comment">!</span>
<a name="l00120"></a>00120 <span class="comment">!     REAL TRANSFORM OF LENGTH N PERFORMED BY REMOVING REDUNDANT</span>
<a name="l00121"></a>00121 <span class="comment">!     OPERATIONS FROM COMPLEX TRANSFORM OF LENGTH N</span>
<a name="l00122"></a>00122 <span class="comment">!</span>
<a name="l00123"></a>00123 <span class="comment">!     A IS THE ARRAY CONTAINING INPUT &amp; OUTPUT DATA</span>
<a name="l00124"></a>00124 <span class="comment">!     WORK IS AN AREA OF SIZE (N+1)*MIN(LOT,64)</span>
<a name="l00125"></a>00125 <span class="comment">!     TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES</span>
<a name="l00126"></a>00126 <span class="comment">!     IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N</span>
<a name="l00127"></a>00127 <span class="comment">!     INC IS THE INCREMENT WITHIN EACH DATA &#39;VECTOR&#39;</span>
<a name="l00128"></a>00128 <span class="comment">!         (E.G. INC=1 FOR CONSECUTIVELY STORED DATA)</span>
<a name="l00129"></a>00129 <span class="comment">!     JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR</span>
<a name="l00130"></a>00130 <span class="comment">!     N IS THE LENGTH OF THE DATA VECTORS</span>
<a name="l00131"></a>00131 <span class="comment">!     LOT IS THE NUMBER OF DATA VECTORS</span>
<a name="l00132"></a>00132 <span class="comment">!     ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT</span>
<a name="l00133"></a>00133 <span class="comment">!           = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL</span>
<a name="l00134"></a>00134 <span class="comment">!</span>
<a name="l00135"></a>00135 <span class="comment">!     ORDERING OF COEFFICIENTS:</span>
<a name="l00136"></a>00136 <span class="comment">!         A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2)</span>
<a name="l00137"></a>00137 <span class="comment">!         WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED</span>
<a name="l00138"></a>00138 <span class="comment">!</span>
<a name="l00139"></a>00139 <span class="comment">!     ORDERING OF DATA:</span>
<a name="l00140"></a>00140 <span class="comment">!         X(0),X(1),X(2),...,X(N-1), 0 , 0 ; (N+2) LOCATIONS REQUIRED</span>
<a name="l00141"></a>00141 <span class="comment">!</span>
<a name="l00142"></a>00142 <span class="comment">!     VECTORIZATION IS ACHIEVED ON CRAY BY DOING THE TRANSFORMS</span>
<a name="l00143"></a>00143 <span class="comment">!     IN PARALLEL</span>
<a name="l00144"></a>00144 <span class="comment">!</span>
<a name="l00145"></a>00145 <span class="comment">!     N MUST BE COMPOSED OF FACTORS 2,3 &amp; 5 BUT DOES NOT HAVE TO BE EVEN</span>
<a name="l00146"></a>00146 <span class="comment">!</span>
<a name="l00147"></a>00147 <span class="comment">!     DEFINITION OF TRANSFORMS:</span>
<a name="l00148"></a>00148 <span class="comment">!     -------------------------</span>
<a name="l00149"></a>00149 <span class="comment">!</span>
<a name="l00150"></a>00150 <span class="comment">!     ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N))</span>
<a name="l00151"></a>00151 <span class="comment">!         WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K)</span>
<a name="l00152"></a>00152 <span class="comment">!</span>
<a name="l00153"></a>00153 <span class="comment">!     ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N))</span>
<a name="l00154"></a>00154 <span class="comment">!               B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N))</span>
<a name="l00155"></a>00155 <span class="comment">!</span>
<a name="l00156"></a>00156       DIMENSION A(*),WORK(*),TRIGS(N),IFAX(10)
<a name="l00157"></a>00157 <span class="comment">!</span>
<a name="l00158"></a>00158       NFAX=IFAX(1)
<a name="l00159"></a>00159       NX=N+1
<a name="l00160"></a>00160       <span class="keyword">IF</span> (MOD(N,2).EQ.1) NX=N
<a name="l00161"></a>00161       NBLOX=1+(LOT-1)/64
<a name="l00162"></a>00162       NVEX=LOT-(NBLOX-1)*64
<a name="l00163"></a>00163       <span class="keyword">IF</span> (ISIGN.EQ.-1) GO TO 300
<a name="l00164"></a>00164 <span class="comment">!</span>
<a name="l00165"></a>00165 <span class="comment">!     ISIGN=+1, SPECTRAL TO GRIDPOINT TRANSFORM</span>
<a name="l00166"></a>00166 <span class="comment">!     -----------------------------------------</span>
<a name="l00167"></a>00167 100   CONTINUE
<a name="l00168"></a>00168       ISTART=1
<a name="l00169"></a>00169       <span class="keyword">DO</span> 220 NB=1,NBLOX
<a name="l00170"></a>00170         IA=ISTART
<a name="l00171"></a>00171         I=ISTART
<a name="l00172"></a>00172         <span class="keyword">DO</span> 110 J=1,NVEX
<a name="l00173"></a>00173           A(I+INC)=0.5*A(I)
<a name="l00174"></a>00174           I=I+JUMP
<a name="l00175"></a>00175 110       CONTINUE
<a name="l00176"></a>00176         <span class="keyword">IF</span> (MOD(N,2).EQ.1) GO TO 130
<a name="l00177"></a>00177         I=ISTART+N*INC
<a name="l00178"></a>00178         <span class="keyword">DO</span> 120 J=1,NVEX
<a name="l00179"></a>00179           A(I)=0.5*A(I)
<a name="l00180"></a>00180           I=I+JUMP
<a name="l00181"></a>00181 120       CONTINUE
<a name="l00182"></a>00182 130     CONTINUE
<a name="l00183"></a>00183         IA=ISTART+INC
<a name="l00184"></a>00184         LA=1
<a name="l00185"></a>00185         IGO=+1
<a name="l00186"></a>00186 <span class="comment">!</span>
<a name="l00187"></a>00187         <span class="keyword">DO</span> 160 K=1,NFAX
<a name="l00188"></a>00188           IFAC=IFAX(K+1)
<a name="l00189"></a>00189           IERR=-1
<a name="l00190"></a>00190           <span class="keyword">IF</span> (IGO.EQ.-1) GO TO 140
<a name="l00191"></a>00191           CALL <a class="code" href="fft991mod_8f90.html#adcdb3d2377fcf2988ef3f1d4a0fdf9af">RPASSM</a>(A(IA),A(IA+LA*INC),WORK(1),WORK(IFAC*LA+1),TRIGS, &amp;
<a name="l00192"></a>00192                    INC,1,JUMP,NX,NVEX,N,IFAC,LA,IERR)
<a name="l00193"></a>00193           GO TO 150
<a name="l00194"></a>00194 140       CONTINUE
<a name="l00195"></a>00195           CALL <a class="code" href="fft991mod_8f90.html#adcdb3d2377fcf2988ef3f1d4a0fdf9af">RPASSM</a>(WORK(1),WORK(LA+1),A(IA),A(IA+IFAC*LA*INC),TRIGS, &amp;
<a name="l00196"></a>00196                    1,INC,NX,JUMP,NVEX,N,IFAC,LA,IERR)
<a name="l00197"></a>00197 150       CONTINUE
<a name="l00198"></a>00198           <span class="keyword">IF</span> (IERR.NE.0) GO TO 500
<a name="l00199"></a>00199           LA=IFAC*LA
<a name="l00200"></a>00200           IGO=-IGO
<a name="l00201"></a>00201           IA=ISTART
<a name="l00202"></a>00202 160       CONTINUE
<a name="l00203"></a>00203 <span class="comment">!</span>
<a name="l00204"></a>00204 <span class="comment">!     IF NECESSARY, COPY RESULTS BACK TO A</span>
<a name="l00205"></a>00205 <span class="comment">!     ------------------------------------</span>
<a name="l00206"></a>00206         <span class="keyword">IF</span> (MOD(NFAX,2).EQ.0) GO TO 190
<a name="l00207"></a>00207         IBASE=1
<a name="l00208"></a>00208         JBASE=IA
<a name="l00209"></a>00209         <span class="keyword">DO</span> 180 JJ=1,NVEX
<a name="l00210"></a>00210           I=IBASE
<a name="l00211"></a>00211           J=JBASE
<a name="l00212"></a>00212           <span class="keyword">DO</span> 170 II=1,N
<a name="l00213"></a>00213             A(J)=WORK(I)
<a name="l00214"></a>00214             I=I+1
<a name="l00215"></a>00215             J=J+INC
<a name="l00216"></a>00216 170         CONTINUE
<a name="l00217"></a>00217           IBASE=IBASE+NX
<a name="l00218"></a>00218           JBASE=JBASE+JUMP
<a name="l00219"></a>00219 180       CONTINUE
<a name="l00220"></a>00220 190     CONTINUE
<a name="l00221"></a>00221 <span class="comment">!</span>
<a name="l00222"></a>00222 <span class="comment">!     FILL IN ZEROS AT END</span>
<a name="l00223"></a>00223 <span class="comment">!     --------------------</span>
<a name="l00224"></a>00224         IX=ISTART+N*INC
<a name="l00225"></a>00225         <span class="keyword">DO</span> 210 J=1,NVEX
<a name="l00226"></a>00226           A(IX)=0.0
<a name="l00227"></a>00227           A(IX+INC)=0.0
<a name="l00228"></a>00228           IX=IX+JUMP
<a name="l00229"></a>00229 210       CONTINUE
<a name="l00230"></a>00230 <span class="comment">!</span>
<a name="l00231"></a>00231         ISTART=ISTART+NVEX*JUMP
<a name="l00232"></a>00232         NVEX=64
<a name="l00233"></a>00233 220     CONTINUE
<a name="l00234"></a>00234       RETURN
<a name="l00235"></a>00235 <span class="comment">!</span>
<a name="l00236"></a>00236 <span class="comment">!     ISIGN=-1, GRIDPOINT TO SPECTRAL TRANSFORM</span>
<a name="l00237"></a>00237 <span class="comment">!     -----------------------------------------</span>
<a name="l00238"></a>00238 300   CONTINUE
<a name="l00239"></a>00239       ISTART=1
<a name="l00240"></a>00240       <span class="keyword">DO</span> 410 NB=1,NBLOX
<a name="l00241"></a>00241         IA=ISTART
<a name="l00242"></a>00242         LA=N
<a name="l00243"></a>00243         IGO=+1
<a name="l00244"></a>00244 <span class="comment">!</span>
<a name="l00245"></a>00245         <span class="keyword">DO</span> 340 K=1,NFAX
<a name="l00246"></a>00246           IFAC=IFAX(NFAX+2-K)
<a name="l00247"></a>00247           LA=LA/IFAC
<a name="l00248"></a>00248           IERR=-1
<a name="l00249"></a>00249           <span class="keyword">IF</span> (IGO.EQ.-1) GO TO 320
<a name="l00250"></a>00250           CALL <a class="code" href="fft991mod_8f90.html#ad40a2639ba9849be91225a116cadd87f">QPASSM</a>(A(IA),A(IA+IFAC*LA*INC),WORK(1),WORK(LA+1),TRIGS, &amp;
<a name="l00251"></a>00251                    INC,1,JUMP,NX,NVEX,N,IFAC,LA,IERR)
<a name="l00252"></a>00252           GO TO 330
<a name="l00253"></a>00253 320       CONTINUE
<a name="l00254"></a>00254           CALL <a class="code" href="fft991mod_8f90.html#ad40a2639ba9849be91225a116cadd87f">QPASSM</a>(WORK(1),WORK(IFAC*LA+1),A(IA),A(IA+LA*INC),TRIGS, &amp;
<a name="l00255"></a>00255                    1,INC,NX,JUMP,NVEX,N,IFAC,LA,IERR)
<a name="l00256"></a>00256 330       CONTINUE
<a name="l00257"></a>00257           <span class="keyword">IF</span> (IERR.NE.0) GO TO 500
<a name="l00258"></a>00258           IGO=-IGO
<a name="l00259"></a>00259           IA=ISTART+INC
<a name="l00260"></a>00260 340       CONTINUE
<a name="l00261"></a>00261 <span class="comment">!</span>
<a name="l00262"></a>00262 <span class="comment">!     IF NECESSARY, COPY RESULTS BACK TO A</span>
<a name="l00263"></a>00263 <span class="comment">!     ------------------------------------</span>
<a name="l00264"></a>00264         <span class="keyword">IF</span> (MOD(NFAX,2).EQ.0) GO TO 370
<a name="l00265"></a>00265         IBASE=1
<a name="l00266"></a>00266         JBASE=IA
<a name="l00267"></a>00267         <span class="keyword">DO</span> 360 JJ=1,NVEX
<a name="l00268"></a>00268           I=IBASE
<a name="l00269"></a>00269           J=JBASE
<a name="l00270"></a>00270           <span class="keyword">DO</span> 350 II=1,N
<a name="l00271"></a>00271             A(J)=WORK(I)
<a name="l00272"></a>00272             I=I+1
<a name="l00273"></a>00273             J=J+INC
<a name="l00274"></a>00274 350         CONTINUE
<a name="l00275"></a>00275           IBASE=IBASE+NX
<a name="l00276"></a>00276           JBASE=JBASE+JUMP
<a name="l00277"></a>00277 360       CONTINUE
<a name="l00278"></a>00278 370     CONTINUE
<a name="l00279"></a>00279 <span class="comment">!</span>
<a name="l00280"></a>00280 <span class="comment">!     SHIFT A(0) &amp; FILL IN ZERO IMAG PARTS</span>
<a name="l00281"></a>00281 <span class="comment">!     ------------------------------------</span>
<a name="l00282"></a>00282         IX=ISTART
<a name="l00283"></a>00283         <span class="keyword">DO</span> 380 J=1,NVEX
<a name="l00284"></a>00284           A(IX)=A(IX+INC)
<a name="l00285"></a>00285           A(IX+INC)=0.0
<a name="l00286"></a>00286           IX=IX+JUMP
<a name="l00287"></a>00287 380       CONTINUE
<a name="l00288"></a>00288         <span class="keyword">IF</span> (MOD(N,2).EQ.1) GO TO 400
<a name="l00289"></a>00289         IZ=ISTART+(N+1)*INC
<a name="l00290"></a>00290         <span class="keyword">DO</span> 390 J=1,NVEX
<a name="l00291"></a>00291           A(IZ)=0.0
<a name="l00292"></a>00292           IZ=IZ+JUMP
<a name="l00293"></a>00293 390       CONTINUE
<a name="l00294"></a>00294 400     CONTINUE
<a name="l00295"></a>00295 <span class="comment">!</span>
<a name="l00296"></a>00296         ISTART=ISTART+NVEX*JUMP
<a name="l00297"></a>00297         NVEX=64
<a name="l00298"></a>00298 410     CONTINUE
<a name="l00299"></a>00299       RETURN
<a name="l00300"></a>00300 <span class="comment">!</span>
<a name="l00301"></a>00301 <span class="comment">!     ERROR MESSAGES</span>
<a name="l00302"></a>00302 <span class="comment">!     --------------</span>
<a name="l00303"></a>00303 500   CONTINUE
<a name="l00304"></a>00304       GO TO (510,530,550) IERR
<a name="l00305"></a>00305 510   CONTINUE
<a name="l00306"></a>00306       <span class="keyword">WRITE</span>(6,520) NVEX
<a name="l00307"></a>00307 520   FORMAT(16H1VECTOR LENGTH =,I4,17H, GREATER THAN 64)
<a name="l00308"></a>00308       GO TO 570
<a name="l00309"></a>00309 530   CONTINUE
<a name="l00310"></a>00310       <span class="keyword">WRITE</span>(6,540) IFAC
<a name="l00311"></a>00311 540   FORMAT( 9H1FACTOR =,I3,17H, NOT CATERED FOR)
<a name="l00312"></a>00312       GO TO 570
<a name="l00313"></a>00313 550   CONTINUE
<a name="l00314"></a>00314       <span class="keyword">WRITE</span>(6,560) IFAC
<a name="l00315"></a>00315 560   FORMAT(9H1FACTOR =,I3,31H, ONLY CATERED FOR <span class="keyword">IF</span> LA*IFAC=N)
<a name="l00316"></a>00316 570   CONTINUE
<a name="l00317"></a>00317       RETURN
<a name="l00318"></a>00318 <span class="keyword">      END</span>
<a name="l00319"></a>00319 
<a name="l00320"></a>00320 
<a name="l00321"></a>00321 
<a name="l00322"></a><a class="code" href="fft991mod_8f90.html#a3a660d3701dad24e4e8e75bd2be89515">00322</a>       <span class="keyword">SUBROUTINE </span><a class="code" href="fft991mod_8f90.html#a3a660d3701dad24e4e8e75bd2be89515">SET99</a>(TRIGS,IFAX,N)
<a name="l00323"></a>00323 <span class="comment">!     SUBROUTINE SET99 - COMPUTES FACTORS OF N &amp; TRIGONOMETRIC</span>
<a name="l00324"></a>00324 <span class="comment">!     FUNCTINS REQUIRED BY FFT99 &amp; FFT991</span>
<a name="l00325"></a>00325 <span class="comment">!</span>
<a name="l00326"></a>00326       DIMENSION TRIGS(N),IFAX(10),JFAX(10),LFAX(7)
<a name="l00327"></a>00327       <span class="keyword">DATA</span> LFAX/6,8,5,4,3,2,1/
<a name="l00328"></a>00328       IXXX=1
<a name="l00329"></a>00329 <span class="comment">!</span>
<a name="l00330"></a>00330       DEL=4.0*ASIN(1.0)/FLOAT(N)
<a name="l00331"></a>00331       NIL=0
<a name="l00332"></a>00332       NHL=(N/2)-1
<a name="l00333"></a>00333       <span class="keyword">DO</span> 10 K=NIL,NHL
<a name="l00334"></a>00334         ANGLE=FLOAT(K)*DEL
<a name="l00335"></a>00335         TRIGS(2*K+1)=COS(ANGLE)
<a name="l00336"></a>00336         TRIGS(2*K+2)=SIN(ANGLE)
<a name="l00337"></a>00337 10      CONTINUE
<a name="l00338"></a>00338 <span class="comment">!</span>
<a name="l00339"></a>00339 <span class="comment">!     FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED)</span>
<a name="l00340"></a>00340 <span class="comment">!     LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER</span>
<a name="l00341"></a>00341       NU=N
<a name="l00342"></a>00342       IFAC=6
<a name="l00343"></a>00343       K=0
<a name="l00344"></a>00344       L=1
<a name="l00345"></a>00345 20    CONTINUE
<a name="l00346"></a>00346       <span class="keyword">IF</span> (MOD(NU,IFAC).NE.0) GO TO 30
<a name="l00347"></a>00347       K=K+1
<a name="l00348"></a>00348       JFAX(K)=IFAC
<a name="l00349"></a>00349       <span class="keyword">IF</span> (IFAC.NE.8) GO TO 25
<a name="l00350"></a>00350       <span class="keyword">IF</span> (K.EQ.1) GO TO 25
<a name="l00351"></a>00351       JFAX(1)=8
<a name="l00352"></a>00352       JFAX(K)=6
<a name="l00353"></a>00353 25    CONTINUE
<a name="l00354"></a>00354       NU=NU/IFAC
<a name="l00355"></a>00355       <span class="keyword">IF</span> (NU.EQ.1) GO TO 50
<a name="l00356"></a>00356       <span class="keyword">IF</span> (IFAC.NE.8) GO TO 20
<a name="l00357"></a>00357 30    CONTINUE
<a name="l00358"></a>00358       L=L+1
<a name="l00359"></a>00359       IFAC=LFAX(L)
<a name="l00360"></a>00360       <span class="keyword">IF</span> (IFAC.GT.1) GO TO 20
<a name="l00361"></a>00361 <span class="comment">!</span>
<a name="l00362"></a>00362       <span class="keyword">WRITE</span>(6,40) N
<a name="l00363"></a>00363 40    FORMAT(4H1N =,I4,27H - <span class="keyword">CONTAINS</span> ILLEGAL FACTORS)
<a name="l00364"></a>00364       RETURN
<a name="l00365"></a>00365 <span class="comment">!</span>
<a name="l00366"></a>00366 <span class="comment">!     NOW REVERSE ORDER OF FACTORS</span>
<a name="l00367"></a>00367 50    CONTINUE
<a name="l00368"></a>00368       NFAX=K
<a name="l00369"></a>00369       IFAX(1)=NFAX
<a name="l00370"></a>00370       <span class="keyword">DO</span> 60 I=1,NFAX
<a name="l00371"></a>00371         IFAX(NFAX+2-I)=JFAX(I)
<a name="l00372"></a>00372 60      CONTINUE
<a name="l00373"></a>00373       IFAX(10)=N
<a name="l00374"></a>00374       RETURN
<a name="l00375"></a>00375 <span class="keyword">      END</span>
<a name="l00376"></a>00376 
<a name="l00377"></a>00377 
<a name="l00378"></a>00378 
<a name="l00379"></a>00379 
<a name="l00380"></a><a class="code" href="fft991mod_8f90.html#ad40a2639ba9849be91225a116cadd87f">00380</a>       <span class="keyword">SUBROUTINE </span><a class="code" href="fft991mod_8f90.html#ad40a2639ba9849be91225a116cadd87f">QPASSM</a>(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA,IERR)
<a name="l00381"></a>00381 <span class="comment">!     SUBROUTINE QPASSM - PERFORMS ONE PASS THROUGH DATA AS PART</span>
<a name="l00382"></a>00382 <span class="comment">!     OF MULTIPLE REAL FFT (FOURIER ANALYSIS) ROUTINE</span>
<a name="l00383"></a>00383 <span class="comment">!</span>
<a name="l00384"></a>00384 <span class="comment">!     A IS FIRST REAL INPUT VECTOR</span>
<a name="l00385"></a>00385 <span class="comment">!         EQUIVALENCE B(1) WITH A(IFAC*LA*INC1+1)</span>
<a name="l00386"></a>00386 <span class="comment">!     C IS FIRST REAL OUTPUT VECTOR</span>
<a name="l00387"></a>00387 <span class="comment">!         EQUIVALENCE D(1) WITH C(LA*INC2+1)</span>
<a name="l00388"></a>00388 <span class="comment">!     TRIGS IS A PRECALCULATED LIST OF SINES &amp; COSINES</span>
<a name="l00389"></a>00389 <span class="comment">!     INC1 IS THE ADDRESSING INCREMENT FOR A</span>
<a name="l00390"></a>00390 <span class="comment">!     INC2 IS THE ADDRESSING INCREMENT FOR C</span>
<a name="l00391"></a>00391 <span class="comment">!     INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A</span>
<a name="l00392"></a>00392 <span class="comment">!     INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C</span>
<a name="l00393"></a>00393 <span class="comment">!     LOT IS THE NUMBER OF VECTORS</span>
<a name="l00394"></a>00394 <span class="comment">!     N IS THE LENGTH OF THE VECTORS</span>
<a name="l00395"></a>00395 <span class="comment">!     IFAC IS THE CURRENT FACTOR OF N</span>
<a name="l00396"></a>00396 <span class="comment">!     LA = N/(PRODUCT OF FACTORS USED SO FAR)</span>
<a name="l00397"></a>00397 <span class="comment">!     IERR IS AN ERROR INDICATOR:</span>
<a name="l00398"></a>00398 <span class="comment">!              0 - PASS COMPLETED WITHOUT ERROR</span>
<a name="l00399"></a>00399 <span class="comment">!              1 - LOT GREATER THAN 64</span>
<a name="l00400"></a>00400 <span class="comment">!              2 - IFAC NOT CATERED FOR</span>
<a name="l00401"></a>00401 <span class="comment">!              3 - IFAC ONLY CATERED FOR IF LA=N/IFAC</span>
<a name="l00402"></a>00402 <span class="comment">!</span>
<a name="l00403"></a>00403 <span class="comment">!-----------------------------------------------------------------------</span>
<a name="l00404"></a>00404 <span class="comment">!</span>
<a name="l00405"></a>00405       DIMENSION A(*),B(*),C(*),D(*),TRIGS(N)
<a name="l00406"></a>00406 <span class="comment">!</span>
<a name="l00407"></a>00407       parameter(SIN36 = 0.587785252292473)
<a name="l00408"></a>00408       parameter(SIN72 = 0.951056516295154)
<a name="l00409"></a>00409       parameter(QRT5  = 0.559016994374947)
<a name="l00410"></a>00410       parameter(SIN60 = 0.866025403784437)
<a name="l00411"></a>00411 <span class="comment">!</span>
<a name="l00412"></a>00412       M=N/IFAC
<a name="l00413"></a>00413       IINK=LA*INC1
<a name="l00414"></a>00414       JINK=LA*INC2
<a name="l00415"></a>00415       IJUMP=(IFAC-1)*IINK
<a name="l00416"></a>00416       KSTOP=(N-IFAC)/(2*IFAC)
<a name="l00417"></a>00417 <span class="comment">!</span>
<a name="l00418"></a>00418       IBAD=1
<a name="l00419"></a>00419       <span class="keyword">IF</span> (LOT.GT.64) GO TO 910
<a name="l00420"></a>00420       IBASE=0
<a name="l00421"></a>00421       JBASE=0
<a name="l00422"></a>00422       IGO=IFAC-1
<a name="l00423"></a>00423       <span class="keyword">IF</span> (IGO.EQ.7) IGO=6
<a name="l00424"></a>00424       IBAD=2
<a name="l00425"></a>00425       <span class="keyword">IF</span> (IGO.LT.1.OR.IGO.GT.6) GO TO 910
<a name="l00426"></a>00426       GO TO (200,300,400,500,600,800),IGO
<a name="l00427"></a>00427 <span class="comment">!</span>
<a name="l00428"></a>00428 <span class="comment">!     CODING FOR FACTOR 2</span>
<a name="l00429"></a>00429 <span class="comment">!     -------------------</span>
<a name="l00430"></a>00430 200   CONTINUE
<a name="l00431"></a>00431       IA=1
<a name="l00432"></a>00432       IB=IA+IINK
<a name="l00433"></a>00433       JA=1
<a name="l00434"></a>00434       JB=JA+(2*M-LA)*INC2
<a name="l00435"></a>00435 <span class="comment">!</span>
<a name="l00436"></a>00436       <span class="keyword">IF</span> (LA.EQ.M) GO TO 290
<a name="l00437"></a>00437 <span class="comment">!</span>
<a name="l00438"></a>00438       <span class="keyword">DO</span> 220 L=1,LA
<a name="l00439"></a>00439         I=IBASE
<a name="l00440"></a>00440         J=JBASE
<a name="l00441"></a>00441 <span class="comment">!DIR$ IVDEP</span>
<a name="l00442"></a>00442         <span class="keyword">DO</span> 210 IJK=1,LOT
<a name="l00443"></a>00443           C(JA+J)=A(IA+I)+A(IB+I)
<a name="l00444"></a>00444           C(JB+J)=A(IA+I)-A(IB+I)
<a name="l00445"></a>00445           I=I+INC3
<a name="l00446"></a>00446           J=J+INC4
<a name="l00447"></a>00447 210       CONTINUE
<a name="l00448"></a>00448         IBASE=IBASE+INC1
<a name="l00449"></a>00449         JBASE=JBASE+INC2
<a name="l00450"></a>00450 220     CONTINUE
<a name="l00451"></a>00451       JA=JA+JINK
<a name="l00452"></a>00452       JINK=2*JINK
<a name="l00453"></a>00453       JB=JB-JINK
<a name="l00454"></a>00454       IBASE=IBASE+IJUMP
<a name="l00455"></a>00455       IJUMP=2*IJUMP+IINK
<a name="l00456"></a>00456       <span class="keyword">IF</span> (JA.EQ.JB) GO TO 260
<a name="l00457"></a>00457       <span class="keyword">DO</span> 250 K=LA,KSTOP,LA
<a name="l00458"></a>00458         KB=K+K
<a name="l00459"></a>00459         C1=TRIGS(KB+1)
<a name="l00460"></a>00460         S1=TRIGS(KB+2)
<a name="l00461"></a>00461         JBASE=0
<a name="l00462"></a>00462         <span class="keyword">DO</span> 240 L=1,LA
<a name="l00463"></a>00463           I=IBASE
<a name="l00464"></a>00464           J=JBASE
<a name="l00465"></a>00465 <span class="comment">!DIR$ IVDEP</span>
<a name="l00466"></a>00466           <span class="keyword">DO</span> 230 IJK=1,LOT
<a name="l00467"></a>00467             C(JA+J)=A(IA+I)+(C1*A(IB+I)+S1*B(IB+I))
<a name="l00468"></a>00468             C(JB+J)=A(IA+I)-(C1*A(IB+I)+S1*B(IB+I))
<a name="l00469"></a>00469             D(JA+J)=(C1*B(IB+I)-S1*A(IB+I))+B(IA+I)
<a name="l00470"></a>00470             D(JB+J)=(C1*B(IB+I)-S1*A(IB+I))-B(IA+I)
<a name="l00471"></a>00471             I=I+INC3
<a name="l00472"></a>00472             J=J+INC4
<a name="l00473"></a>00473 230         CONTINUE
<a name="l00474"></a>00474           IBASE=IBASE+INC1
<a name="l00475"></a>00475           JBASE=JBASE+INC2
<a name="l00476"></a>00476 240       CONTINUE
<a name="l00477"></a>00477         IBASE=IBASE+IJUMP
<a name="l00478"></a>00478         JA=JA+JINK
<a name="l00479"></a>00479         JB=JB-JINK
<a name="l00480"></a>00480 250     CONTINUE
<a name="l00481"></a>00481       <span class="keyword">IF</span> (JA.GT.JB) GO TO 900
<a name="l00482"></a>00482 260   CONTINUE
<a name="l00483"></a>00483       JBASE=0
<a name="l00484"></a>00484       <span class="keyword">DO</span> 280 L=1,LA
<a name="l00485"></a>00485         I=IBASE
<a name="l00486"></a>00486         J=JBASE
<a name="l00487"></a>00487 <span class="comment">!DIR$ IVDEP</span>
<a name="l00488"></a>00488         <span class="keyword">DO</span> 270 IJK=1,LOT
<a name="l00489"></a>00489           C(JA+J)=A(IA+I)
<a name="l00490"></a>00490           D(JA+J)=-A(IB+I)
<a name="l00491"></a>00491           I=I+INC3
<a name="l00492"></a>00492           J=J+INC4
<a name="l00493"></a>00493 270       CONTINUE
<a name="l00494"></a>00494         IBASE=IBASE+INC1
<a name="l00495"></a>00495         JBASE=JBASE+INC2
<a name="l00496"></a>00496 280     CONTINUE
<a name="l00497"></a>00497       GO TO 900
<a name="l00498"></a>00498 <span class="comment">!</span>
<a name="l00499"></a>00499 290   CONTINUE
<a name="l00500"></a>00500       Z=1.0/FLOAT(N)
<a name="l00501"></a>00501       <span class="keyword">DO</span> 294 L=1,LA
<a name="l00502"></a>00502         I=IBASE
<a name="l00503"></a>00503         J=JBASE
<a name="l00504"></a>00504 <span class="comment">!DIR$ IVDEP</span>
<a name="l00505"></a>00505         <span class="keyword">DO</span> 292 IJK=1,LOT
<a name="l00506"></a>00506           C(JA+J)=Z*(A(IA+I)+A(IB+I))
<a name="l00507"></a>00507           C(JB+J)=Z*(A(IA+I)-A(IB+I))
<a name="l00508"></a>00508           I=I+INC3
<a name="l00509"></a>00509           J=J+INC4
<a name="l00510"></a>00510 292       CONTINUE
<a name="l00511"></a>00511         IBASE=IBASE+INC1
<a name="l00512"></a>00512         JBASE=JBASE+INC2
<a name="l00513"></a>00513 294     CONTINUE
<a name="l00514"></a>00514       GO TO 900
<a name="l00515"></a>00515 <span class="comment">!</span>
<a name="l00516"></a>00516 <span class="comment">!     CODING FOR FACTOR 3</span>
<a name="l00517"></a>00517 <span class="comment">!     -------------------</span>
<a name="l00518"></a>00518 300   CONTINUE
<a name="l00519"></a>00519       IA=1
<a name="l00520"></a>00520       IB=IA+IINK
<a name="l00521"></a>00521       IC=IB+IINK
<a name="l00522"></a>00522       JA=1
<a name="l00523"></a>00523       JB=JA+(2*M-LA)*INC2
<a name="l00524"></a>00524       JC=JB
<a name="l00525"></a>00525 <span class="comment">!</span>
<a name="l00526"></a>00526       <span class="keyword">IF</span> (LA.EQ.M) GO TO 390
<a name="l00527"></a>00527 <span class="comment">!</span>
<a name="l00528"></a>00528       <span class="keyword">DO</span> 320 L=1,LA
<a name="l00529"></a>00529         I=IBASE
<a name="l00530"></a>00530         J=JBASE
<a name="l00531"></a>00531 <span class="comment">!DIR$ IVDEP</span>
<a name="l00532"></a>00532         <span class="keyword">DO</span> 310 IJK=1,LOT
<a name="l00533"></a>00533           C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I))
<a name="l00534"></a>00534           C(JB+J)=A(IA+I)-0.5*(A(IB+I)+A(IC+I))
<a name="l00535"></a>00535           D(JB+J)=SIN60*(A(IC+I)-A(IB+I))
<a name="l00536"></a>00536           I=I+INC3
<a name="l00537"></a>00537           J=J+INC4
<a name="l00538"></a>00538 310       CONTINUE
<a name="l00539"></a>00539         IBASE=IBASE+INC1
<a name="l00540"></a>00540         JBASE=JBASE+INC2
<a name="l00541"></a>00541 320     CONTINUE
<a name="l00542"></a>00542       JA=JA+JINK
<a name="l00543"></a>00543       JINK=2*JINK
<a name="l00544"></a>00544       JB=JB+JINK
<a name="l00545"></a>00545       JC=JC-JINK
<a name="l00546"></a>00546       IBASE=IBASE+IJUMP
<a name="l00547"></a>00547       IJUMP=2*IJUMP+IINK
<a name="l00548"></a>00548       <span class="keyword">IF</span> (JA.EQ.JC) GO TO 360
<a name="l00549"></a>00549       <span class="keyword">DO</span> 350 K=LA,KSTOP,LA
<a name="l00550"></a>00550         KB=K+K
<a name="l00551"></a>00551         KC=KB+KB
<a name="l00552"></a>00552         C1=TRIGS(KB+1)
<a name="l00553"></a>00553         S1=TRIGS(KB+2)
<a name="l00554"></a>00554         C2=TRIGS(KC+1)
<a name="l00555"></a>00555         S2=TRIGS(KC+2)
<a name="l00556"></a>00556         JBASE=0
<a name="l00557"></a>00557         <span class="keyword">DO</span> 340 L=1,LA
<a name="l00558"></a>00558           I=IBASE
<a name="l00559"></a>00559           J=JBASE
<a name="l00560"></a>00560 <span class="comment">!DIR$ IVDEP</span>
<a name="l00561"></a>00561           <span class="keyword">DO</span> 330 IJK=1,LOT
<a name="l00562"></a>00562             A1=(C1*A(IB+I)+S1*B(IB+I))+(C2*A(IC+I)+S2*B(IC+I))
<a name="l00563"></a>00563             B1=(C1*B(IB+I)-S1*A(IB+I))+(C2*B(IC+I)-S2*A(IC+I))
<a name="l00564"></a>00564             A2=A(IA+I)-0.5*A1
<a name="l00565"></a>00565             B2=B(IA+I)-0.5*B1
<a name="l00566"></a>00566             A3=SIN60*((C1*A(IB+I)+S1*B(IB+I))-(C2*A(IC+I)+S2*B(IC+I)))
<a name="l00567"></a>00567             B3=SIN60*((C1*B(IB+I)-S1*A(IB+I))-(C2*B(IC+I)-S2*A(IC+I)))
<a name="l00568"></a>00568             C(JA+J)=A(IA+I)+A1
<a name="l00569"></a>00569             D(JA+J)=B(IA+I)+B1
<a name="l00570"></a>00570             C(JB+J)=A2+B3
<a name="l00571"></a>00571             D(JB+J)=B2-A3
<a name="l00572"></a>00572             C(JC+J)=A2-B3
<a name="l00573"></a>00573             D(JC+J)=-(B2+A3)
<a name="l00574"></a>00574             I=I+INC3
<a name="l00575"></a>00575             J=J+INC4
<a name="l00576"></a>00576 330         CONTINUE
<a name="l00577"></a>00577           IBASE=IBASE+INC1
<a name="l00578"></a>00578           JBASE=JBASE+INC2
<a name="l00579"></a>00579 340       CONTINUE
<a name="l00580"></a>00580         IBASE=IBASE+IJUMP
<a name="l00581"></a>00581         JA=JA+JINK
<a name="l00582"></a>00582         JB=JB+JINK
<a name="l00583"></a>00583         JC=JC-JINK
<a name="l00584"></a>00584 350     CONTINUE
<a name="l00585"></a>00585       <span class="keyword">IF</span> (JA.GT.JC) GO TO 900
<a name="l00586"></a>00586 360   CONTINUE
<a name="l00587"></a>00587       JBASE=0
<a name="l00588"></a>00588       <span class="keyword">DO</span> 380 L=1,LA
<a name="l00589"></a>00589         I=IBASE
<a name="l00590"></a>00590         J=JBASE
<a name="l00591"></a>00591 <span class="comment">!DIR$ IVDEP</span>
<a name="l00592"></a>00592         <span class="keyword">DO</span> 370 IJK=1,LOT
<a name="l00593"></a>00593           C(JA+J)=A(IA+I)+0.5*(A(IB+I)-A(IC+I))
<a name="l00594"></a>00594           D(JA+J)=-SIN60*(A(IB+I)+A(IC+I))
<a name="l00595"></a>00595           C(JB+J)=A(IA+I)-(A(IB+I)-A(IC+I))
<a name="l00596"></a>00596           I=I+INC3
<a name="l00597"></a>00597           J=J+INC4
<a name="l00598"></a>00598 370       CONTINUE
<a name="l00599"></a>00599         IBASE=IBASE+INC1
<a name="l00600"></a>00600         JBASE=JBASE+INC2
<a name="l00601"></a>00601 380     CONTINUE
<a name="l00602"></a>00602       GO TO 900
<a name="l00603"></a>00603 <span class="comment">!</span>
<a name="l00604"></a>00604 390   CONTINUE
<a name="l00605"></a>00605       Z=1.0/FLOAT(N)
<a name="l00606"></a>00606       ZSIN60=Z*SIN60
<a name="l00607"></a>00607       <span class="keyword">DO</span> 394 L=1,LA
<a name="l00608"></a>00608         I=IBASE
<a name="l00609"></a>00609         J=JBASE
<a name="l00610"></a>00610 <span class="comment">!DIR$ IVDEP</span>
<a name="l00611"></a>00611         <span class="keyword">DO</span> 392 IJK=1,LOT
<a name="l00612"></a>00612           C(JA+J)=Z*(A(IA+I)+(A(IB+I)+A(IC+I)))
<a name="l00613"></a>00613           C(JB+J)=Z*(A(IA+I)-0.5*(A(IB+I)+A(IC+I)))
<a name="l00614"></a>00614           D(JB+J)=ZSIN60*(A(IC+I)-A(IB+I))
<a name="l00615"></a>00615           I=I+INC3
<a name="l00616"></a>00616           J=J+INC4
<a name="l00617"></a>00617 392       CONTINUE
<a name="l00618"></a>00618         IBASE=IBASE+INC1
<a name="l00619"></a>00619         JBASE=JBASE+INC2
<a name="l00620"></a>00620 394     CONTINUE
<a name="l00621"></a>00621       GO TO 900
<a name="l00622"></a>00622 <span class="comment">!</span>
<a name="l00623"></a>00623 <span class="comment">!     CODING FOR FACTOR 4</span>
<a name="l00624"></a>00624 <span class="comment">!     -------------------</span>
<a name="l00625"></a>00625 400   CONTINUE
<a name="l00626"></a>00626       IA=1
<a name="l00627"></a>00627       IB=IA+IINK
<a name="l00628"></a>00628       IC=IB+IINK
<a name="l00629"></a>00629       ID=IC+IINK
<a name="l00630"></a>00630       JA=1
<a name="l00631"></a>00631       JB=JA+(2*M-LA)*INC2
<a name="l00632"></a>00632       JC=JB+2*M*INC2
<a name="l00633"></a>00633       JD=JB
<a name="l00634"></a>00634 <span class="comment">!</span>
<a name="l00635"></a>00635       <span class="keyword">IF</span> (LA.EQ.M) GO TO 490
<a name="l00636"></a>00636 <span class="comment">!</span>
<a name="l00637"></a>00637       <span class="keyword">DO</span> 420 L=1,LA
<a name="l00638"></a>00638         I=IBASE
<a name="l00639"></a>00639         J=JBASE
<a name="l00640"></a>00640 <span class="comment">!DIR$ IVDEP</span>
<a name="l00641"></a>00641         <span class="keyword">DO</span> 410 IJK=1,LOT
<a name="l00642"></a>00642           C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))
<a name="l00643"></a>00643           C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))
<a name="l00644"></a>00644           C(JB+J)=A(IA+I)-A(IC+I)
<a name="l00645"></a>00645           D(JB+J)=A(ID+I)-A(IB+I)
<a name="l00646"></a>00646           I=I+INC3
<a name="l00647"></a>00647           J=J+INC4
<a name="l00648"></a>00648 410       CONTINUE
<a name="l00649"></a>00649         IBASE=IBASE+INC1
<a name="l00650"></a>00650         JBASE=JBASE+INC2
<a name="l00651"></a>00651 420     CONTINUE
<a name="l00652"></a>00652       JA=JA+JINK
<a name="l00653"></a>00653       JINK=2*JINK
<a name="l00654"></a>00654       JB=JB+JINK
<a name="l00655"></a>00655       JC=JC-JINK
<a name="l00656"></a>00656       JD=JD-JINK
<a name="l00657"></a>00657       IBASE=IBASE+IJUMP
<a name="l00658"></a>00658       IJUMP=2*IJUMP+IINK
<a name="l00659"></a>00659       <span class="keyword">IF</span> (JB.EQ.JC) GO TO 460
<a name="l00660"></a>00660       <span class="keyword">DO</span> 450 K=LA,KSTOP,LA
<a name="l00661"></a>00661         KB=K+K
<a name="l00662"></a>00662         KC=KB+KB
<a name="l00663"></a>00663         KD=KC+KB
<a name="l00664"></a>00664         C1=TRIGS(KB+1)
<a name="l00665"></a>00665         S1=TRIGS(KB+2)
<a name="l00666"></a>00666         C2=TRIGS(KC+1)
<a name="l00667"></a>00667         S2=TRIGS(KC+2)
<a name="l00668"></a>00668         C3=TRIGS(KD+1)
<a name="l00669"></a>00669         S3=TRIGS(KD+2)
<a name="l00670"></a>00670         JBASE=0
<a name="l00671"></a>00671         <span class="keyword">DO</span> 440 L=1,LA
<a name="l00672"></a>00672           I=IBASE
<a name="l00673"></a>00673           J=JBASE
<a name="l00674"></a>00674 <span class="comment">!DIR$ IVDEP</span>
<a name="l00675"></a>00675           <span class="keyword">DO</span> 430 IJK=1,LOT
<a name="l00676"></a>00676             A0=A(IA+I)+(C2*A(IC+I)+S2*B(IC+I))
<a name="l00677"></a>00677             A2=A(IA+I)-(C2*A(IC+I)+S2*B(IC+I))
<a name="l00678"></a>00678             A1=(C1*A(IB+I)+S1*B(IB+I))+(C3*A(ID+I)+S3*B(ID+I))
<a name="l00679"></a>00679             A3=(C1*A(IB+I)+S1*B(IB+I))-(C3*A(ID+I)+S3*B(ID+I))
<a name="l00680"></a>00680             B0=B(IA+I)+(C2*B(IC+I)-S2*A(IC+I))
<a name="l00681"></a>00681             B2=B(IA+I)-(C2*B(IC+I)-S2*A(IC+I))
<a name="l00682"></a>00682             B1=(C1*B(IB+I)-S1*A(IB+I))+(C3*B(ID+I)-S3*A(ID+I))
<a name="l00683"></a>00683             B3=(C1*B(IB+I)-S1*A(IB+I))-(C3*B(ID+I)-S3*A(ID+I))
<a name="l00684"></a>00684             C(JA+J)=A0+A1
<a name="l00685"></a>00685             C(JC+J)=A0-A1
<a name="l00686"></a>00686             D(JA+J)=B0+B1
<a name="l00687"></a>00687             D(JC+J)=B1-B0
<a name="l00688"></a>00688             C(JB+J)=A2+B3
<a name="l00689"></a>00689             C(JD+J)=A2-B3
<a name="l00690"></a>00690             D(JB+J)=B2-A3
<a name="l00691"></a>00691             D(JD+J)=-(B2+A3)
<a name="l00692"></a>00692             I=I+INC3
<a name="l00693"></a>00693             J=J+INC4
<a name="l00694"></a>00694 430         CONTINUE
<a name="l00695"></a>00695           IBASE=IBASE+INC1
<a name="l00696"></a>00696           JBASE=JBASE+INC2
<a name="l00697"></a>00697 440       CONTINUE
<a name="l00698"></a>00698         IBASE=IBASE+IJUMP
<a name="l00699"></a>00699         JA=JA+JINK
<a name="l00700"></a>00700         JB=JB+JINK
<a name="l00701"></a>00701         JC=JC-JINK
<a name="l00702"></a>00702         JD=JD-JINK
<a name="l00703"></a>00703 450     CONTINUE
<a name="l00704"></a>00704       <span class="keyword">IF</span> (JB.GT.JC) GO TO 900
<a name="l00705"></a>00705 460   CONTINUE
<a name="l00706"></a>00706       SIN45=SQRT(0.5)
<a name="l00707"></a>00707       JBASE=0
<a name="l00708"></a>00708       <span class="keyword">DO</span> 480 L=1,LA
<a name="l00709"></a>00709         I=IBASE
<a name="l00710"></a>00710         J=JBASE
<a name="l00711"></a>00711 <span class="comment">!DIR$ IVDEP</span>
<a name="l00712"></a>00712         <span class="keyword">DO</span> 470 IJK=1,LOT
<a name="l00713"></a>00713           C(JA+J)=A(IA+I)+SIN45*(A(IB+I)-A(ID+I))
<a name="l00714"></a>00714           C(JB+J)=A(IA+I)-SIN45*(A(IB+I)-A(ID+I))
<a name="l00715"></a>00715           D(JA+J)=-A(IC+I)-SIN45*(A(IB+I)+A(ID+I))
<a name="l00716"></a>00716           D(JB+J)=A(IC+I)-SIN45*(A(IB+I)+A(ID+I))
<a name="l00717"></a>00717           I=I+INC3
<a name="l00718"></a>00718           J=J+INC4
<a name="l00719"></a>00719 470       CONTINUE
<a name="l00720"></a>00720         IBASE=IBASE+INC1
<a name="l00721"></a>00721         JBASE=JBASE+INC2
<a name="l00722"></a>00722 480     CONTINUE
<a name="l00723"></a>00723       GO TO 900
<a name="l00724"></a>00724 <span class="comment">!</span>
<a name="l00725"></a>00725 490   CONTINUE
<a name="l00726"></a>00726       Z=1.0/FLOAT(N)
<a name="l00727"></a>00727       <span class="keyword">DO</span> 494 L=1,LA
<a name="l00728"></a>00728         I=IBASE
<a name="l00729"></a>00729         J=JBASE
<a name="l00730"></a>00730 <span class="comment">!DIR$ IVDEP</span>
<a name="l00731"></a>00731         <span class="keyword">DO</span> 492 IJK=1,LOT
<a name="l00732"></a>00732           C(JA+J)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)))
<a name="l00733"></a>00733           C(JC+J)=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)))
<a name="l00734"></a>00734           C(JB+J)=Z*(A(IA+I)-A(IC+I))
<a name="l00735"></a>00735           D(JB+J)=Z*(A(ID+I)-A(IB+I))
<a name="l00736"></a>00736           I=I+INC3
<a name="l00737"></a>00737           J=J+INC4
<a name="l00738"></a>00738 492       CONTINUE
<a name="l00739"></a>00739         IBASE=IBASE+INC1
<a name="l00740"></a>00740         JBASE=JBASE+INC2
<a name="l00741"></a>00741 494     CONTINUE
<a name="l00742"></a>00742       GO TO 900
<a name="l00743"></a>00743 <span class="comment">!</span>
<a name="l00744"></a>00744 <span class="comment">!     CODING FOR FACTOR 5</span>
<a name="l00745"></a>00745 <span class="comment">!     -------------------</span>
<a name="l00746"></a>00746 500   CONTINUE
<a name="l00747"></a>00747       IA=1
<a name="l00748"></a>00748       IB=IA+IINK
<a name="l00749"></a>00749       IC=IB+IINK
<a name="l00750"></a>00750       ID=IC+IINK
<a name="l00751"></a>00751       IE=ID+IINK
<a name="l00752"></a>00752       JA=1
<a name="l00753"></a>00753       JB=JA+(2*M-LA)*INC2
<a name="l00754"></a>00754       JC=JB+2*M*INC2
<a name="l00755"></a>00755       JD=JC
<a name="l00756"></a>00756       JE=JB
<a name="l00757"></a>00757 <span class="comment">!</span>
<a name="l00758"></a>00758       <span class="keyword">IF</span> (LA.EQ.M) GO TO 590
<a name="l00759"></a>00759 <span class="comment">!</span>
<a name="l00760"></a>00760       <span class="keyword">DO</span> 520 L=1,LA
<a name="l00761"></a>00761         I=IBASE
<a name="l00762"></a>00762         J=JBASE
<a name="l00763"></a>00763 <span class="comment">!DIR$ IVDEP</span>
<a name="l00764"></a>00764         <span class="keyword">DO</span> 510 IJK=1,LOT
<a name="l00765"></a>00765           A1=A(IB+I)+A(IE+I)
<a name="l00766"></a>00766           A3=A(IB+I)-A(IE+I)
<a name="l00767"></a>00767           A2=A(IC+I)+A(ID+I)
<a name="l00768"></a>00768           A4=A(IC+I)-A(ID+I)
<a name="l00769"></a>00769           A5=A(IA+I)-0.25*(A1+A2)
<a name="l00770"></a>00770           A6=QRT5*(A1-A2)
<a name="l00771"></a>00771           C(JA+J)=A(IA+I)+(A1+A2)
<a name="l00772"></a>00772           C(JB+J)=A5+A6
<a name="l00773"></a>00773           C(JC+J)=A5-A6
<a name="l00774"></a>00774           D(JB+J)=-SIN72*A3-SIN36*A4
<a name="l00775"></a>00775           D(JC+J)=-SIN36*A3+SIN72*A4
<a name="l00776"></a>00776           I=I+INC3
<a name="l00777"></a>00777           J=J+INC4
<a name="l00778"></a>00778 510       CONTINUE
<a name="l00779"></a>00779         IBASE=IBASE+INC1
<a name="l00780"></a>00780         JBASE=JBASE+INC2
<a name="l00781"></a>00781 520     CONTINUE
<a name="l00782"></a>00782       JA=JA+JINK
<a name="l00783"></a>00783       JINK=2*JINK
<a name="l00784"></a>00784       JB=JB+JINK
<a name="l00785"></a>00785       JC=JC+JINK
<a name="l00786"></a>00786       JD=JD-JINK
<a name="l00787"></a>00787       JE=JE-JINK
<a name="l00788"></a>00788       IBASE=IBASE+IJUMP
<a name="l00789"></a>00789       IJUMP=2*IJUMP+IINK
<a name="l00790"></a>00790       <span class="keyword">IF</span> (JB.EQ.JD) GO TO 560
<a name="l00791"></a>00791       <span class="keyword">DO</span> 550 K=LA,KSTOP,LA
<a name="l00792"></a>00792         KB=K+K
<a name="l00793"></a>00793         KC=KB+KB
<a name="l00794"></a>00794         KD=KC+KB
<a name="l00795"></a>00795         KE=KD+KB
<a name="l00796"></a>00796         C1=TRIGS(KB+1)
<a name="l00797"></a>00797         S1=TRIGS(KB+2)
<a name="l00798"></a>00798         C2=TRIGS(KC+1)
<a name="l00799"></a>00799         S2=TRIGS(KC+2)
<a name="l00800"></a>00800         C3=TRIGS(KD+1)
<a name="l00801"></a>00801         S3=TRIGS(KD+2)
<a name="l00802"></a>00802         C4=TRIGS(KE+1)
<a name="l00803"></a>00803         S4=TRIGS(KE+2)
<a name="l00804"></a>00804         JBASE=0
<a name="l00805"></a>00805         <span class="keyword">DO</span> 540 L=1,LA
<a name="l00806"></a>00806           I=IBASE
<a name="l00807"></a>00807           J=JBASE
<a name="l00808"></a>00808 <span class="comment">!DIR$ IVDEP</span>
<a name="l00809"></a>00809           <span class="keyword">DO</span> 530 IJK=1,LOT
<a name="l00810"></a>00810             A1=(C1*A(IB+I)+S1*B(IB+I))+(C4*A(IE+I)+S4*B(IE+I))
<a name="l00811"></a>00811             A3=(C1*A(IB+I)+S1*B(IB+I))-(C4*A(IE+I)+S4*B(IE+I))
<a name="l00812"></a>00812             A2=(C2*A(IC+I)+S2*B(IC+I))+(C3*A(ID+I)+S3*B(ID+I))
<a name="l00813"></a>00813             A4=(C2*A(IC+I)+S2*B(IC+I))-(C3*A(ID+I)+S3*B(ID+I))
<a name="l00814"></a>00814             B1=(C1*B(IB+I)-S1*A(IB+I))+(C4*B(IE+I)-S4*A(IE+I))
<a name="l00815"></a>00815             B3=(C1*B(IB+I)-S1*A(IB+I))-(C4*B(IE+I)-S4*A(IE+I))
<a name="l00816"></a>00816             B2=(C2*B(IC+I)-S2*A(IC+I))+(C3*B(ID+I)-S3*A(ID+I))
<a name="l00817"></a>00817             B4=(C2*B(IC+I)-S2*A(IC+I))-(C3*B(ID+I)-S3*A(ID+I))
<a name="l00818"></a>00818             A5=A(IA+I)-0.25*(A1+A2)
<a name="l00819"></a>00819             A6=QRT5*(A1-A2)
<a name="l00820"></a>00820             B5=B(IA+I)-0.25*(B1+B2)
<a name="l00821"></a>00821             B6=QRT5*(B1-B2)
<a name="l00822"></a>00822             A10=A5+A6
<a name="l00823"></a>00823             A20=A5-A6
<a name="l00824"></a>00824             B10=B5+B6
<a name="l00825"></a>00825             B20=B5-B6
<a name="l00826"></a>00826             A11=SIN72*B3+SIN36*B4
<a name="l00827"></a>00827             A21=SIN36*B3-SIN72*B4
<a name="l00828"></a>00828             B11=SIN72*A3+SIN36*A4
<a name="l00829"></a>00829             B21=SIN36*A3-SIN72*A4
<a name="l00830"></a>00830             C(JA+J)=A(IA+I)+(A1+A2)
<a name="l00831"></a>00831             C(JB+J)=A10+A11
<a name="l00832"></a>00832             C(JE+J)=A10-A11
<a name="l00833"></a>00833             C(JC+J)=A20+A21
<a name="l00834"></a>00834             C(JD+J)=A20-A21
<a name="l00835"></a>00835             D(JA+J)=B(IA+I)+(B1+B2)
<a name="l00836"></a>00836             D(JB+J)=B10-B11
<a name="l00837"></a>00837             D(JE+J)=-(B10+B11)
<a name="l00838"></a>00838             D(JC+J)=B20-B21
<a name="l00839"></a>00839             D(JD+J)=-(B20+B21)
<a name="l00840"></a>00840             I=I+INC3
<a name="l00841"></a>00841             J=J+INC4
<a name="l00842"></a>00842 530         CONTINUE
<a name="l00843"></a>00843           IBASE=IBASE+INC1
<a name="l00844"></a>00844           JBASE=JBASE+INC2
<a name="l00845"></a>00845 540       CONTINUE
<a name="l00846"></a>00846         IBASE=IBASE+IJUMP
<a name="l00847"></a>00847         JA=JA+JINK
<a name="l00848"></a>00848         JB=JB+JINK
<a name="l00849"></a>00849         JC=JC+JINK
<a name="l00850"></a>00850         JD=JD-JINK
<a name="l00851"></a>00851         JE=JE-JINK
<a name="l00852"></a>00852 550     CONTINUE
<a name="l00853"></a>00853       <span class="keyword">IF</span> (JB.GT.JD) GO TO 900
<a name="l00854"></a>00854 560   CONTINUE
<a name="l00855"></a>00855       JBASE=0
<a name="l00856"></a>00856       <span class="keyword">DO</span> 580 L=1,LA
<a name="l00857"></a>00857         I=IBASE
<a name="l00858"></a>00858         J=JBASE
<a name="l00859"></a>00859 <span class="comment">!DIR$ IVDEP</span>
<a name="l00860"></a>00860         <span class="keyword">DO</span> 570 IJK=1,LOT
<a name="l00861"></a>00861           A1=A(IB+I)+A(IE+I)
<a name="l00862"></a>00862           A3=A(IB+I)-A(IE+I)
<a name="l00863"></a>00863           A2=A(IC+I)+A(ID+I)
<a name="l00864"></a>00864           A4=A(IC+I)-A(ID+I)
<a name="l00865"></a>00865           A5=A(IA+I)+0.25*(A3-A4)
<a name="l00866"></a>00866           A6=QRT5*(A3+A4)
<a name="l00867"></a>00867           C(JA+J)=A5+A6
<a name="l00868"></a>00868           C(JB+J)=A5-A6
<a name="l00869"></a>00869           C(JC+J)=A(IA+I)-(A3-A4)
<a name="l00870"></a>00870           D(JA+J)=-SIN36*A1-SIN72*A2
<a name="l00871"></a>00871           D(JB+J)=-SIN72*A1+SIN36*A2
<a name="l00872"></a>00872           I=I+INC3
<a name="l00873"></a>00873           J=J+INC4
<a name="l00874"></a>00874 570       CONTINUE
<a name="l00875"></a>00875         IBASE=IBASE+INC1
<a name="l00876"></a>00876         JBASE=JBASE+INC2
<a name="l00877"></a>00877 580     CONTINUE
<a name="l00878"></a>00878       GO TO 900
<a name="l00879"></a>00879 <span class="comment">!</span>
<a name="l00880"></a>00880 590   CONTINUE
<a name="l00881"></a>00881       Z=1.0/FLOAT(N)
<a name="l00882"></a>00882       ZQRT5=Z*QRT5
<a name="l00883"></a>00883       ZSIN36=Z*SIN36
<a name="l00884"></a>00884       ZSIN72=Z*SIN72
<a name="l00885"></a>00885       <span class="keyword">DO</span> 594 L=1,LA
<a name="l00886"></a>00886         I=IBASE
<a name="l00887"></a>00887         J=JBASE
<a name="l00888"></a>00888 <span class="comment">!DIR$ IVDEP</span>
<a name="l00889"></a>00889         <span class="keyword">DO</span> 592 IJK=1,LOT
<a name="l00890"></a>00890           A1=A(IB+I)+A(IE+I)
<a name="l00891"></a>00891           A3=A(IB+I)-A(IE+I)
<a name="l00892"></a>00892           A2=A(IC+I)+A(ID+I)
<a name="l00893"></a>00893           A4=A(IC+I)-A(ID+I)
<a name="l00894"></a>00894           A5=Z*(A(IA+I)-0.25*(A1+A2))
<a name="l00895"></a>00895           A6=ZQRT5*(A1-A2)
<a name="l00896"></a>00896           C(JA+J)=Z*(A(IA+I)+(A1+A2))
<a name="l00897"></a>00897           C(JB+J)=A5+A6
<a name="l00898"></a>00898           C(JC+J)=A5-A6
<a name="l00899"></a>00899           D(JB+J)=-ZSIN72*A3-ZSIN36*A4
<a name="l00900"></a>00900           D(JC+J)=-ZSIN36*A3+ZSIN72*A4
<a name="l00901"></a>00901           I=I+INC3
<a name="l00902"></a>00902           J=J+INC4
<a name="l00903"></a>00903 592       CONTINUE
<a name="l00904"></a>00904         IBASE=IBASE+INC1
<a name="l00905"></a>00905         JBASE=JBASE+INC2
<a name="l00906"></a>00906 594     CONTINUE
<a name="l00907"></a>00907       GO TO 900
<a name="l00908"></a>00908 <span class="comment">!</span>
<a name="l00909"></a>00909 <span class="comment">!     CODING FOR FACTOR 6</span>
<a name="l00910"></a>00910 <span class="comment">!     -------------------</span>
<a name="l00911"></a>00911 600   CONTINUE
<a name="l00912"></a>00912       IA=1
<a name="l00913"></a>00913       IB=IA+IINK
<a name="l00914"></a>00914       IC=IB+IINK
<a name="l00915"></a>00915       ID=IC+IINK
<a name="l00916"></a>00916       IE=ID+IINK
<a name="l00917"></a>00917       IF=IE+IINK
<a name="l00918"></a>00918       JA=1
<a name="l00919"></a>00919       JB=JA+(2*M-LA)*INC2
<a name="l00920"></a>00920       JC=JB+2*M*INC2
<a name="l00921"></a>00921       JD=JC+2*M*INC2
<a name="l00922"></a>00922       JE=JC
<a name="l00923"></a>00923       JF=JB
<a name="l00924"></a>00924 <span class="comment">!</span>
<a name="l00925"></a>00925       <span class="keyword">IF</span> (LA.EQ.M) GO TO 690
<a name="l00926"></a>00926 <span class="comment">!</span>
<a name="l00927"></a>00927       <span class="keyword">DO</span> 620 L=1,LA
<a name="l00928"></a>00928         I=IBASE
<a name="l00929"></a>00929         J=JBASE
<a name="l00930"></a>00930 <span class="comment">!DIR$ IVDEP</span>
<a name="l00931"></a>00931         <span class="keyword">DO</span> 610 IJK=1,LOT
<a name="l00932"></a>00932           A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I))
<a name="l00933"></a>00933           C(JA+J)=(A(IA+I)+A(ID+I))+A11
<a name="l00934"></a>00934           C(JC+J)=(A(IA+I)+A(ID+I)-0.5*A11)
<a name="l00935"></a>00935           D(JC+J)=SIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I)))
<a name="l00936"></a>00936           A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I))
<a name="l00937"></a>00937           C(JB+J)=(A(IA+I)-A(ID+I))-0.5*A11
<a name="l00938"></a>00938           D(JB+J)=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I)))
<a name="l00939"></a>00939           C(JD+J)=(A(IA+I)-A(ID+I))+A11
<a name="l00940"></a>00940           I=I+INC3
<a name="l00941"></a>00941           J=J+INC4
<a name="l00942"></a>00942 610       CONTINUE
<a name="l00943"></a>00943         IBASE=IBASE+INC1
<a name="l00944"></a>00944         JBASE=JBASE+INC2
<a name="l00945"></a>00945 620     CONTINUE
<a name="l00946"></a>00946       JA=JA+JINK
<a name="l00947"></a>00947       JINK=2*JINK
<a name="l00948"></a>00948       JB=JB+JINK
<a name="l00949"></a>00949       JC=JC+JINK
<a name="l00950"></a>00950       JD=JD-JINK
<a name="l00951"></a>00951       JE=JE-JINK
<a name="l00952"></a>00952       JF=JF-JINK
<a name="l00953"></a>00953       IBASE=IBASE+IJUMP
<a name="l00954"></a>00954       IJUMP=2*IJUMP+IINK
<a name="l00955"></a>00955       <span class="keyword">IF</span> (JC.EQ.JD) GO TO 660
<a name="l00956"></a>00956       <span class="keyword">DO</span> 650 K=LA,KSTOP,LA
<a name="l00957"></a>00957         KB=K+K
<a name="l00958"></a>00958         KC=KB+KB
<a name="l00959"></a>00959         KD=KC+KB
<a name="l00960"></a>00960         KE=KD+KB
<a name="l00961"></a>00961         KF=KE+KB
<a name="l00962"></a>00962         C1=TRIGS(KB+1)
<a name="l00963"></a>00963         S1=TRIGS(KB+2)
<a name="l00964"></a>00964         C2=TRIGS(KC+1)
<a name="l00965"></a>00965         S2=TRIGS(KC+2)
<a name="l00966"></a>00966         C3=TRIGS(KD+1)
<a name="l00967"></a>00967         S3=TRIGS(KD+2)
<a name="l00968"></a>00968         C4=TRIGS(KE+1)
<a name="l00969"></a>00969         S4=TRIGS(KE+2)
<a name="l00970"></a>00970         C5=TRIGS(KF+1)
<a name="l00971"></a>00971         S5=TRIGS(KF+2)
<a name="l00972"></a>00972         JBASE=0
<a name="l00973"></a>00973         <span class="keyword">DO</span> 640 L=1,LA
<a name="l00974"></a>00974           I=IBASE
<a name="l00975"></a>00975           J=JBASE
<a name="l00976"></a>00976 <span class="comment">!DIR$ IVDEP</span>
<a name="l00977"></a>00977           <span class="keyword">DO</span> 630 IJK=1,LOT
<a name="l00978"></a>00978             A1=C1*A(IB+I)+S1*B(IB+I)
<a name="l00979"></a>00979             B1=C1*B(IB+I)-S1*A(IB+I)
<a name="l00980"></a>00980             A2=C2*A(IC+I)+S2*B(IC+I)
<a name="l00981"></a>00981             B2=C2*B(IC+I)-S2*A(IC+I)
<a name="l00982"></a>00982             A3=C3*A(ID+I)+S3*B(ID+I)
<a name="l00983"></a>00983             B3=C3*B(ID+I)-S3*A(ID+I)
<a name="l00984"></a>00984             A4=C4*A(IE+I)+S4*B(IE+I)
<a name="l00985"></a>00985             B4=C4*B(IE+I)-S4*A(IE+I)
<a name="l00986"></a>00986             A5=C5*A(IF+I)+S5*B(IF+I)
<a name="l00987"></a>00987             B5=C5*B(IF+I)-S5*A(IF+I)
<a name="l00988"></a>00988             A11=(A2+A5)+(A1+A4)
<a name="l00989"></a>00989             A20=(A(IA+I)+A3)-0.5*A11
<a name="l00990"></a>00990             A21=SIN60*((A2+A5)-(A1+A4))
<a name="l00991"></a>00991             B11=(B2+B5)+(B1+B4)
<a name="l00992"></a>00992             B20=(B(IA+I)+B3)-0.5*B11
<a name="l00993"></a>00993             B21=SIN60*((B2+B5)-(B1+B4))
<a name="l00994"></a>00994             C(JA+J)=(A(IA+I)+A3)+A11
<a name="l00995"></a>00995             D(JA+J)=(B(IA+I)+B3)+B11
<a name="l00996"></a>00996             C(JC+J)=A20-B21
<a name="l00997"></a>00997             D(JC+J)=A21+B20
<a name="l00998"></a>00998             C(JE+J)=A20+B21
<a name="l00999"></a>00999             D(JE+J)=A21-B20
<a name="l01000"></a>01000             A11=(A2-A5)+(A4-A1)
<a name="l01001"></a>01001             A20=(A(IA+I)-A3)-0.5*A11
<a name="l01002"></a>01002             A21=SIN60*((A4-A1)-(A2-A5))
<a name="l01003"></a>01003             B11=(B5-B2)-(B4-B1)
<a name="l01004"></a>01004             B20=(B3-B(IA+I))-0.5*B11
<a name="l01005"></a>01005             B21=SIN60*((B5-B2)+(B4-B1))
<a name="l01006"></a>01006             C(JB+J)=A20-B21
<a name="l01007"></a>01007             D(JB+J)=A21-B20
<a name="l01008"></a>01008             C(JD+J)=A11+(A(IA+I)-A3)
<a name="l01009"></a>01009             D(JD+J)=B11+(B3-B(IA+I))
<a name="l01010"></a>01010             C(JF+J)=A20+B21
<a name="l01011"></a>01011             D(JF+J)=A21+B20
<a name="l01012"></a>01012             I=I+INC3
<a name="l01013"></a>01013             J=J+INC4
<a name="l01014"></a>01014 630         CONTINUE
<a name="l01015"></a>01015           IBASE=IBASE+INC1
<a name="l01016"></a>01016           JBASE=JBASE+INC2
<a name="l01017"></a>01017 640       CONTINUE
<a name="l01018"></a>01018         IBASE=IBASE+IJUMP
<a name="l01019"></a>01019         JA=JA+JINK
<a name="l01020"></a>01020         JB=JB+JINK
<a name="l01021"></a>01021         JC=JC+JINK
<a name="l01022"></a>01022         JD=JD-JINK
<a name="l01023"></a>01023         JE=JE-JINK
<a name="l01024"></a>01024         JF=JF-JINK
<a name="l01025"></a>01025 650     CONTINUE
<a name="l01026"></a>01026       <span class="keyword">IF</span> (JC.GT.JD) GO TO 900
<a name="l01027"></a>01027 660   CONTINUE
<a name="l01028"></a>01028       JBASE=0
<a name="l01029"></a>01029       <span class="keyword">DO</span> 680 L=1,LA
<a name="l01030"></a>01030         I=IBASE
<a name="l01031"></a>01031         J=JBASE
<a name="l01032"></a>01032 <span class="comment">!DIR$ IVDEP</span>
<a name="l01033"></a>01033         <span class="keyword">DO</span> 670 IJK=1,LOT
<a name="l01034"></a>01034           C(JA+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I)))+ SIN60*(A(IB+I)-A(IF+I))
<a name="l01035"></a>01035           D(JA+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I)))-SIN60*(A(IC+I)+A(IE+I))
<a name="l01036"></a>01036           C(JB+J)=A(IA+I)-(A(IC+I)-A(IE+I))
<a name="l01037"></a>01037           D(JB+J)=A(ID+I)-(A(IB+I)+A(IF+I))
<a name="l01038"></a>01038           C(JC+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I)))-SIN60*(A(IB+I)-A(IF+I))
<a name="l01039"></a>01039           D(JC+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I)))+SIN60*(A(IC+I)+A(IE+I))
<a name="l01040"></a>01040           I=I+INC3
<a name="l01041"></a>01041           J=J+INC4
<a name="l01042"></a>01042 670       CONTINUE
<a name="l01043"></a>01043         IBASE=IBASE+INC1
<a name="l01044"></a>01044         JBASE=JBASE+INC2
<a name="l01045"></a>01045 680     CONTINUE
<a name="l01046"></a>01046       GO TO 900
<a name="l01047"></a>01047 <span class="comment">!</span>
<a name="l01048"></a>01048 690   CONTINUE
<a name="l01049"></a>01049       Z=1.0/FLOAT(N)
<a name="l01050"></a>01050       ZSIN60=Z*SIN60
<a name="l01051"></a>01051       <span class="keyword">DO</span> 694 L=1,LA
<a name="l01052"></a>01052         I=IBASE
<a name="l01053"></a>01053         J=JBASE
<a name="l01054"></a>01054 <span class="comment">!DIR$ IVDEP</span>
<a name="l01055"></a>01055         <span class="keyword">DO</span> 692 IJK=1,LOT
<a name="l01056"></a>01056           A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I))
<a name="l01057"></a>01057           C(JA+J)=Z*((A(IA+I)+A(ID+I))+A11)
<a name="l01058"></a>01058           C(JC+J)=Z*((A(IA+I)+A(ID+I))-0.5*A11)
<a name="l01059"></a>01059           D(JC+J)=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I)))
<a name="l01060"></a>01060           A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I))
<a name="l01061"></a>01061           C(JB+J)=Z*((A(IA+I)-A(ID+I))-0.5*A11)
<a name="l01062"></a>01062           D(JB+J)=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I)))
<a name="l01063"></a>01063           C(JD+J)=Z*((A(IA+I)-A(ID+I))+A11)
<a name="l01064"></a>01064           I=I+INC3
<a name="l01065"></a>01065           J=J+INC4
<a name="l01066"></a>01066 692       CONTINUE
<a name="l01067"></a>01067         IBASE=IBASE+INC1
<a name="l01068"></a>01068         JBASE=JBASE+INC2
<a name="l01069"></a>01069 694     CONTINUE
<a name="l01070"></a>01070       GO TO 900
<a name="l01071"></a>01071 <span class="comment">!</span>
<a name="l01072"></a>01072 <span class="comment">!     CODING FOR FACTOR 8</span>
<a name="l01073"></a>01073 <span class="comment">!     -------------------</span>
<a name="l01074"></a>01074 800   CONTINUE
<a name="l01075"></a>01075       IBAD=3
<a name="l01076"></a>01076       <span class="keyword">IF</span> (LA.NE.M) GO TO 910
<a name="l01077"></a>01077       IA=1
<a name="l01078"></a>01078       IB=IA+IINK
<a name="l01079"></a>01079       IC=IB+IINK
<a name="l01080"></a>01080       ID=IC+IINK
<a name="l01081"></a>01081       IE=ID+IINK
<a name="l01082"></a>01082       IF=IE+IINK
<a name="l01083"></a>01083       IG=IF+IINK
<a name="l01084"></a>01084       IH=IG+IINK
<a name="l01085"></a>01085       JA=1
<a name="l01086"></a>01086       JB=JA+LA*INC2
<a name="l01087"></a>01087       JC=JB+2*M*INC2
<a name="l01088"></a>01088       JD=JC+2*M*INC2
<a name="l01089"></a>01089       JE=JD+2*M*INC2
<a name="l01090"></a>01090       Z=1.0/FLOAT(N)
<a name="l01091"></a>01091       ZSIN45=Z*SQRT(0.5)
<a name="l01092"></a>01092 <span class="comment">!</span>
<a name="l01093"></a>01093       <span class="keyword">DO</span> 820 L=1,LA
<a name="l01094"></a>01094         I=IBASE
<a name="l01095"></a>01095         J=JBASE
<a name="l01096"></a>01096 <span class="comment">!DIR$ IVDEP</span>
<a name="l01097"></a>01097         <span class="keyword">DO</span> 810 IJK=1,LOT
<a name="l01098"></a>01098           C(JA+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ &amp;
<a name="l01099"></a>01099                    ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I))))
<a name="l01100"></a>01100           C(JE+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- &amp;
<a name="l01101"></a>01101                    ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I))))
<a name="l01102"></a>01102           C(JC+J)=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I)))
<a name="l01103"></a>01103           D(JC+J)=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I)))
<a name="l01104"></a>01104           C(JB+J)=Z*(A(IA+I)-A(IE+I)) &amp;
<a name="l01105"></a>01105                    +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I)))
<a name="l01106"></a>01106           C(JD+J)=Z*(A(IA+I)-A(IE+I)) &amp;
<a name="l01107"></a>01107                    -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I)))
<a name="l01108"></a>01108           D(JB+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) &amp;
<a name="l01109"></a>01109                    +Z*(A(IG+I)-A(IC+I))
<a name="l01110"></a>01110           D(JD+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) &amp;
<a name="l01111"></a>01111                    -Z*(A(IG+I)-A(IC+I))
<a name="l01112"></a>01112           I=I+INC3
<a name="l01113"></a>01113           J=J+INC4
<a name="l01114"></a>01114 810       CONTINUE
<a name="l01115"></a>01115         IBASE=IBASE+INC1
<a name="l01116"></a>01116         JBASE=JBASE+INC2
<a name="l01117"></a>01117 820     CONTINUE
<a name="l01118"></a>01118 <span class="comment">!</span>
<a name="l01119"></a>01119 <span class="comment">!     RETURN</span>
<a name="l01120"></a>01120 <span class="comment">!     ------</span>
<a name="l01121"></a>01121 900   CONTINUE
<a name="l01122"></a>01122       IBAD=0
<a name="l01123"></a>01123 910   CONTINUE
<a name="l01124"></a>01124       IERR=IBAD
<a name="l01125"></a>01125       RETURN
<a name="l01126"></a>01126 <span class="keyword">      END</span>
<a name="l01127"></a>01127 
<a name="l01128"></a>01128 
<a name="l01129"></a>01129 
<a name="l01130"></a><a class="code" href="fft991mod_8f90.html#adcdb3d2377fcf2988ef3f1d4a0fdf9af">01130</a>       <span class="keyword">SUBROUTINE </span><a class="code" href="fft991mod_8f90.html#adcdb3d2377fcf2988ef3f1d4a0fdf9af">RPASSM</a>(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA,IERR)
<a name="l01131"></a>01131 <span class="comment">!     SUBROUTINE &#39;RPASSM&#39; - PERFORMS ONE PASS THROUGH DATA AS PART</span>
<a name="l01132"></a>01132 <span class="comment">!     OF MULTIPLE REAL FFT (FOURIER SYNTHESIS) ROUTINE</span>
<a name="l01133"></a>01133 <span class="comment">!</span>
<a name="l01134"></a>01134 <span class="comment">!     A IS FIRST REAL INPUT VECTOR</span>
<a name="l01135"></a>01135 <span class="comment">!         EQUIVALENCE B(1) WITH A (LA*INC1+1)</span>
<a name="l01136"></a>01136 <span class="comment">!     C IS FIRST REAL OUTPUT VECTOR</span>
<a name="l01137"></a>01137 <span class="comment">!         EQUIVALENCE D(1) WITH C(IFAC*LA*INC2+1)</span>
<a name="l01138"></a>01138 <span class="comment">!     TRIGS IS A PRECALCULATED LIST OF SINES &amp; COSINES</span>
<a name="l01139"></a>01139 <span class="comment">!     INC1 IS THE ADDRESSING INCREMENT FOR A</span>
<a name="l01140"></a>01140 <span class="comment">!     INC2 IS THE ADDRESSING INCREMENT FOR C</span>
<a name="l01141"></a>01141 <span class="comment">!     INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A</span>
<a name="l01142"></a>01142 <span class="comment">!     INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C</span>
<a name="l01143"></a>01143 <span class="comment">!     LOT IS THE NUMBER OF VECTORS</span>
<a name="l01144"></a>01144 <span class="comment">!     N IS THE LENGTH OF THE VECTORS</span>
<a name="l01145"></a>01145 <span class="comment">!     IFAC IS THE CURRENT FACTOR OF N</span>
<a name="l01146"></a>01146 <span class="comment">!     LA IS THE PRODUCT OF PREVIOUS FACTORS</span>
<a name="l01147"></a>01147 <span class="comment">!     IERR IS AN ERROR INDICATOR:</span>
<a name="l01148"></a>01148 <span class="comment">!              0 - PASS COMPLETED WITHOUT ERROR</span>
<a name="l01149"></a>01149 <span class="comment">!              1 - LOT GREATER THAN 64</span>
<a name="l01150"></a>01150 <span class="comment">!              2 - IFAC NOT CATERED FOR</span>
<a name="l01151"></a>01151 <span class="comment">!              3 - IFAC ONLY CATERED FOR IF LA=N/IFAC</span>
<a name="l01152"></a>01152 <span class="comment">!</span>
<a name="l01153"></a>01153 <span class="comment">!-----------------------------------------------------------------------</span>
<a name="l01154"></a>01154 <span class="comment">!</span>
<a name="l01155"></a>01155       DIMENSION A(*),B(*),C(*),D(*),TRIGS(N)
<a name="l01156"></a>01156 <span class="comment">!</span>
<a name="l01157"></a>01157       DIMENSION A10(64),A11(64),A20(64),A21(64),B10(64),B11(64),B20(64),B21(64)
<a name="l01158"></a>01158       parameter(SIN36 = 0.587785252292473)
<a name="l01159"></a>01159       parameter(SIN72 = 0.951056516295154)
<a name="l01160"></a>01160       parameter(QRT5  = 0.559016994374947)
<a name="l01161"></a>01161       parameter(SIN60 = 0.866025403784437)
<a name="l01162"></a>01162 <span class="comment">!</span>
<a name="l01163"></a>01163       M=N/IFAC
<a name="l01164"></a>01164       IINK=LA*INC1
<a name="l01165"></a>01165       JINK=LA*INC2
<a name="l01166"></a>01166       JUMP=(IFAC-1)*JINK
<a name="l01167"></a>01167       KSTOP=(N-IFAC)/(2*IFAC)
<a name="l01168"></a>01168 <span class="comment">!</span>
<a name="l01169"></a>01169       IBAD=1
<a name="l01170"></a>01170       <span class="keyword">IF</span> (LOT.GT.64) GO TO 910
<a name="l01171"></a>01171       IBASE=0
<a name="l01172"></a>01172       JBASE=0
<a name="l01173"></a>01173       IGO=IFAC-1
<a name="l01174"></a>01174       <span class="keyword">IF</span> (IGO.EQ.7) IGO=6
<a name="l01175"></a>01175       IBAD=2
<a name="l01176"></a>01176       <span class="keyword">IF</span> (IGO.LT.1.OR.IGO.GT.6) GO TO 910
<a name="l01177"></a>01177       GO TO (200,300,400,500,600,800),IGO
<a name="l01178"></a>01178 <span class="comment">!</span>
<a name="l01179"></a>01179 <span class="comment">!     CODING FOR FACTOR 2</span>
<a name="l01180"></a>01180 <span class="comment">!     -------------------</span>
<a name="l01181"></a>01181 200   CONTINUE
<a name="l01182"></a>01182       IA=1
<a name="l01183"></a>01183       IB=IA+(2*M-LA)*INC1
<a name="l01184"></a>01184       JA=1
<a name="l01185"></a>01185       JB=JA+JINK
<a name="l01186"></a>01186 <span class="comment">!</span>
<a name="l01187"></a>01187       <span class="keyword">IF</span> (LA.EQ.M) GO TO 290
<a name="l01188"></a>01188 <span class="comment">!</span>
<a name="l01189"></a>01189       <span class="keyword">DO</span> 220 L=1,LA
<a name="l01190"></a>01190         I=IBASE
<a name="l01191"></a>01191         J=JBASE
<a name="l01192"></a>01192 <span class="comment">!DIR$ IVDEP</span>
<a name="l01193"></a>01193         <span class="keyword">DO</span> 210 IJK=1,LOT
<a name="l01194"></a>01194           C(JA+J)=A(IA+I)+A(IB+I)
<a name="l01195"></a>01195           C(JB+J)=A(IA+I)-A(IB+I)
<a name="l01196"></a>01196           I=I+INC3
<a name="l01197"></a>01197           J=J+INC4
<a name="l01198"></a>01198 210       CONTINUE
<a name="l01199"></a>01199         IBASE=IBASE+INC1
<a name="l01200"></a>01200         JBASE=JBASE+INC2
<a name="l01201"></a>01201 220     CONTINUE
<a name="l01202"></a>01202       IA=IA+IINK
<a name="l01203"></a>01203       IINK=2*IINK
<a name="l01204"></a>01204       IB=IB-IINK
<a name="l01205"></a>01205       IBASE=0
<a name="l01206"></a>01206       JBASE=JBASE+JUMP
<a name="l01207"></a>01207       JUMP=2*JUMP+JINK
<a name="l01208"></a>01208       <span class="keyword">IF</span> (IA.EQ.IB) GO TO 260
<a name="l01209"></a>01209       <span class="keyword">DO</span> 250 K=LA,KSTOP,LA
<a name="l01210"></a>01210         KB=K+K
<a name="l01211"></a>01211         C1=TRIGS(KB+1)
<a name="l01212"></a>01212         S1=TRIGS(KB+2)
<a name="l01213"></a>01213         IBASE=0
<a name="l01214"></a>01214         <span class="keyword">DO</span> 240 L=1,LA
<a name="l01215"></a>01215           I=IBASE
<a name="l01216"></a>01216           J=JBASE
<a name="l01217"></a>01217 <span class="comment">!DIR$ IVDEP</span>
<a name="l01218"></a>01218           <span class="keyword">DO</span> 230 IJK=1,LOT
<a name="l01219"></a>01219             C(JA+J)=A(IA+I)+A(IB+I)
<a name="l01220"></a>01220             D(JA+J)=B(IA+I)-B(IB+I)
<a name="l01221"></a>01221             C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)+B(IB+I))
<a name="l01222"></a>01222             D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)+B(IB+I))
<a name="l01223"></a>01223             I=I+INC3
<a name="l01224"></a>01224             J=J+INC4
<a name="l01225"></a>01225 230         CONTINUE
<a name="l01226"></a>01226           IBASE=IBASE+INC1
<a name="l01227"></a>01227           JBASE=JBASE+INC2
<a name="l01228"></a>01228 240       CONTINUE
<a name="l01229"></a>01229         IA=IA+IINK
<a name="l01230"></a>01230         IB=IB-IINK
<a name="l01231"></a>01231         JBASE=JBASE+JUMP
<a name="l01232"></a>01232 250     CONTINUE
<a name="l01233"></a>01233       <span class="keyword">IF</span> (IA.GT.IB) GO TO 900
<a name="l01234"></a>01234 260   CONTINUE
<a name="l01235"></a>01235       IBASE=0
<a name="l01236"></a>01236       <span class="keyword">DO</span> 280 L=1,LA
<a name="l01237"></a>01237         I=IBASE
<a name="l01238"></a>01238         J=JBASE
<a name="l01239"></a>01239 <span class="comment">!DIR$ IVDEP</span>
<a name="l01240"></a>01240         <span class="keyword">DO</span> 270 IJK=1,LOT
<a name="l01241"></a>01241           C(JA+J)=A(IA+I)
<a name="l01242"></a>01242           C(JB+J)=-B(IA+I)
<a name="l01243"></a>01243           I=I+INC3
<a name="l01244"></a>01244           J=J+INC4
<a name="l01245"></a>01245 270       CONTINUE
<a name="l01246"></a>01246         IBASE=IBASE+INC1
<a name="l01247"></a>01247         JBASE=JBASE+INC2
<a name="l01248"></a>01248 280     CONTINUE
<a name="l01249"></a>01249       GO TO 900
<a name="l01250"></a>01250 <span class="comment">!</span>
<a name="l01251"></a>01251 290   CONTINUE
<a name="l01252"></a>01252       <span class="keyword">DO</span> 294 L=1,LA
<a name="l01253"></a>01253         I=IBASE
<a name="l01254"></a>01254         J=JBASE
<a name="l01255"></a>01255 <span class="comment">!DIR$ IVDEP</span>
<a name="l01256"></a>01256         <span class="keyword">DO</span> 292 IJK=1,LOT
<a name="l01257"></a>01257           C(JA+J)=2.0*(A(IA+I)+A(IB+I))
<a name="l01258"></a>01258           C(JB+J)=2.0*(A(IA+I)-A(IB+I))
<a name="l01259"></a>01259           I=I+INC3
<a name="l01260"></a>01260           J=J+INC4
<a name="l01261"></a>01261 292       CONTINUE
<a name="l01262"></a>01262         IBASE=IBASE+INC1
<a name="l01263"></a>01263         JBASE=JBASE+INC2
<a name="l01264"></a>01264 294     CONTINUE
<a name="l01265"></a>01265       GO TO 900
<a name="l01266"></a>01266 <span class="comment">!</span>
<a name="l01267"></a>01267 <span class="comment">!     CODING FOR FACTOR 3</span>
<a name="l01268"></a>01268 <span class="comment">!     -------------------</span>
<a name="l01269"></a>01269 300   CONTINUE
<a name="l01270"></a>01270       IA=1
<a name="l01271"></a>01271       IB=IA+(2*M-LA)*INC1
<a name="l01272"></a>01272       IC=IB
<a name="l01273"></a>01273       JA=1
<a name="l01274"></a>01274       JB=JA+JINK
<a name="l01275"></a>01275       JC=JB+JINK
<a name="l01276"></a>01276 <span class="comment">!</span>
<a name="l01277"></a>01277       <span class="keyword">IF</span> (LA.EQ.M) GO TO 390
<a name="l01278"></a>01278 <span class="comment">!</span>
<a name="l01279"></a>01279       <span class="keyword">DO</span> 320 L=1,LA
<a name="l01280"></a>01280         I=IBASE
<a name="l01281"></a>01281         J=JBASE
<a name="l01282"></a>01282 <span class="comment">!DIR$ IVDEP</span>
<a name="l01283"></a>01283         <span class="keyword">DO</span> 310 IJK=1,LOT
<a name="l01284"></a>01284           C(JA+J)=A(IA+I)+A(IB+I)
<a name="l01285"></a>01285           C(JB+J)=(A(IA+I)-0.5*A(IB+I))-(SIN60*(B(IB+I)))
<a name="l01286"></a>01286           C(JC+J)=(A(IA+I)-0.5*A(IB+I))+(SIN60*(B(IB+I)))
<a name="l01287"></a>01287           I=I+INC3
<a name="l01288"></a>01288           J=J+INC4
<a name="l01289"></a>01289 310       CONTINUE
<a name="l01290"></a>01290         IBASE=IBASE+INC1
<a name="l01291"></a>01291         JBASE=JBASE+INC2
<a name="l01292"></a>01292 320     CONTINUE
<a name="l01293"></a>01293       IA=IA+IINK
<a name="l01294"></a>01294       IINK=2*IINK
<a name="l01295"></a>01295       IB=IB+IINK
<a name="l01296"></a>01296       IC=IC-IINK
<a name="l01297"></a>01297       JBASE=JBASE+JUMP
<a name="l01298"></a>01298       JUMP=2*JUMP+JINK
<a name="l01299"></a>01299       <span class="keyword">IF</span> (IA.EQ.IC) GO TO 360
<a name="l01300"></a>01300       <span class="keyword">DO</span> 350 K=LA,KSTOP,LA
<a name="l01301"></a>01301         KB=K+K
<a name="l01302"></a>01302         KC=KB+KB
<a name="l01303"></a>01303         C1=TRIGS(KB+1)
<a name="l01304"></a>01304         S1=TRIGS(KB+2)
<a name="l01305"></a>01305         C2=TRIGS(KC+1)
<a name="l01306"></a>01306         S2=TRIGS(KC+2)
<a name="l01307"></a>01307         IBASE=0
<a name="l01308"></a>01308         <span class="keyword">DO</span> 340 L=1,LA
<a name="l01309"></a>01309           I=IBASE
<a name="l01310"></a>01310           J=JBASE
<a name="l01311"></a>01311 <span class="comment">!DIR$ IVDEP</span>
<a name="l01312"></a>01312           <span class="keyword">DO</span> 330 IJK=1,LOT
<a name="l01313"></a>01313             C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I))
<a name="l01314"></a>01314             D(JA+J)=B(IA+I)+(B(IB+I)-B(IC+I))
<a name="l01315"></a>01315             C(JB+J)=C1*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+    &amp;
<a name="l01316"></a>01316              I)+B(IC+I))))   -S1*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))+(SIN60 &amp;
<a name="l01317"></a>01317              *(A(IB+I)-A(IC+I))))
<a name="l01318"></a>01318             D(JB+J)=S1*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+    &amp;
<a name="l01319"></a>01319              I)+B(IC+I))))   +C1*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))+(SIN60 &amp;
<a name="l01320"></a>01320              *(A(IB+I)-A(IC+I))))
<a name="l01321"></a>01321             C(JC+J)=C2*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+    &amp;
<a name="l01322"></a>01322              I)+B(IC+I))))   -S2*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))-(SIN60 &amp;
<a name="l01323"></a>01323              *(A(IB+I)-A(IC+I))))
<a name="l01324"></a>01324             D(JC+J)=S2*((A(IA+I)-0.5*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+    &amp;
<a name="l01325"></a>01325              I)+B(IC+I))))   +C2*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))-(SIN60 &amp;
<a name="l01326"></a>01326              *(A(IB+I)-A(IC+I))))
<a name="l01327"></a>01327             I=I+INC3
<a name="l01328"></a>01328             J=J+INC4
<a name="l01329"></a>01329 330         CONTINUE
<a name="l01330"></a>01330           IBASE=IBASE+INC1
<a name="l01331"></a>01331           JBASE=JBASE+INC2
<a name="l01332"></a>01332 340       CONTINUE
<a name="l01333"></a>01333         IA=IA+IINK
<a name="l01334"></a>01334         IB=IB+IINK
<a name="l01335"></a>01335         IC=IC-IINK
<a name="l01336"></a>01336         JBASE=JBASE+JUMP
<a name="l01337"></a>01337 350     CONTINUE
<a name="l01338"></a>01338       <span class="keyword">IF</span> (IA.GT.IC) GO TO 900
<a name="l01339"></a>01339 360   CONTINUE
<a name="l01340"></a>01340       IBASE=0
<a name="l01341"></a>01341       <span class="keyword">DO</span> 380 L=1,LA
<a name="l01342"></a>01342         I=IBASE
<a name="l01343"></a>01343         J=JBASE
<a name="l01344"></a>01344 <span class="comment">!DIR$ IVDEP</span>
<a name="l01345"></a>01345         <span class="keyword">DO</span> 370 IJK=1,LOT
<a name="l01346"></a>01346           C(JA+J)=A(IA+I)+A(IB+I)
<a name="l01347"></a>01347           C(JB+J)=(0.5*A(IA+I)-A(IB+I))-(SIN60*B(IA+I))
<a name="l01348"></a>01348           C(JC+J)=-(0.5*A(IA+I)-A(IB+I))-(SIN60*B(IA+I))
<a name="l01349"></a>01349           I=I+INC3
<a name="l01350"></a>01350           J=J+INC4
<a name="l01351"></a>01351 370       CONTINUE
<a name="l01352"></a>01352         IBASE=IBASE+INC1
<a name="l01353"></a>01353         JBASE=JBASE+INC2
<a name="l01354"></a>01354 380     CONTINUE
<a name="l01355"></a>01355       GO TO 900
<a name="l01356"></a>01356 <span class="comment">!</span>
<a name="l01357"></a>01357 390   CONTINUE
<a name="l01358"></a>01358       SSIN60=2.0*SIN60
<a name="l01359"></a>01359       <span class="keyword">DO</span> 394 L=1,LA
<a name="l01360"></a>01360         I=IBASE
<a name="l01361"></a>01361         J=JBASE
<a name="l01362"></a>01362 <span class="comment">!DIR$ IVDEP</span>
<a name="l01363"></a>01363         <span class="keyword">DO</span> 392 IJK=1,LOT
<a name="l01364"></a>01364           C(JA+J)=2.0*(A(IA+I)+A(IB+I))
<a name="l01365"></a>01365           C(JB+J)=(2.0*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I))
<a name="l01366"></a>01366           C(JC+J)=(2.0*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I))
<a name="l01367"></a>01367           I=I+INC3
<a name="l01368"></a>01368           J=J+INC4
<a name="l01369"></a>01369 392       CONTINUE
<a name="l01370"></a>01370         IBASE=IBASE+INC1
<a name="l01371"></a>01371         JBASE=JBASE+INC2
<a name="l01372"></a>01372 394     CONTINUE
<a name="l01373"></a>01373       GO TO 900
<a name="l01374"></a>01374 <span class="comment">!</span>
<a name="l01375"></a>01375 <span class="comment">!     CODING FOR FACTOR 4</span>
<a name="l01376"></a>01376 <span class="comment">!     -------------------</span>
<a name="l01377"></a>01377 400   CONTINUE
<a name="l01378"></a>01378       IA=1
<a name="l01379"></a>01379       IB=IA+(2*M-LA)*INC1
<a name="l01380"></a>01380       IC=IB+2*M*INC1
<a name="l01381"></a>01381       ID=IB
<a name="l01382"></a>01382       JA=1
<a name="l01383"></a>01383       JB=JA+JINK
<a name="l01384"></a>01384       JC=JB+JINK
<a name="l01385"></a>01385       JD=JC+JINK
<a name="l01386"></a>01386 <span class="comment">!</span>
<a name="l01387"></a>01387       <span class="keyword">IF</span> (LA.EQ.M) GO TO 490
<a name="l01388"></a>01388 <span class="comment">!</span>
<a name="l01389"></a>01389       <span class="keyword">DO</span> 420 L=1,LA
<a name="l01390"></a>01390         I=IBASE
<a name="l01391"></a>01391         J=JBASE
<a name="l01392"></a>01392 <span class="comment">!DIR$ IVDEP</span>
<a name="l01393"></a>01393         <span class="keyword">DO</span> 410 IJK=1,LOT
<a name="l01394"></a>01394           C(JA+J)=(A(IA+I)+A(IC+I))+A(IB+I)
<a name="l01395"></a>01395           C(JB+J)=(A(IA+I)-A(IC+I))-B(IB+I)
<a name="l01396"></a>01396           C(JC+J)=(A(IA+I)+A(IC+I))-A(IB+I)
<a name="l01397"></a>01397           C(JD+J)=(A(IA+I)-A(IC+I))+B(IB+I)
<a name="l01398"></a>01398           I=I+INC3
<a name="l01399"></a>01399           J=J+INC4
<a name="l01400"></a>01400 410       CONTINUE
<a name="l01401"></a>01401         IBASE=IBASE+INC1
<a name="l01402"></a>01402         JBASE=JBASE+INC2
<a name="l01403"></a>01403 420     CONTINUE
<a name="l01404"></a>01404       IA=IA+IINK
<a name="l01405"></a>01405       IINK=2*IINK
<a name="l01406"></a>01406       IB=IB+IINK
<a name="l01407"></a>01407       IC=IC-IINK
<a name="l01408"></a>01408       ID=ID-IINK
<a name="l01409"></a>01409       JBASE=JBASE+JUMP
<a name="l01410"></a>01410       JUMP=2*JUMP+JINK
<a name="l01411"></a>01411       <span class="keyword">IF</span> (IB.EQ.IC) GO TO 460
<a name="l01412"></a>01412       <span class="keyword">DO</span> 450 K=LA,KSTOP,LA
<a name="l01413"></a>01413         KB=K+K
<a name="l01414"></a>01414         KC=KB+KB
<a name="l01415"></a>01415         KD=KC+KB
<a name="l01416"></a>01416         C1=TRIGS(KB+1)
<a name="l01417"></a>01417         S1=TRIGS(KB+2)
<a name="l01418"></a>01418         C2=TRIGS(KC+1)
<a name="l01419"></a>01419         S2=TRIGS(KC+2)
<a name="l01420"></a>01420         C3=TRIGS(KD+1)
<a name="l01421"></a>01421         S3=TRIGS(KD+2)
<a name="l01422"></a>01422         IBASE=0
<a name="l01423"></a>01423         <span class="keyword">DO</span> 440 L=1,LA
<a name="l01424"></a>01424           I=IBASE
<a name="l01425"></a>01425           J=JBASE
<a name="l01426"></a>01426 <span class="comment">!DIR$ IVDEP</span>
<a name="l01427"></a>01427           <span class="keyword">DO</span> 430 IJK=1,LOT
<a name="l01428"></a>01428             C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))
<a name="l01429"></a>01429             D(JA+J)=(B(IA+I)-B(IC+I))+(B(IB+I)-B(ID+I))
<a name="l01430"></a>01430             C(JC+J)=C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) &amp;
<a name="l01431"></a>01431                    -S2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I)))
<a name="l01432"></a>01432             D(JC+J)=S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) &amp;
<a name="l01433"></a>01433                    +C2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I)))
<a name="l01434"></a>01434             C(JB+J)=C1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) &amp;
<a name="l01435"></a>01435                    -S1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I)))
<a name="l01436"></a>01436             D(JB+J)=S1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) &amp;
<a name="l01437"></a>01437                    +C1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I)))
<a name="l01438"></a>01438             C(JD+J)=C3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) &amp;
<a name="l01439"></a>01439                    -S3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I)))
<a name="l01440"></a>01440             D(JD+J)=S3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) &amp;
<a name="l01441"></a>01441                    +C3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I)))
<a name="l01442"></a>01442             I=I+INC3
<a name="l01443"></a>01443             J=J+INC4
<a name="l01444"></a>01444 430         CONTINUE
<a name="l01445"></a>01445           IBASE=IBASE+INC1
<a name="l01446"></a>01446           JBASE=JBASE+INC2
<a name="l01447"></a>01447 440       CONTINUE
<a name="l01448"></a>01448         IA=IA+IINK
<a name="l01449"></a>01449         IB=IB+IINK
<a name="l01450"></a>01450         IC=IC-IINK
<a name="l01451"></a>01451         ID=ID-IINK
<a name="l01452"></a>01452         JBASE=JBASE+JUMP
<a name="l01453"></a>01453 450     CONTINUE
<a name="l01454"></a>01454       <span class="keyword">IF</span> (IB.GT.IC) GO TO 900
<a name="l01455"></a>01455 460   CONTINUE
<a name="l01456"></a>01456       IBASE=0
<a name="l01457"></a>01457       SIN45=SQRT(0.5)
<a name="l01458"></a>01458       <span class="keyword">DO</span> 480 L=1,LA
<a name="l01459"></a>01459         I=IBASE
<a name="l01460"></a>01460         J=JBASE
<a name="l01461"></a>01461 <span class="comment">!DIR$ IVDEP</span>
<a name="l01462"></a>01462         <span class="keyword">DO</span> 470 IJK=1,LOT
<a name="l01463"></a>01463           C(JA+J)=A(IA+I)+A(IB+I)
<a name="l01464"></a>01464           C(JB+J)=SIN45*((A(IA+I)-A(IB+I))-(B(IA+I)+B(IB+I)))
<a name="l01465"></a>01465           C(JC+J)=B(IB+I)-B(IA+I)
<a name="l01466"></a>01466           C(JD+J)=-SIN45*((A(IA+I)-A(IB+I))+(B(IA+I)+B(IB+I)))
<a name="l01467"></a>01467           I=I+INC3
<a name="l01468"></a>01468           J=J+INC4
<a name="l01469"></a>01469 470       CONTINUE
<a name="l01470"></a>01470         IBASE=IBASE+INC1
<a name="l01471"></a>01471         JBASE=JBASE+INC2
<a name="l01472"></a>01472 480     CONTINUE
<a name="l01473"></a>01473       GO TO 900
<a name="l01474"></a>01474 <span class="comment">!</span>
<a name="l01475"></a>01475 490   CONTINUE
<a name="l01476"></a>01476       <span class="keyword">DO</span> 494 L=1,LA
<a name="l01477"></a>01477         I=IBASE
<a name="l01478"></a>01478         J=JBASE
<a name="l01479"></a>01479 <span class="comment">!DIR$ IVDEP</span>
<a name="l01480"></a>01480         <span class="keyword">DO</span> 492 IJK=1,LOT
<a name="l01481"></a>01481           C(JA+J)=2.0*((A(IA+I)+A(IC+I))+A(IB+I))
<a name="l01482"></a>01482           C(JB+J)=2.0*((A(IA+I)-A(IC+I))-B(IB+I))
<a name="l01483"></a>01483           C(JC+J)=2.0*((A(IA+I)+A(IC+I))-A(IB+I))
<a name="l01484"></a>01484           C(JD+J)=2.0*((A(IA+I)-A(IC+I))+B(IB+I))
<a name="l01485"></a>01485           I=I+INC3
<a name="l01486"></a>01486           J=J+INC4
<a name="l01487"></a>01487 492       CONTINUE
<a name="l01488"></a>01488         IBASE=IBASE+INC1
<a name="l01489"></a>01489         JBASE=JBASE+INC2
<a name="l01490"></a>01490 494     CONTINUE
<a name="l01491"></a>01491       GO TO 900
<a name="l01492"></a>01492 <span class="comment">!</span>
<a name="l01493"></a>01493 <span class="comment">!     CODING FOR FACTOR 5</span>
<a name="l01494"></a>01494 <span class="comment">!     -------------------</span>
<a name="l01495"></a>01495 500   CONTINUE
<a name="l01496"></a>01496       IA=1
<a name="l01497"></a>01497       IB=IA+(2*M-LA)*INC1
<a name="l01498"></a>01498       IC=IB+2*M*INC1
<a name="l01499"></a>01499       ID=IC
<a name="l01500"></a>01500       IE=IB
<a name="l01501"></a>01501       JA=1
<a name="l01502"></a>01502       JB=JA+JINK
<a name="l01503"></a>01503       JC=JB+JINK
<a name="l01504"></a>01504       JD=JC+JINK
<a name="l01505"></a>01505       JE=JD+JINK
<a name="l01506"></a>01506 <span class="comment">!</span>
<a name="l01507"></a>01507       <span class="keyword">IF</span> (LA.EQ.M) GO TO 590
<a name="l01508"></a>01508 <span class="comment">!</span>
<a name="l01509"></a>01509       <span class="keyword">DO</span> 520 L=1,LA
<a name="l01510"></a>01510         I=IBASE
<a name="l01511"></a>01511         J=JBASE
<a name="l01512"></a>01512 <span class="comment">!DIR$ IVDEP</span>
<a name="l01513"></a>01513         <span class="keyword">DO</span> 510 IJK=1,LOT
<a name="l01514"></a>01514           C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I))
<a name="l01515"></a>01515           C(JB+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))+QRT5*(A(IB+I)-A(IC+I &amp;
<a name="l01516"></a>01516            )))     -(SIN72*B(IB+I)+SIN36*B(IC+I))
<a name="l01517"></a>01517           C(JC+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))-QRT5*(A(IB+I)-A(IC+I &amp;
<a name="l01518"></a>01518            )))     -(SIN36*B(IB+I)-SIN72*B(IC+I))
<a name="l01519"></a>01519           C(JD+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))-QRT5*(A(IB+I)-A(IC+I &amp;
<a name="l01520"></a>01520            )))     +(SIN36*B(IB+I)-SIN72*B(IC+I))
<a name="l01521"></a>01521           C(JE+J)=((A(IA+I)-0.25*(A(IB+I)+A(IC+I)))+QRT5*(A(IB+I)-A(IC+I &amp;
<a name="l01522"></a>01522            )))     +(SIN72*B(IB+I)+SIN36*B(IC+I))
<a name="l01523"></a>01523           I=I+INC3
<a name="l01524"></a>01524           J=J+INC4
<a name="l01525"></a>01525 510       CONTINUE
<a name="l01526"></a>01526         IBASE=IBASE+INC1
<a name="l01527"></a>01527         JBASE=JBASE+INC2
<a name="l01528"></a>01528 520     CONTINUE
<a name="l01529"></a>01529       IA=IA+IINK
<a name="l01530"></a>01530       IINK=2*IINK
<a name="l01531"></a>01531       IB=IB+IINK
<a name="l01532"></a>01532       IC=IC+IINK
<a name="l01533"></a>01533       ID=ID-IINK
<a name="l01534"></a>01534       IE=IE-IINK
<a name="l01535"></a>01535       JBASE=JBASE+JUMP
<a name="l01536"></a>01536       JUMP=2*JUMP+JINK
<a name="l01537"></a>01537       <span class="keyword">IF</span> (IB.EQ.ID) GO TO 560
<a name="l01538"></a>01538       <span class="keyword">DO</span> 550 K=LA,KSTOP,LA
<a name="l01539"></a>01539         KB=K+K
<a name="l01540"></a>01540         KC=KB+KB
<a name="l01541"></a>01541         KD=KC+KB
<a name="l01542"></a>01542         KE=KD+KB
<a name="l01543"></a>01543         C1=TRIGS(KB+1)
<a name="l01544"></a>01544         S1=TRIGS(KB+2)
<a name="l01545"></a>01545         C2=TRIGS(KC+1)
<a name="l01546"></a>01546         S2=TRIGS(KC+2)
<a name="l01547"></a>01547         C3=TRIGS(KD+1)
<a name="l01548"></a>01548         S3=TRIGS(KD+2)
<a name="l01549"></a>01549         C4=TRIGS(KE+1)
<a name="l01550"></a>01550         S4=TRIGS(KE+2)
<a name="l01551"></a>01551         IBASE=0
<a name="l01552"></a>01552         <span class="keyword">DO</span> 540 L=1,LA
<a name="l01553"></a>01553           I=IBASE
<a name="l01554"></a>01554           J=JBASE
<a name="l01555"></a>01555 <span class="comment">!DIR$ IVDEP</span>
<a name="l01556"></a>01556           <span class="keyword">DO</span> 530 IJK=1,LOT
<a name="l01557"></a>01557 <span class="comment">!</span>
<a name="l01558"></a>01558             A10(IJK)=(A(IA+I)-0.25*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I))) &amp;
<a name="l01559"></a>01559              )         +QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I)))
<a name="l01560"></a>01560             A20(IJK)=(A(IA+I)-0.25*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I))) &amp;
<a name="l01561"></a>01561              )         -QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I)))
<a name="l01562"></a>01562             B10(IJK)=(B(IA+I)-0.25*((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I))) &amp;
<a name="l01563"></a>01563              )         +QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I)))
<a name="l01564"></a>01564             B20(IJK)=(B(IA+I)-0.25*((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I))) &amp;
<a name="l01565"></a>01565              )         -QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I)))
<a name="l01566"></a>01566             A11(IJK)=SIN72*(B(IB+I)+B(IE+I))+SIN36*(B(IC+I)+B(ID+I))
<a name="l01567"></a>01567             A21(IJK)=SIN36*(B(IB+I)+B(IE+I))-SIN72*(B(IC+I)+B(ID+I))
<a name="l01568"></a>01568             B11(IJK)=SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I))
<a name="l01569"></a>01569             B21(IJK)=SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I))
<a name="l01570"></a>01570 <span class="comment">!</span>
<a name="l01571"></a>01571             C(JA+J)=A(IA+I)+((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)))
<a name="l01572"></a>01572             D(JA+J)=B(IA+I)+((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I)))
<a name="l01573"></a>01573             C(JB+J)=C1*(A10(IJK)-A11(IJK))-S1*(B10(IJK)+B11(IJK))
<a name="l01574"></a>01574             D(JB+J)=S1*(A10(IJK)-A11(IJK))+C1*(B10(IJK)+B11(IJK))
<a name="l01575"></a>01575             C(JE+J)=C4*(A10(IJK)+A11(IJK))-S4*(B10(IJK)-B11(IJK))
<a name="l01576"></a>01576             D(JE+J)=S4*(A10(IJK)+A11(IJK))+C4*(B10(IJK)-B11(IJK))
<a name="l01577"></a>01577             C(JC+J)=C2*(A20(IJK)-A21(IJK))-S2*(B20(IJK)+B21(IJK))
<a name="l01578"></a>01578             D(JC+J)=S2*(A20(IJK)-A21(IJK))+C2*(B20(IJK)+B21(IJK))
<a name="l01579"></a>01579             C(JD+J)=C3*(A20(IJK)+A21(IJK))-S3*(B20(IJK)-B21(IJK))
<a name="l01580"></a>01580             D(JD+J)=S3*(A20(IJK)+A21(IJK))+C3*(B20(IJK)-B21(IJK))
<a name="l01581"></a>01581 <span class="comment">!</span>
<a name="l01582"></a>01582             I=I+INC3
<a name="l01583"></a>01583             J=J+INC4
<a name="l01584"></a>01584 530         CONTINUE
<a name="l01585"></a>01585           IBASE=IBASE+INC1
<a name="l01586"></a>01586           JBASE=JBASE+INC2
<a name="l01587"></a>01587 540       CONTINUE
<a name="l01588"></a>01588         IA=IA+IINK
<a name="l01589"></a>01589         IB=IB+IINK
<a name="l01590"></a>01590         IC=IC+IINK
<a name="l01591"></a>01591         ID=ID-IINK
<a name="l01592"></a>01592         IE=IE-IINK
<a name="l01593"></a>01593         JBASE=JBASE+JUMP
<a name="l01594"></a>01594 550     CONTINUE
<a name="l01595"></a>01595       <span class="keyword">IF</span> (IB.GT.ID) GO TO 900
<a name="l01596"></a>01596 560   CONTINUE
<a name="l01597"></a>01597       IBASE=0
<a name="l01598"></a>01598       <span class="keyword">DO</span> 580 L=1,LA
<a name="l01599"></a>01599         I=IBASE
<a name="l01600"></a>01600         J=JBASE
<a name="l01601"></a>01601 <span class="comment">!DIR$ IVDEP</span>
<a name="l01602"></a>01602         <span class="keyword">DO</span> 570 IJK=1,LOT
<a name="l01603"></a>01603           C(JA+J)=(A(IA+I)+A(IB+I))+A(IC+I)
<a name="l01604"></a>01604           C(JB+J)=(QRT5*(A(IA+I)-A(IB+I))+(0.25*(A(IA+I)+A(IB+I))-A(IC+I &amp;
<a name="l01605"></a>01605            )))     -(SIN36*B(IA+I)+SIN72*B(IB+I))
<a name="l01606"></a>01606           C(JE+J)=-(QRT5*(A(IA+I)-A(IB+I))+(0.25*(A(IA+I)+A(IB+I))-A(IC+ &amp;
<a name="l01607"></a>01607            I)))    -(SIN36*B(IA+I)+SIN72*B(IB+I))
<a name="l01608"></a>01608           C(JC+J)=(QRT5*(A(IA+I)-A(IB+I))-(0.25*(A(IA+I)+A(IB+I))-A(IC+I &amp;
<a name="l01609"></a>01609            )))     -(SIN72*B(IA+I)-SIN36*B(IB+I))
<a name="l01610"></a>01610           C(JD+J)=-(QRT5*(A(IA+I)-A(IB+I))-(0.25*(A(IA+I)+A(IB+I))-A(IC+ &amp;
<a name="l01611"></a>01611            I)))    -(SIN72*B(IA+I)-SIN36*B(IB+I))
<a name="l01612"></a>01612           I=I+INC3
<a name="l01613"></a>01613           J=J+INC4
<a name="l01614"></a>01614 570       CONTINUE
<a name="l01615"></a>01615         IBASE=IBASE+INC1
<a name="l01616"></a>01616         JBASE=JBASE+INC2
<a name="l01617"></a>01617 580     CONTINUE
<a name="l01618"></a>01618       GO TO 900
<a name="l01619"></a>01619 <span class="comment">!</span>
<a name="l01620"></a>01620 590   CONTINUE
<a name="l01621"></a>01621       QQRT5=2.0*QRT5
<a name="l01622"></a>01622       SSIN36=2.0*SIN36
<a name="l01623"></a>01623       SSIN72=2.0*SIN72
<a name="l01624"></a>01624       <span class="keyword">DO</span> 594 L=1,LA
<a name="l01625"></a>01625         I=IBASE
<a name="l01626"></a>01626         J=JBASE
<a name="l01627"></a>01627 <span class="comment">!DIR$ IVDEP</span>
<a name="l01628"></a>01628         <span class="keyword">DO</span> 592 IJK=1,LOT
<a name="l01629"></a>01629           C(JA+J)=2.0*(A(IA+I)+(A(IB+I)+A(IC+I)))
<a name="l01630"></a>01630           C(JB+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) &amp;
<a name="l01631"></a>01631                  +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+SSIN36*B(IC+I))
<a name="l01632"></a>01632           C(JC+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) &amp;
<a name="l01633"></a>01633                  -QQRT5*(A(IB+I)-A(IC+I)))-(SSIN36*B(IB+I)-SSIN72*B(IC+I))
<a name="l01634"></a>01634           C(JD+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) &amp;
<a name="l01635"></a>01635                  -QQRT5*(A(IB+I)-A(IC+I)))+(SSIN36*B(IB+I)-SSIN72*B(IC+I))
<a name="l01636"></a>01636           C(JE+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) &amp;
<a name="l01637"></a>01637                  +QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+SSIN36*B(IC+I))
<a name="l01638"></a>01638           I=I+INC3
<a name="l01639"></a>01639           J=J+INC4
<a name="l01640"></a>01640 592       CONTINUE
<a name="l01641"></a>01641         IBASE=IBASE+INC1
<a name="l01642"></a>01642         JBASE=JBASE+INC2
<a name="l01643"></a>01643 594     CONTINUE
<a name="l01644"></a>01644       GO TO 900
<a name="l01645"></a>01645 <span class="comment">!</span>
<a name="l01646"></a>01646 <span class="comment">!     CODING FOR FACTOR 6</span>
<a name="l01647"></a>01647 <span class="comment">!     -------------------</span>
<a name="l01648"></a>01648 600   CONTINUE
<a name="l01649"></a>01649       IA=1
<a name="l01650"></a>01650       IB=IA+(2*M-LA)*INC1
<a name="l01651"></a>01651       IC=IB+2*M*INC1
<a name="l01652"></a>01652       ID=IC+2*M*INC1
<a name="l01653"></a>01653       IE=IC
<a name="l01654"></a>01654       IF=IB
<a name="l01655"></a>01655       JA=1
<a name="l01656"></a>01656       JB=JA+JINK
<a name="l01657"></a>01657       JC=JB+JINK
<a name="l01658"></a>01658       JD=JC+JINK
<a name="l01659"></a>01659       JE=JD+JINK
<a name="l01660"></a>01660       JF=JE+JINK
<a name="l01661"></a>01661 <span class="comment">!</span>
<a name="l01662"></a>01662       <span class="keyword">IF</span> (LA.EQ.M) GO TO 690
<a name="l01663"></a>01663 <span class="comment">!</span>
<a name="l01664"></a>01664       <span class="keyword">DO</span> 620 L=1,LA
<a name="l01665"></a>01665         I=IBASE
<a name="l01666"></a>01666         J=JBASE
<a name="l01667"></a>01667 <span class="comment">!DIR$ IVDEP</span>
<a name="l01668"></a>01668         <span class="keyword">DO</span> 610 IJK=1,LOT
<a name="l01669"></a>01669           C(JA+J)=(A(IA+I)+A(ID+I))+(A(IB+I)+A(IC+I))
<a name="l01670"></a>01670           C(JD+J)=(A(IA+I)-A(ID+I))-(A(IB+I)-A(IC+I))
<a name="l01671"></a>01671           C(JB+J)=((A(IA+I)-A(ID+I))+0.5*(A(IB+I)-A(IC+I))) &amp;
<a name="l01672"></a>01672                    -(SIN60*(B(IB+I)+B(IC+I)))
<a name="l01673"></a>01673           C(JF+J)=((A(IA+I)-A(ID+I))+0.5*(A(IB+I)-A(IC+I))) &amp;
<a name="l01674"></a>01674                    +(SIN60*(B(IB+I)+B(IC+I)))
<a name="l01675"></a>01675           C(JC+J)=((A(IA+I)+A(ID+I))-0.5*(A(IB+I)+A(IC+I))) &amp;
<a name="l01676"></a>01676                    -(SIN60*(B(IB+I)-B(IC+I)))
<a name="l01677"></a>01677           C(JE+J)=((A(IA+I)+A(ID+I))-0.5*(A(IB+I)+A(IC+I))) &amp;
<a name="l01678"></a>01678                    +(SIN60*(B(IB+I)-B(IC+I)))
<a name="l01679"></a>01679           I=I+INC3
<a name="l01680"></a>01680           J=J+INC4
<a name="l01681"></a>01681 610       CONTINUE
<a name="l01682"></a>01682         IBASE=IBASE+INC1
<a name="l01683"></a>01683         JBASE=JBASE+INC2
<a name="l01684"></a>01684 620     CONTINUE
<a name="l01685"></a>01685       IA=IA+IINK
<a name="l01686"></a>01686       IINK=2*IINK
<a name="l01687"></a>01687       IB=IB+IINK
<a name="l01688"></a>01688       IC=IC+IINK
<a name="l01689"></a>01689       ID=ID-IINK
<a name="l01690"></a>01690       IE=IE-IINK
<a name="l01691"></a>01691       IF=IF-IINK
<a name="l01692"></a>01692       JBASE=JBASE+JUMP
<a name="l01693"></a>01693       JUMP=2*JUMP+JINK
<a name="l01694"></a>01694       <span class="keyword">IF</span> (IC.EQ.ID) GO TO 660
<a name="l01695"></a>01695       <span class="keyword">DO</span> 650 K=LA,KSTOP,LA
<a name="l01696"></a>01696         KB=K+K
<a name="l01697"></a>01697         KC=KB+KB
<a name="l01698"></a>01698         KD=KC+KB
<a name="l01699"></a>01699         KE=KD+KB
<a name="l01700"></a>01700         KF=KE+KB
<a name="l01701"></a>01701         C1=TRIGS(KB+1)
<a name="l01702"></a>01702         S1=TRIGS(KB+2)
<a name="l01703"></a>01703         C2=TRIGS(KC+1)
<a name="l01704"></a>01704         S2=TRIGS(KC+2)
<a name="l01705"></a>01705         C3=TRIGS(KD+1)
<a name="l01706"></a>01706         S3=TRIGS(KD+2)
<a name="l01707"></a>01707         C4=TRIGS(KE+1)
<a name="l01708"></a>01708         S4=TRIGS(KE+2)
<a name="l01709"></a>01709         C5=TRIGS(KF+1)
<a name="l01710"></a>01710         S5=TRIGS(KF+2)
<a name="l01711"></a>01711         IBASE=0
<a name="l01712"></a>01712         <span class="keyword">DO</span> 640 L=1,LA
<a name="l01713"></a>01713           I=IBASE
<a name="l01714"></a>01714           J=JBASE
<a name="l01715"></a>01715 <span class="comment">!DIR$ IVDEP</span>
<a name="l01716"></a>01716           <span class="keyword">DO</span> 630 IJK=1,LOT
<a name="l01717"></a>01717 <span class="comment">!</span>
<a name="l01718"></a>01718             A11(IJK)= (A(IE+I)+A(IB+I))+(A(IC+I)+A(IF+I))
<a name="l01719"></a>01719             A20(IJK)=(A(IA+I)+A(ID+I))-0.5*A11(IJK)
<a name="l01720"></a>01720             A21(IJK)=SIN60*((A(IE+I)+A(IB+I))-(A(IC+I)+A(IF+I)))
<a name="l01721"></a>01721             B11(IJK)= (B(IB+I)-B(IE+I))+(B(IC+I)-B(IF+I))
<a name="l01722"></a>01722             B20(IJK)=(B(IA+I)-B(ID+I))-0.5*B11(IJK)
<a name="l01723"></a>01723             B21(IJK)=SIN60*((B(IB+I)-B(IE+I))-(B(IC+I)-B(IF+I)))
<a name="l01724"></a>01724 <span class="comment">!</span>
<a name="l01725"></a>01725             C(JA+J)=(A(IA+I)+A(ID+I))+A11(IJK)
<a name="l01726"></a>01726             D(JA+J)=(B(IA+I)-B(ID+I))+B11(IJK)
<a name="l01727"></a>01727             C(JC+J)=C2*(A20(IJK)-B21(IJK))-S2*(B20(IJK)+A21(IJK))
<a name="l01728"></a>01728             D(JC+J)=S2*(A20(IJK)-B21(IJK))+C2*(B20(IJK)+A21(IJK))
<a name="l01729"></a>01729             C(JE+J)=C4*(A20(IJK)+B21(IJK))-S4*(B20(IJK)-A21(IJK))
<a name="l01730"></a>01730             D(JE+J)=S4*(A20(IJK)+B21(IJK))+C4*(B20(IJK)-A21(IJK))
<a name="l01731"></a>01731 <span class="comment">!</span>
<a name="l01732"></a>01732             A11(IJK)=(A(IE+I)-A(IB+I))+(A(IC+I)-A(IF+I))
<a name="l01733"></a>01733             B11(IJK)=(B(IE+I)+B(IB+I))-(B(IC+I)+B(IF+I))
<a name="l01734"></a>01734             A20(IJK)=(A(IA+I)-A(ID+I))-0.5*A11(IJK)
<a name="l01735"></a>01735             A21(IJK)=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I)))
<a name="l01736"></a>01736             B20(IJK)=(B(IA+I)+B(ID+I))+0.5*B11(IJK)
<a name="l01737"></a>01737             B21(IJK)=SIN60*((B(IE+I)+B(IB+I))+(B(IC+I)+B(IF+I)))
<a name="l01738"></a>01738 <span class="comment">!</span>
<a name="l01739"></a>01739             C(JD+J)=C3*((A(IA+I)-A(ID+I))+A11(IJK))-S3*((B(IA+I)+B(ID+I &amp;
<a name="l01740"></a>01740              ))-B11(IJK))
<a name="l01741"></a>01741             D(JD+J)=S3*((A(IA+I)-A(ID+I))+A11(IJK))+C3*((B(IA+I)+B(ID+I &amp;
<a name="l01742"></a>01742              ))-B11(IJK))
<a name="l01743"></a>01743             C(JB+J)=C1*(A20(IJK)-B21(IJK))-S1*(B20(IJK)-A21(IJK))
<a name="l01744"></a>01744             D(JB+J)=S1*(A20(IJK)-B21(IJK))+C1*(B20(IJK)-A21(IJK))
<a name="l01745"></a>01745             C(JF+J)=C5*(A20(IJK)+B21(IJK))-S5*(B20(IJK)+A21(IJK))
<a name="l01746"></a>01746             D(JF+J)=S5*(A20(IJK)+B21(IJK))+C5*(B20(IJK)+A21(IJK))
<a name="l01747"></a>01747 <span class="comment">!</span>
<a name="l01748"></a>01748             I=I+INC3
<a name="l01749"></a>01749             J=J+INC4
<a name="l01750"></a>01750 630         CONTINUE
<a name="l01751"></a>01751           IBASE=IBASE+INC1
<a name="l01752"></a>01752           JBASE=JBASE+INC2
<a name="l01753"></a>01753 640       CONTINUE
<a name="l01754"></a>01754         IA=IA+IINK
<a name="l01755"></a>01755         IB=IB+IINK
<a name="l01756"></a>01756         IC=IC+IINK
<a name="l01757"></a>01757         ID=ID-IINK
<a name="l01758"></a>01758         IE=IE-IINK
<a name="l01759"></a>01759         IF=IF-IINK
<a name="l01760"></a>01760         JBASE=JBASE+JUMP
<a name="l01761"></a>01761 650     CONTINUE
<a name="l01762"></a>01762       <span class="keyword">IF</span> (IC.GT.ID) GO TO 900
<a name="l01763"></a>01763 660   CONTINUE
<a name="l01764"></a>01764       IBASE=0
<a name="l01765"></a>01765       <span class="keyword">DO</span> 680 L=1,LA
<a name="l01766"></a>01766         I=IBASE
<a name="l01767"></a>01767         J=JBASE
<a name="l01768"></a>01768 <span class="comment">!DIR$ IVDEP</span>
<a name="l01769"></a>01769         <span class="keyword">DO</span> 670 IJK=1,LOT
<a name="l01770"></a>01770           C(JA+J)=A(IB+I)+(A(IA+I)+A(IC+I))
<a name="l01771"></a>01771           C(JD+J)=B(IB+I)-(B(IA+I)+B(IC+I))
<a name="l01772"></a>01772           C(JB+J)=(SIN60*(A(IA+I)-A(IC+I)))-(0.5*(B(IA+I)+B(IC+I))+B(IB+I))
<a name="l01773"></a>01773           C(JF+J)=-(SIN60*(A(IA+I)-A(IC+I)))-(0.5*(B(IA+I)+B(IC+I))+B(IB+I))
<a name="l01774"></a>01774           C(JC+J)=SIN60*(B(IC+I)-B(IA+I))+(0.5*(A(IA+I)+A(IC+I))-A(IB+I))
<a name="l01775"></a>01775           C(JE+J)=SIN60*(B(IC+I)-B(IA+I))-(0.5*(A(IA+I)+A(IC+I))-A(IB+I))
<a name="l01776"></a>01776           I=I+INC3
<a name="l01777"></a>01777           J=J+INC4
<a name="l01778"></a>01778 670       CONTINUE
<a name="l01779"></a>01779         IBASE=IBASE+INC1
<a name="l01780"></a>01780         JBASE=JBASE+INC2
<a name="l01781"></a>01781 680     CONTINUE
<a name="l01782"></a>01782       GO TO 900
<a name="l01783"></a>01783 <span class="comment">!</span>
<a name="l01784"></a>01784 690   CONTINUE
<a name="l01785"></a>01785       SSIN60=2.0*SIN60
<a name="l01786"></a>01786       <span class="keyword">DO</span> 694 L=1,LA
<a name="l01787"></a>01787         I=IBASE
<a name="l01788"></a>01788         J=JBASE
<a name="l01789"></a>01789 <span class="comment">!DIR$ IVDEP</span>
<a name="l01790"></a>01790         <span class="keyword">DO</span> 692 IJK=1,LOT
<a name="l01791"></a>01791           C(JA+J)=(2.0*(A(IA+I)+A(ID+I)))+(2.0*(A(IB+I)+A(IC+I)))
<a name="l01792"></a>01792           C(JD+J)=(2.0*(A(IA+I)-A(ID+I)))-(2.0*(A(IB+I)-A(IC+I)))
<a name="l01793"></a>01793           C(JB+J)=(2.0*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) &amp;
<a name="l01794"></a>01794                    -(SSIN60*(B(IB+I)+B(IC+I)))
<a name="l01795"></a>01795           C(JF+J)=(2.0*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) &amp;
<a name="l01796"></a>01796                    +(SSIN60*(B(IB+I)+B(IC+I)))
<a name="l01797"></a>01797           C(JC+J)=(2.0*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) &amp;
<a name="l01798"></a>01798                    -(SSIN60*(B(IB+I)-B(IC+I)))
<a name="l01799"></a>01799           C(JE+J)=(2.0*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) &amp;
<a name="l01800"></a>01800                    +(SSIN60*(B(IB+I)-B(IC+I)))
<a name="l01801"></a>01801           I=I+INC3
<a name="l01802"></a>01802           J=J+INC4
<a name="l01803"></a>01803 692       CONTINUE
<a name="l01804"></a>01804         IBASE=IBASE+INC1
<a name="l01805"></a>01805         JBASE=JBASE+INC2
<a name="l01806"></a>01806 694     CONTINUE
<a name="l01807"></a>01807       GO TO 900
<a name="l01808"></a>01808 <span class="comment">!</span>
<a name="l01809"></a>01809 <span class="comment">!     CODING FOR FACTOR 8</span>
<a name="l01810"></a>01810 <span class="comment">!     -------------------</span>
<a name="l01811"></a>01811 800   CONTINUE
<a name="l01812"></a>01812       IBAD=3
<a name="l01813"></a>01813       <span class="keyword">IF</span> (LA.NE.M) GO TO 910
<a name="l01814"></a>01814       IA=1
<a name="l01815"></a>01815       IB=IA+LA*INC1
<a name="l01816"></a>01816       IC=IB+2*LA*INC1
<a name="l01817"></a>01817       ID=IC+2*LA*INC1
<a name="l01818"></a>01818       IE=ID+2*LA*INC1
<a name="l01819"></a>01819       JA=1
<a name="l01820"></a>01820       JB=JA+JINK
<a name="l01821"></a>01821       JC=JB+JINK
<a name="l01822"></a>01822       JD=JC+JINK
<a name="l01823"></a>01823       JE=JD+JINK
<a name="l01824"></a>01824       JF=JE+JINK
<a name="l01825"></a>01825       JG=JF+JINK
<a name="l01826"></a>01826       JH=JG+JINK
<a name="l01827"></a>01827       SSIN45=SQRT(2.0)
<a name="l01828"></a>01828 <span class="comment">!</span>
<a name="l01829"></a>01829       <span class="keyword">DO</span> 820 L=1,LA
<a name="l01830"></a>01830         I=IBASE
<a name="l01831"></a>01831         J=JBASE
<a name="l01832"></a>01832 <span class="comment">!DIR$ IVDEP</span>
<a name="l01833"></a>01833         <span class="keyword">DO</span> 810 IJK=1,LOT
<a name="l01834"></a>01834           C(JA+J)=2.0*(((A(IA+I)+A(IE+I))+A(IC+I))+(A(IB+I)+A(ID+I)))
<a name="l01835"></a>01835           C(JE+J)=2.0*(((A(IA+I)+A(IE+I))+A(IC+I))-(A(IB+I)+A(ID+I)))
<a name="l01836"></a>01836           C(JC+J)=2.0*(((A(IA+I)+A(IE+I))-A(IC+I))-(B(IB+I)-B(ID+I)))
<a name="l01837"></a>01837           C(JG+J)=2.0*(((A(IA+I)+A(IE+I))-A(IC+I))+(B(IB+I)-B(ID+I)))
<a name="l01838"></a>01838           C(JB+J)=2.0*((A(IA+I)-A(IE+I))-B(IC+I)) &amp;
<a name="l01839"></a>01839                    +SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I)))
<a name="l01840"></a>01840           C(JF+J)=2.0*((A(IA+I)-A(IE+I))-B(IC+I)) &amp;
<a name="l01841"></a>01841                    -SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I)))
<a name="l01842"></a>01842           C(JD+J)=2.0*((A(IA+I)-A(IE+I))+B(IC+I)) &amp;
<a name="l01843"></a>01843                    -SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I)))
<a name="l01844"></a>01844           C(JH+J)=2.0*((A(IA+I)-A(IE+I))+B(IC+I)) &amp;
<a name="l01845"></a>01845                    +SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I)))
<a name="l01846"></a>01846           I=I+INC3
<a name="l01847"></a>01847           J=J+INC4
<a name="l01848"></a>01848 810       CONTINUE
<a name="l01849"></a>01849         IBASE=IBASE+INC1
<a name="l01850"></a>01850         JBASE=JBASE+INC2
<a name="l01851"></a>01851 820     CONTINUE
<a name="l01852"></a>01852 <span class="comment">!</span>
<a name="l01853"></a>01853 <span class="comment">!     RETURN</span>
<a name="l01854"></a>01854 <span class="comment">!     ------</span>
<a name="l01855"></a>01855 900   CONTINUE
<a name="l01856"></a>01856       IBAD=0
<a name="l01857"></a>01857 910   CONTINUE
<a name="l01858"></a>01858       IERR=IBAD
<a name="l01859"></a>01859       RETURN
<a name="l01860"></a>01860 <span class="keyword">      END</span>
<a name="l01861"></a>01861 
<a name="l01862"></a>01862 
</pre></div></div>
</div>
  <div id="nav-path" class="navpath">
    <ul>
      <li class="navelem"><a class="el" href="fft991mod_8f90.html">fft991mod.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>