1
1
module test_fftpack_utils
2
2
3
- use fftpack, only: rk, fftshift, ifftshift
3
+ use fftpack, only: rk, fft, ifft, fftshift, ifftshift, fftfreq, rfftfreq
4
4
use testdrive, only: new_unittest, unittest_type, error_type, check
5
5
implicit none
6
6
private
@@ -18,7 +18,11 @@ subroutine collect_utils(testsuite)
18
18
new_unittest(" fftshift_complex" , test_fftshift_complex), &
19
19
new_unittest(" fftshift_real" , test_fftshift_real), &
20
20
new_unittest(" ifftshift_complex" , test_fftshift_complex), &
21
- new_unittest(" ifftshift_real" , test_fftshift_real) &
21
+ new_unittest(" ifftshift_real" , test_fftshift_real), &
22
+ new_unittest(" fftfreq_1" , test_fftfreq_1), &
23
+ new_unittest(" fftfreq_2" , test_fftfreq_2), &
24
+ new_unittest(" fftfreq_3" , test_fftfreq_3), &
25
+ new_unittest(" rfftfreq" , test_rfftfreq) &
22
26
]
23
27
24
28
end subroutine collect_utils
@@ -79,4 +83,78 @@ subroutine test_ifftshift_real(error)
79
83
80
84
end subroutine test_ifftshift_real
81
85
86
+ subroutine test_fftfreq_1 (error )
87
+ type (error_type), allocatable , intent (out ) :: error
88
+ integer , dimension (8 ) :: target1 = [0 , 1 , 2 , 3 , - 4 , - 3 , - 2 , - 1 ]
89
+ integer , dimension (9 ) :: target2 = [0 , 1 , 2 , 3 , 4 , - 4 , - 3 , - 2 , - 1 ]
90
+
91
+ call check(error, all (fftfreq(8 ) == target1),&
92
+ " all(fftfreq(8) == target1) failed." )
93
+ if (allocated (error)) return
94
+ call check(error, all (fftfreq(9 ) == target2),&
95
+ " all(fftfreq(9) == target2) failed." )
96
+ end subroutine test_fftfreq_1
97
+
98
+ subroutine test_fftfreq_2 (error )
99
+ implicit none
100
+ type (error_type), allocatable , intent (out ) :: error
101
+
102
+ real (rk), parameter :: tol = 1.0e-12_rk
103
+ real (rk), parameter :: twopi = 8 * atan (1.0_rk ) ! > 2*pi
104
+ complex (rk), parameter :: imu = (0 ,1 ) ! > imaginary unit
105
+
106
+ integer , parameter :: n = 128
107
+ integer :: i
108
+ complex (rk), dimension (n) :: xvec, xfou
109
+ real (rk), dimension (n) :: xtrue
110
+
111
+ do i = 1 , n
112
+ xvec(i) = cos (twopi* (i-1 )/ n)
113
+ xtrue(i) = - sin (twopi* (i-1 )/ n) ! > derivative in physical space
114
+ end do
115
+
116
+ xfou = fft(xvec)/ n
117
+ xfou = imu* fftfreq(n)* xfou ! > derivative in Fourier space
118
+ xvec = ifft(xfou)
119
+ call check(error, maxval (abs (xvec- xtrue)) < tol, &
120
+ " maxval(abs(xvec-xtrue)) < tol failed." )
121
+ end subroutine test_fftfreq_2
122
+
123
+ subroutine test_fftfreq_3 (error )
124
+ implicit none
125
+ type (error_type), allocatable , intent (out ) :: error
126
+
127
+ real (rk), parameter :: tol = 1.0e-12_rk
128
+ real (rk), parameter :: twopi = 8 * atan (1.0_rk ) ! > 2*pi
129
+ complex (rk), parameter :: imu = (0 ,1 ) ! > imaginary unit
130
+
131
+ integer , parameter :: n = 135
132
+ integer :: i
133
+ complex (rk), dimension (n) :: xvec, xfou
134
+ real (rk), dimension (n) :: xtrue
135
+
136
+ do i = 1 , n
137
+ xvec(i) = cos (twopi* (i-1 )/ n)
138
+ xtrue(i) = - sin (twopi* (i-1 )/ n) ! > derivative in physical space
139
+ end do
140
+
141
+ xfou = fft(xvec)/ n
142
+ xfou = imu* fftfreq(n)* xfou ! > derivative in Fourier space
143
+ xvec = ifft(xfou)
144
+ call check(error, maxval (abs (xvec- xtrue)) < tol, &
145
+ " maxval(abs(xvec-xtrue)) < tol failed." )
146
+ end subroutine test_fftfreq_3
147
+
148
+ subroutine test_rfftfreq (error )
149
+ type (error_type), allocatable , intent (out ) :: error
150
+ integer , dimension (8 ) :: target1 = [0 , 1 , 1 , 2 , 2 , 3 , 3 , - 4 ]
151
+ integer , dimension (9 ) :: target2 = [0 , 1 , 1 , 2 , 2 , 3 , 3 , 4 , 4 ]
152
+
153
+ call check(error, all (rfftfreq(8 ) == target1),&
154
+ " all(rfftfreq(8) == target1) failed." )
155
+ if (allocated (error)) return
156
+ call check(error, all (rfftfreq(9 ) == target2),&
157
+ " all(rfftfreq(9) == target2) failed." )
158
+ end subroutine test_rfftfreq
159
+
82
160
end module test_fftpack_utils
0 commit comments