-
Notifications
You must be signed in to change notification settings - Fork 19
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #46 from fortran-lang/auto-discovery
Enable auto-discovery of examples, tests, and programs
- Loading branch information
Showing
4 changed files
with
43 additions
and
7 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,4 +1,4 @@ | ||
program main | ||
program bench2 | ||
use fftpack, only: zffti, zfftf, zfftb, fft, ifft | ||
use fftpack_kind, only: rk | ||
|
||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,4 +1,4 @@ | ||
program main | ||
program bench3 | ||
use fftpack, only: dffti, dfftf, dfftb, rfft, irfft | ||
use fftpack_kind, only: rk | ||
|
||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,41 @@ | ||
program forward_transform_of_real_function | ||
!! This program computes the forward transform of a real function and constructs | ||
!! the complex result (re)organized to match the array subscripting to the common | ||
!! analytical form [1]. Which form one uses in practice requires balancing the | ||
!! need for speed versus clarity. | ||
!! | ||
!! [1] https://docs.scipy.org/doc/scipy/reference/generated/scipy.fftpack.rfft.html#scipy.fftpack.rfft | ||
use fftpack, only: rfft, irfft | ||
implicit none | ||
integer j, k | ||
integer, parameter :: N = 8 | ||
double precision, parameter :: two_pi = 2.D0*acos(-1.D0), tolerance = 1.0D-06, f_avg = 3.D0, zero=0.D0 | ||
double precision, parameter :: f(0:N-1) = f_avg + [(cos(two_pi*dble(j)/dble(N)), j=0,N-1)] | ||
double precision, dimension(0:N-1) :: f_round_trip, rfft_f | ||
integer, parameter :: rk = kind(two_pi) | ||
complex(rk) f_hat(0:N/2) | ||
|
||
call assert(mod(N,2)==0, "the algorithm below requires even N") | ||
|
||
rfft_f(:) = rfft(f)/dble(N) | ||
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)) ] | ||
f_round_trip(:) = dble(irfft(rfft_f)) | ||
!call assert(any(abs(f_round_trip - f) < tolerance), "inverse of forward FFT must yield the original function") | ||
|
||
print *, "f = ", f | ||
print *, "f_hat = ", f_hat | ||
print *, "f_round_trip = ", f_round_trip | ||
|
||
!print '(3(10x,a,10x))',"f", "f_round_trip", "rfft_f" | ||
!do m = 1, size(f) | ||
! print *, f(m), f_round_trip(m), rfft_f(m) | ||
!end do | ||
!print * | ||
|
||
contains | ||
pure subroutine assert(assertion, description) | ||
logical, intent(in) :: assertion | ||
character(len=*), intent(in) :: description | ||
if (.not. assertion) error stop description | ||
end subroutine | ||
end program |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters