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