Scrambler  1
nr_fourn.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    nr_fourn.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00023 !=======================================================================
00024 !
00025 ! SUBROUTINE: nr_fourn.f90
00026 !
00027 ! PURPOSE   : n-dimensional fast fourier transformation
00028 ! SOURCE    : Numerical Recipes for C, Press et al. 1992
00029 !
00030 ! INPUT     : ndim : number of dimensions
00031 !             nn   : integer array of length ndim containing length of each
00032 !                    dimension. Must be power of 2.
00033 !             isign: +1: x is replaced by forward transform
00034 !                    -1: x is replaced by inverse transform multiplied by
00035 !                        lengths of dimensions
00036 !             x    : array to be transformed. Real array of length twice
00037 !                    the product of all dimension lengths. Real and 
00038 !                    imaginary part are stored consecutively, i.e.
00039 !                    real(x(k)) = x(2k-1), imag(x(k)) = x(2k), k = 1...n.
00040 !
00041 ! OUTPUT    : x    : array with transform. 
00042 !
00043 !=======================================================================
00044 !
00045 
00046 subroutine nr_fourn (nn,ndim,isign,x)
00047 
00048   implicit none
00049 
00050   integer isign  , ndim   , 
00051           i1     , i2     , i2rev  , i3     , i3rev  , ibit   , 
00052           idim   , ifp1   , ifp2   , ip1    , ip2    , ip3    , 
00053           k1     , k2     , n      , nprev  , nrem   , ntot
00054 
00055   integer nn(1:ndim)
00056 
00057   double precision tempi  , tempr  , theta  , wi     , wpi    , wpr    , 
00058                    wr     , wtemp
00059 
00060   double precision x(*)
00061 
00062 !----------------------------------------------------------
00063 
00064       ntot=1
00065       do idim=1,ndim
00066         ntot=ntot*nn(idim)
00067       end do
00068       nprev=1
00069       do idim=1,ndim
00070         n     = nn(idim)
00071         nrem  = ntot/(n*nprev)
00072         ip1   = 2*nprev
00073         ip2   = ip1*n
00074         ip3   = ip2*nrem
00075         i2rev = 1
00076         do i2=1,ip2,ip1
00077           if(i2.lt.i2rev)then
00078             do i1=i2,i2+ip1-2,2
00079               do i3=i1,ip3,ip2
00080                 i3rev      = i2rev+i3-i2
00081                 tempr      = x(i3)
00082                 tempi      = x(i3+1)
00083                 x(i3)      = x(i3rev)
00084                 x(i3+1)    = x(i3rev+1)
00085                 x(i3rev)   = tempr
00086                 x(i3rev+1) = tempi
00087               end do
00088             end do
00089           end if
00090           ibit = ip2/2
00091           do while ((ibit.ge.ip1).and.(i2rev.gt.ibit))
00092             i2rev = i2rev-ibit
00093             ibit  = ibit/2
00094           end do
00095           i2rev = i2rev+ibit
00096         end do
00097         ifp1 = ip1
00098         do while (ifp1.lt.ip2)
00099           ifp2=2*ifp1
00100           theta=isign*6.28318530717959d0/(ifp2/ip1)
00101           wpr=-2.d0*sin(0.5d0*theta)**2
00102           wpi=sin(theta)
00103           wr=1.d0
00104           wi=0.d0
00105           do i3=1,ifp1,ip1
00106             do i1=i3,i3+ip1-2,2
00107               do i2=i1,ip3,ifp2
00108                 k1      = i2
00109                 k2      = k1+ifp1
00110                 tempr   = (wr)*x(k2)-(wi)*x(k2+1)
00111                 tempi   = (wr)*x(k2+1)+(wi)*x(k2)
00112                 x(k2)   = x(k1)-tempr
00113                 x(k2+1) = x(k1+1)-tempi
00114                 x(k1)   = x(k1)+tempr
00115                 x(k1+1) = x(k1+1)+tempi
00116               end do
00117             end do
00118             wtemp = wr
00119             wr    = wr*wpr-wi*wpi+wr
00120             wi    = wi*wpr+wtemp*wpi+wi
00121           end do
00122           ifp1=ifp2
00123         end do
00124         nprev=n*nprev 
00125       end do
00126 
00127    return
00128 end subroutine nr_fourn
 All Classes Files Functions Variables