NLSL: ftfuns.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

ftfuns.f90
Go to the documentation of this file.
1 c NLSL Version 1.4 10/10/94
2 c----------------------------------------------------------------------
3 c ======================
4 c subroutine TWOFFT
5 c ======================
6 c From Numerical Recipes by Press et al.
7 c----------------------------------------------------------------------
8 subroutine twofft(data1,data2,fft1,fft2,n)
9 implicit none
10 integer j,n,n2
11 double precision data1(n),data2(n)
12 double complex fft1(n),fft2(n),h1,h2,c1,c2
13 c
14 intrinsic dcmplx,dreal,dimag,dconjg
15 c
16 double precision ZERO
17 parameter(zero=0.0d0)
18 c
19 c......................................................................
20 c
21 c1=dcmplx(0.5d0,zero)
22 c2=dcmplx(zero,-0.5d0)
23 do 11 j=1,n
24 fft1(j)=dcmplx(data1(j),data2(j))
25 11 continue
26 call four1(fft1,n,1)
27 fft2(1)=dcmplx(dimag(fft1(1)),zero)
28 fft1(1)=dcmplx(dreal(fft1(1)),zero)
29 n2=n+2
30 do 12 j=2,n/2+1
31 h1=c1*(fft1(j)+dconjg(fft1(n2-j)))
32 h2=c2*(fft1(j)-dconjg(fft1(n2-j)))
33 fft1(j)=h1
34 fft1(n2-j)=dconjg(h1)
35 fft2(j)=h2
36 fft2(n2-j)=dconjg(h2)
37 12 continue
38 return
39 end
40
41 c----------------------------------------------------------------------
42 c ======================
43 c subroutine REALFT
44 c ======================
45 c From Numerical Recipes by Press et al.
46 c----------------------------------------------------------------------
47 subroutine realft(data,n,isign)
48 implicit none
49 integer i,i1,i2,i3,i4,isign,n,n2p3
50 double precision c1,c2,h1r,h1i,h2r,h2i,wrs,wis,wr,wi,wpr,wpi,
51 # wtemp,theta
52 double precision data(2*n)
53 c
54 theta=6.28318530717959d0/2.0d0/dble(n)
55 c1=0.5d0
56 if (isign.eq.1) then
57 c2=-0.5d0
58 call four1(data,n,+1)
59 else
60 c2=0.5d0
61 theta=-theta
62 endif
63 wpr=-2.0d0*dsin(0.5d0*theta)**2
64 wpi=dsin(theta)
65 wr=1.d0+wpr
66 wi=wpi
67 n2p3=2*n+3
68 do 11 i=2,n/2+1
69 i1=2*i-1
70 i2=i1+1
71 i3=n2p3-i2
72 i4=i3+1
73 wrs=sngl(wr)
74 wis=sngl(wi)
75 h1r=c1*(data(i1)+data(i3))
76 h1i=c1*(data(i2)-data(i4))
77 h2r=-c2*(data(i2)+data(i4))
78 h2i=c2*(data(i1)-data(i3))
79 data(i1)=h1r+wrs*h2r-wis*h2i
80 data(i2)=h1i+wrs*h2i+wis*h2r
81 data(i3)=h1r-wrs*h2r+wis*h2i
82 data(i4)=-h1i+wrs*h2i+wis*h2r
83 wtemp=wr
84 wr=wr*wpr-wi*wpi+wr
85 wi=wi*wpr+wtemp*wpi+wi
86 11 continue
87 if (isign.eq.1) then
88 h1r=data(1)
89 data(1)=h1r+data(2)
90 data(2)=h1r-data(2)
91 else
92 h1r=data(1)
93 data(1)=c1*(h1r+data(2))
94 data(2)=c1*(h1r-data(2))
95 call four1(data,n,-1)
96 endif
97 return
98 end
99
100 c----------------------------------------------------------------------
101 c ======================
102 c subroutine FOUR1
103 c ======================
104 c From Numerical Recipes by Press et al.
105 c----------------------------------------------------------------------
106 subroutine four1(data,nn,isign)
107 implicit none
108 integer i,istep,j,m,mmax,n,nn,isign
109 double precision wr,wi,wpr,wpi,wtemp,tempi,tempr,theta
110 double precision data(2*nn)
111 c
112 n=2*nn
113 j=1
114 do 11 i=1,n,2
115 if(j.gt.i)then
116 tempr=data(j)
117 tempi=data(j+1)
118 data(j)=data(i)
119 data(j+1)=data(i+1)
120 data(i)=tempr
121 data(i+1)=tempi
122 endif
123 m=n/2
124 1 if ((m.ge.2).and.(j.gt.m)) then
125 j=j-m
126 m=m/2
127 go to 1
128 endif
129 j=j+m
130 11 continue
131 mmax=2
132 2 if (n.gt.mmax) then
133 istep=2*mmax
134 theta=6.28318530717959d0/(isign*mmax)
135 wpr=-2.d0*dsin(0.5d0*theta)**2
136 wpi=dsin(theta)
137 wr=1.d0
138 wi=0.d0
139 do 13 m=1,mmax,2
140 do 12 i=m,n,istep
141 j=i+mmax
142 tempr=sngl(wr)*data(j)-sngl(wi)*data(j+1)
143 tempi=sngl(wr)*data(j+1)+sngl(wi)*data(j)
144 data(j)=data(i)-tempr
145 data(j+1)=data(i+1)-tempi
146 data(i)=data(i)+tempr
147 data(i+1)=data(i+1)+tempi
148 12 continue
149 wtemp=wr
150 wr=wr*wpr-wi*wpi+wr
151 wi=wi*wpr+wtemp*wpi+wi
152 13 continue
153 mmax=istep
154 go to 2
155 endif
156 return
157 end
realft
subroutine realft(data, n, isign)
Definition: ftfuns.f90:48
twofft
subroutine twofft(data1, data2, fft1, fft2, n)
Definition: ftfuns.f90:9
four1
subroutine four1(data, nn, isign)
Definition: ftfuns.f90:107