NLSL
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