Skip to content

Commit 24f6a67

Browse files
committed
feat(example): add complex-transform.f90
1 parent 48b8412 commit 24f6a67

File tree

1 file changed

+46
-0
lines changed

1 file changed

+46
-0
lines changed

example/complex-transform.f90

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
program round_trip_transform_of_complex_function
2+
!! This program invokes fftpack's fft function to compute the forward transform of a complex function
3+
!! and the inverse transform of the result. An assertion verifies the expected result of the forward
4+
!! transform according to the element layout described at [1]. A second assertion checks that the
5+
!! inverse transform recovers the original function.
6+
!!
7+
!! [1] https://docs.scipy.org/doc/scipy/reference/generated/scipy.fftpack.fft.html#scipy.fftpack.fft
8+
use fftpack, only: fft, ifft
9+
implicit none
10+
integer j, k
11+
integer, parameter :: N = 8
12+
double precision, parameter :: two_pi = 2.D0*acos(-1.D0), tolerance = 1.0D-06, f_avg = 3.D0, zero=0.D0
13+
double precision, parameter :: x(0:N-1) = [(two_pi*dble(j)/dble(N), j=0,N-1)]
14+
integer, parameter :: rk = kind(two_pi)
15+
complex(rk), parameter :: f(0:N-1) = f_avg + cos(x)
16+
!! sample f(x) = 3 + cos(x) uniformly on [0,2*pi)
17+
!! = 3 + (exp(i*x) - exp(-i*x))/2
18+
!! which yields the Fourier coefficients
19+
!! { 3, k = 0
20+
!! f_hat = { 1/2, k = 1
21+
!! { 1/2, k = -1
22+
!! { 0, otherwise
23+
complex(rk), dimension(0:N-1) :: f_round_trip, fft_f
24+
character(len=*), parameter :: real_format = "(a,*(g10.4,:,1x))" !! space-separated values
25+
character(len=*), parameter :: complex_format= "(a,*('(',g10.4,',',g10.4,')',:,1x)))" !! space-separated complex values
26+
27+
call assert(mod(N,2)==0, "the algorithm below requires even N")
28+
29+
fft_f(:) = fft(f)/dble(N)
30+
f_round_trip(:) = ifft(fft_f)
31+
32+
print complex_format, "f = ", f
33+
print complex_format, "fft_f = ", fft_f
34+
print complex_format, "f_round_trip = ",f_round_trip
35+
36+
!call assert(all(abs(f_round_trip - f) < tolerance), "inverse of forward FFT must yield the original function")
37+
38+
contains
39+
40+
pure subroutine assert(assertion, description)
41+
logical, intent(in) :: assertion
42+
character(len=*), intent(in) :: description
43+
if (.not. assertion) error stop description
44+
end subroutine
45+
46+
end program

0 commit comments

Comments
 (0)