Scrambler
1
|
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