|
1 | 1 | program forward_transform_of_real_function
|
2 |
| - !! This program computes the forward transform of a real function and constructs |
3 |
| - !! the complex result (re)organized to match the array subscripting to the common |
4 |
| - !! analytical form [1]. Which form one uses in practice requires balancing the |
5 |
| - !! need for speed versus clarity. |
| 2 | + !! This program invokes fftpack's rrft function to compute the forward transform of a real function |
| 3 | + !! and constructs the resulting complex Fourier coefficients by (re)organizing and normalizing the |
| 4 | + !! rfft result according to array element layout described at [1]. The program also demonstrates |
| 5 | + !! the inverse transform of the raw rrft result to recover the original function. |
6 | 6 | !!
|
7 | 7 | !! [1] https://docs.scipy.org/doc/scipy/reference/generated/scipy.fftpack.rfft.html#scipy.fftpack.rfft
|
8 | 8 | use fftpack, only: rfft, irfft
|
9 | 9 | implicit none
|
10 | 10 | integer j, k
|
11 | 11 | integer, parameter :: N = 8
|
12 | 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 :: f(0:N-1) = f_avg + [(cos(two_pi*dble(j)/dble(N)), j=0,N-1)] |
| 13 | + double precision, parameter :: x(0:N-1) = [(two_pi*dble(j)/dble(N), j=0,N-1)] |
| 14 | + double precision, parameter :: f(0:N-1) = f_avg + cos(x) |
| 15 | + !! sample f(x) = 3 + cos(x) uniformly on [0,2*pi) |
| 16 | + !! = 3 + (exp(i*x) - exp(-i*x))/2 |
| 17 | + !! which yields the Fourier coefficients |
| 18 | + !! { 3, k = 0 |
| 19 | + !! f_hat = { 1/2, k = 1 |
| 20 | + !! { 0, otherwise |
14 | 21 | double precision, dimension(0:N-1) :: f_round_trip, rfft_f
|
15 | 22 | integer, parameter :: rk = kind(two_pi)
|
16 | 23 | complex(rk) f_hat(0:N/2)
|
| 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 |
17 | 26 |
|
18 | 27 | call assert(mod(N,2)==0, "the algorithm below requires even N")
|
19 | 28 |
|
20 | 29 | rfft_f(:) = rfft(f)/dble(N)
|
21 |
| - f_hat(:) = [ cmplx(rfft_f(0),zero), [( cmplx(k,k+1), k=lbound(rfft_f,1)+1,ubound(rfft_f,1)-1,2)], cmplx(zero,rfft_f(N-1)) ] |
22 |
| - f_round_trip(:) = dble(irfft(rfft_f)) |
23 |
| - !call assert(any(abs(f_round_trip - f) < tolerance), "inverse of forward FFT must yield the original function") |
| 30 | + f_hat(:) = [ & |
| 31 | + cmplx(rfft_f(0),zero), & |
| 32 | + [( cmplx(rfft_f(k),rfft_f(k+1)), k=lbound(rfft_f,1)+1,ubound(rfft_f,1)-1,2)], & |
| 33 | + cmplx(zero,rfft_f(N-1)) & |
| 34 | + ] |
| 35 | + f_round_trip(:) = irfft(rfft_f) |
24 | 36 |
|
25 |
| - print *, "f = ", f |
26 |
| - print *, "f_hat = ", f_hat |
27 |
| - print *, "f_round_trip = ", f_round_trip |
| 37 | + print real_format, "f = ", f |
| 38 | + print complex_format, "f_hat = ", f_hat |
| 39 | + print real_format, "f_round_trip = ",f_round_trip |
28 | 40 |
|
29 |
| - !print '(3(10x,a,10x))',"f", "f_round_trip", "rfft_f" |
30 |
| - !do m = 1, size(f) |
31 |
| - ! print *, f(m), f_round_trip(m), rfft_f(m) |
32 |
| - !end do |
33 |
| - !print * |
| 41 | + call assert(all(abs(f_round_trip - f) < tolerance), "inverse of forward FFT must yield the original function") |
34 | 42 |
|
35 | 43 | contains
|
| 44 | + |
36 | 45 | pure subroutine assert(assertion, description)
|
37 | 46 | logical, intent(in) :: assertion
|
38 | 47 | character(len=*), intent(in) :: description
|
39 | 48 | if (.not. assertion) error stop description
|
40 | 49 | end subroutine
|
| 50 | + |
41 | 51 | end program
|
0 commit comments