1! Generated automatically.  DO NOT EDIT!
2
3  integer(C_INT), parameter :: FFTW_R2HC = 0
4  integer(C_INT), parameter :: FFTW_HC2R = 1
5  integer(C_INT), parameter :: FFTW_DHT = 2
6  integer(C_INT), parameter :: FFTW_REDFT00 = 3
7  integer(C_INT), parameter :: FFTW_REDFT01 = 4
8  integer(C_INT), parameter :: FFTW_REDFT10 = 5
9  integer(C_INT), parameter :: FFTW_REDFT11 = 6
10  integer(C_INT), parameter :: FFTW_RODFT00 = 7
11  integer(C_INT), parameter :: FFTW_RODFT01 = 8
12  integer(C_INT), parameter :: FFTW_RODFT10 = 9
13  integer(C_INT), parameter :: FFTW_RODFT11 = 10
14  integer(C_INT), parameter :: FFTW_FORWARD = -1
15  integer(C_INT), parameter :: FFTW_BACKWARD = +1
16  integer(C_INT), parameter :: FFTW_MEASURE = 0
17  integer(C_INT), parameter :: FFTW_DESTROY_INPUT = 1
18  integer(C_INT), parameter :: FFTW_UNALIGNED = 2
19  integer(C_INT), parameter :: FFTW_CONSERVE_MEMORY = 4
20  integer(C_INT), parameter :: FFTW_EXHAUSTIVE = 8
21  integer(C_INT), parameter :: FFTW_PRESERVE_INPUT = 16
22  integer(C_INT), parameter :: FFTW_PATIENT = 32
23  integer(C_INT), parameter :: FFTW_ESTIMATE = 64
24  integer(C_INT), parameter :: FFTW_WISDOM_ONLY = 2097152
25  integer(C_INT), parameter :: FFTW_ESTIMATE_PATIENT = 128
26  integer(C_INT), parameter :: FFTW_BELIEVE_PCOST = 256
27  integer(C_INT), parameter :: FFTW_NO_DFT_R2HC = 512
28  integer(C_INT), parameter :: FFTW_NO_NONTHREADED = 1024
29  integer(C_INT), parameter :: FFTW_NO_BUFFERING = 2048
30  integer(C_INT), parameter :: FFTW_NO_INDIRECT_OP = 4096
31  integer(C_INT), parameter :: FFTW_ALLOW_LARGE_GENERIC = 8192
32  integer(C_INT), parameter :: FFTW_NO_RANK_SPLITS = 16384
33  integer(C_INT), parameter :: FFTW_NO_VRANK_SPLITS = 32768
34  integer(C_INT), parameter :: FFTW_NO_VRECURSE = 65536
35  integer(C_INT), parameter :: FFTW_NO_SIMD = 131072
36  integer(C_INT), parameter :: FFTW_NO_SLOW = 262144
37  integer(C_INT), parameter :: FFTW_NO_FIXED_RADIX_LARGE_N = 524288
38  integer(C_INT), parameter :: FFTW_ALLOW_PRUNING = 1048576
39
40  type, bind(C) :: fftw_iodim
41     integer(C_INT) n, is, os
42  end type fftw_iodim
43  type, bind(C) :: fftw_iodim64
44     integer(C_INTPTR_T) n, is, os
45  end type fftw_iodim64
46
47  interface
48    type(C_PTR) function fftw_plan_dft(rank,n,in,out,sign,flags) bind(C, name='fftw_plan_dft')
49      import
50      integer(C_INT), value :: rank
51      integer(C_INT), dimension(*), intent(in) :: n
52      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
53      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
54      integer(C_INT), value :: sign
55      integer(C_INT), value :: flags
56    end function fftw_plan_dft
57
58    type(C_PTR) function fftw_plan_dft_1d(n,in,out,sign,flags) bind(C, name='fftw_plan_dft_1d')
59      import
60      integer(C_INT), value :: n
61      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
62      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
63      integer(C_INT), value :: sign
64      integer(C_INT), value :: flags
65    end function fftw_plan_dft_1d
66
67    type(C_PTR) function fftw_plan_dft_2d(n0,n1,in,out,sign,flags) bind(C, name='fftw_plan_dft_2d')
68      import
69      integer(C_INT), value :: n0
70      integer(C_INT), value :: n1
71      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
72      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
73      integer(C_INT), value :: sign
74      integer(C_INT), value :: flags
75    end function fftw_plan_dft_2d
76
77    type(C_PTR) function fftw_plan_dft_3d(n0,n1,n2,in,out,sign,flags) bind(C, name='fftw_plan_dft_3d')
78      import
79      integer(C_INT), value :: n0
80      integer(C_INT), value :: n1
81      integer(C_INT), value :: n2
82      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
83      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
84      integer(C_INT), value :: sign
85      integer(C_INT), value :: flags
86    end function fftw_plan_dft_3d
87
88    type(C_PTR) function fftw_plan_many_dft(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,sign,flags) &
89                         bind(C, name='fftw_plan_many_dft')
90      import
91      integer(C_INT), value :: rank
92      integer(C_INT), dimension(*), intent(in) :: n
93      integer(C_INT), value :: howmany
94      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
95      integer(C_INT), dimension(*), intent(in) :: inembed
96      integer(C_INT), value :: istride
97      integer(C_INT), value :: idist
98      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
99      integer(C_INT), dimension(*), intent(in) :: onembed
100      integer(C_INT), value :: ostride
101      integer(C_INT), value :: odist
102      integer(C_INT), value :: sign
103      integer(C_INT), value :: flags
104    end function fftw_plan_many_dft
105
106    type(C_PTR) function fftw_plan_guru_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) &
107                         bind(C, name='fftw_plan_guru_dft')
108      import
109      integer(C_INT), value :: rank
110      type(fftw_iodim), dimension(*), intent(in) :: dims
111      integer(C_INT), value :: howmany_rank
112      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
113      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
114      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
115      integer(C_INT), value :: sign
116      integer(C_INT), value :: flags
117    end function fftw_plan_guru_dft
118
119    type(C_PTR) function fftw_plan_guru_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) &
120                         bind(C, name='fftw_plan_guru_split_dft')
121      import
122      integer(C_INT), value :: rank
123      type(fftw_iodim), dimension(*), intent(in) :: dims
124      integer(C_INT), value :: howmany_rank
125      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
126      real(C_DOUBLE), dimension(*), intent(out) :: ri
127      real(C_DOUBLE), dimension(*), intent(out) :: ii
128      real(C_DOUBLE), dimension(*), intent(out) :: ro
129      real(C_DOUBLE), dimension(*), intent(out) :: io
130      integer(C_INT), value :: flags
131    end function fftw_plan_guru_split_dft
132
133    type(C_PTR) function fftw_plan_guru64_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) &
134                         bind(C, name='fftw_plan_guru64_dft')
135      import
136      integer(C_INT), value :: rank
137      type(fftw_iodim64), dimension(*), intent(in) :: dims
138      integer(C_INT), value :: howmany_rank
139      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
140      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
141      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
142      integer(C_INT), value :: sign
143      integer(C_INT), value :: flags
144    end function fftw_plan_guru64_dft
145
146    type(C_PTR) function fftw_plan_guru64_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) &
147                         bind(C, name='fftw_plan_guru64_split_dft')
148      import
149      integer(C_INT), value :: rank
150      type(fftw_iodim64), dimension(*), intent(in) :: dims
151      integer(C_INT), value :: howmany_rank
152      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
153      real(C_DOUBLE), dimension(*), intent(out) :: ri
154      real(C_DOUBLE), dimension(*), intent(out) :: ii
155      real(C_DOUBLE), dimension(*), intent(out) :: ro
156      real(C_DOUBLE), dimension(*), intent(out) :: io
157      integer(C_INT), value :: flags
158    end function fftw_plan_guru64_split_dft
159
160    subroutine fftw_execute_dft(p,in,out) bind(C, name='fftw_execute_dft')
161      import
162      type(C_PTR), value :: p
163      complex(C_DOUBLE_COMPLEX), dimension(*), intent(inout) :: in
164      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
165    end subroutine fftw_execute_dft
166
167    subroutine fftw_execute_split_dft(p,ri,ii,ro,io) bind(C, name='fftw_execute_split_dft')
168      import
169      type(C_PTR), value :: p
170      real(C_DOUBLE), dimension(*), intent(inout) :: ri
171      real(C_DOUBLE), dimension(*), intent(inout) :: ii
172      real(C_DOUBLE), dimension(*), intent(out) :: ro
173      real(C_DOUBLE), dimension(*), intent(out) :: io
174    end subroutine fftw_execute_split_dft
175
176    type(C_PTR) function fftw_plan_many_dft_r2c(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) &
177                         bind(C, name='fftw_plan_many_dft_r2c')
178      import
179      integer(C_INT), value :: rank
180      integer(C_INT), dimension(*), intent(in) :: n
181      integer(C_INT), value :: howmany
182      real(C_DOUBLE), dimension(*), intent(out) :: in
183      integer(C_INT), dimension(*), intent(in) :: inembed
184      integer(C_INT), value :: istride
185      integer(C_INT), value :: idist
186      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
187      integer(C_INT), dimension(*), intent(in) :: onembed
188      integer(C_INT), value :: ostride
189      integer(C_INT), value :: odist
190      integer(C_INT), value :: flags
191    end function fftw_plan_many_dft_r2c
192
193    type(C_PTR) function fftw_plan_dft_r2c(rank,n,in,out,flags) bind(C, name='fftw_plan_dft_r2c')
194      import
195      integer(C_INT), value :: rank
196      integer(C_INT), dimension(*), intent(in) :: n
197      real(C_DOUBLE), dimension(*), intent(out) :: in
198      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
199      integer(C_INT), value :: flags
200    end function fftw_plan_dft_r2c
201
202    type(C_PTR) function fftw_plan_dft_r2c_1d(n,in,out,flags) bind(C, name='fftw_plan_dft_r2c_1d')
203      import
204      integer(C_INT), value :: n
205      real(C_DOUBLE), dimension(*), intent(out) :: in
206      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
207      integer(C_INT), value :: flags
208    end function fftw_plan_dft_r2c_1d
209
210    type(C_PTR) function fftw_plan_dft_r2c_2d(n0,n1,in,out,flags) bind(C, name='fftw_plan_dft_r2c_2d')
211      import
212      integer(C_INT), value :: n0
213      integer(C_INT), value :: n1
214      real(C_DOUBLE), dimension(*), intent(out) :: in
215      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
216      integer(C_INT), value :: flags
217    end function fftw_plan_dft_r2c_2d
218
219    type(C_PTR) function fftw_plan_dft_r2c_3d(n0,n1,n2,in,out,flags) bind(C, name='fftw_plan_dft_r2c_3d')
220      import
221      integer(C_INT), value :: n0
222      integer(C_INT), value :: n1
223      integer(C_INT), value :: n2
224      real(C_DOUBLE), dimension(*), intent(out) :: in
225      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
226      integer(C_INT), value :: flags
227    end function fftw_plan_dft_r2c_3d
228
229    type(C_PTR) function fftw_plan_many_dft_c2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) &
230                         bind(C, name='fftw_plan_many_dft_c2r')
231      import
232      integer(C_INT), value :: rank
233      integer(C_INT), dimension(*), intent(in) :: n
234      integer(C_INT), value :: howmany
235      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
236      integer(C_INT), dimension(*), intent(in) :: inembed
237      integer(C_INT), value :: istride
238      integer(C_INT), value :: idist
239      real(C_DOUBLE), dimension(*), intent(out) :: out
240      integer(C_INT), dimension(*), intent(in) :: onembed
241      integer(C_INT), value :: ostride
242      integer(C_INT), value :: odist
243      integer(C_INT), value :: flags
244    end function fftw_plan_many_dft_c2r
245
246    type(C_PTR) function fftw_plan_dft_c2r(rank,n,in,out,flags) bind(C, name='fftw_plan_dft_c2r')
247      import
248      integer(C_INT), value :: rank
249      integer(C_INT), dimension(*), intent(in) :: n
250      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
251      real(C_DOUBLE), dimension(*), intent(out) :: out
252      integer(C_INT), value :: flags
253    end function fftw_plan_dft_c2r
254
255    type(C_PTR) function fftw_plan_dft_c2r_1d(n,in,out,flags) bind(C, name='fftw_plan_dft_c2r_1d')
256      import
257      integer(C_INT), value :: n
258      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
259      real(C_DOUBLE), dimension(*), intent(out) :: out
260      integer(C_INT), value :: flags
261    end function fftw_plan_dft_c2r_1d
262
263    type(C_PTR) function fftw_plan_dft_c2r_2d(n0,n1,in,out,flags) bind(C, name='fftw_plan_dft_c2r_2d')
264      import
265      integer(C_INT), value :: n0
266      integer(C_INT), value :: n1
267      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
268      real(C_DOUBLE), dimension(*), intent(out) :: out
269      integer(C_INT), value :: flags
270    end function fftw_plan_dft_c2r_2d
271
272    type(C_PTR) function fftw_plan_dft_c2r_3d(n0,n1,n2,in,out,flags) bind(C, name='fftw_plan_dft_c2r_3d')
273      import
274      integer(C_INT), value :: n0
275      integer(C_INT), value :: n1
276      integer(C_INT), value :: n2
277      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
278      real(C_DOUBLE), dimension(*), intent(out) :: out
279      integer(C_INT), value :: flags
280    end function fftw_plan_dft_c2r_3d
281
282    type(C_PTR) function fftw_plan_guru_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
283                         bind(C, name='fftw_plan_guru_dft_r2c')
284      import
285      integer(C_INT), value :: rank
286      type(fftw_iodim), dimension(*), intent(in) :: dims
287      integer(C_INT), value :: howmany_rank
288      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
289      real(C_DOUBLE), dimension(*), intent(out) :: in
290      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
291      integer(C_INT), value :: flags
292    end function fftw_plan_guru_dft_r2c
293
294    type(C_PTR) function fftw_plan_guru_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
295                         bind(C, name='fftw_plan_guru_dft_c2r')
296      import
297      integer(C_INT), value :: rank
298      type(fftw_iodim), dimension(*), intent(in) :: dims
299      integer(C_INT), value :: howmany_rank
300      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
301      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
302      real(C_DOUBLE), dimension(*), intent(out) :: out
303      integer(C_INT), value :: flags
304    end function fftw_plan_guru_dft_c2r
305
306    type(C_PTR) function fftw_plan_guru_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) &
307                         bind(C, name='fftw_plan_guru_split_dft_r2c')
308      import
309      integer(C_INT), value :: rank
310      type(fftw_iodim), dimension(*), intent(in) :: dims
311      integer(C_INT), value :: howmany_rank
312      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
313      real(C_DOUBLE), dimension(*), intent(out) :: in
314      real(C_DOUBLE), dimension(*), intent(out) :: ro
315      real(C_DOUBLE), dimension(*), intent(out) :: io
316      integer(C_INT), value :: flags
317    end function fftw_plan_guru_split_dft_r2c
318
319    type(C_PTR) function fftw_plan_guru_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) &
320                         bind(C, name='fftw_plan_guru_split_dft_c2r')
321      import
322      integer(C_INT), value :: rank
323      type(fftw_iodim), dimension(*), intent(in) :: dims
324      integer(C_INT), value :: howmany_rank
325      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
326      real(C_DOUBLE), dimension(*), intent(out) :: ri
327      real(C_DOUBLE), dimension(*), intent(out) :: ii
328      real(C_DOUBLE), dimension(*), intent(out) :: out
329      integer(C_INT), value :: flags
330    end function fftw_plan_guru_split_dft_c2r
331
332    type(C_PTR) function fftw_plan_guru64_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
333                         bind(C, name='fftw_plan_guru64_dft_r2c')
334      import
335      integer(C_INT), value :: rank
336      type(fftw_iodim64), dimension(*), intent(in) :: dims
337      integer(C_INT), value :: howmany_rank
338      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
339      real(C_DOUBLE), dimension(*), intent(out) :: in
340      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
341      integer(C_INT), value :: flags
342    end function fftw_plan_guru64_dft_r2c
343
344    type(C_PTR) function fftw_plan_guru64_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
345                         bind(C, name='fftw_plan_guru64_dft_c2r')
346      import
347      integer(C_INT), value :: rank
348      type(fftw_iodim64), dimension(*), intent(in) :: dims
349      integer(C_INT), value :: howmany_rank
350      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
351      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
352      real(C_DOUBLE), dimension(*), intent(out) :: out
353      integer(C_INT), value :: flags
354    end function fftw_plan_guru64_dft_c2r
355
356    type(C_PTR) function fftw_plan_guru64_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) &
357                         bind(C, name='fftw_plan_guru64_split_dft_r2c')
358      import
359      integer(C_INT), value :: rank
360      type(fftw_iodim64), dimension(*), intent(in) :: dims
361      integer(C_INT), value :: howmany_rank
362      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
363      real(C_DOUBLE), dimension(*), intent(out) :: in
364      real(C_DOUBLE), dimension(*), intent(out) :: ro
365      real(C_DOUBLE), dimension(*), intent(out) :: io
366      integer(C_INT), value :: flags
367    end function fftw_plan_guru64_split_dft_r2c
368
369    type(C_PTR) function fftw_plan_guru64_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) &
370                         bind(C, name='fftw_plan_guru64_split_dft_c2r')
371      import
372      integer(C_INT), value :: rank
373      type(fftw_iodim64), dimension(*), intent(in) :: dims
374      integer(C_INT), value :: howmany_rank
375      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
376      real(C_DOUBLE), dimension(*), intent(out) :: ri
377      real(C_DOUBLE), dimension(*), intent(out) :: ii
378      real(C_DOUBLE), dimension(*), intent(out) :: out
379      integer(C_INT), value :: flags
380    end function fftw_plan_guru64_split_dft_c2r
381
382    subroutine fftw_execute_dft_r2c(p,in,out) bind(C, name='fftw_execute_dft_r2c')
383      import
384      type(C_PTR), value :: p
385      real(C_DOUBLE), dimension(*), intent(inout) :: in
386      complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
387    end subroutine fftw_execute_dft_r2c
388
389    subroutine fftw_execute_dft_c2r(p,in,out) bind(C, name='fftw_execute_dft_c2r')
390      import
391      type(C_PTR), value :: p
392      complex(C_DOUBLE_COMPLEX), dimension(*), intent(inout) :: in
393      real(C_DOUBLE), dimension(*), intent(out) :: out
394    end subroutine fftw_execute_dft_c2r
395
396    subroutine fftw_execute_split_dft_r2c(p,in,ro,io) bind(C, name='fftw_execute_split_dft_r2c')
397      import
398      type(C_PTR), value :: p
399      real(C_DOUBLE), dimension(*), intent(inout) :: in
400      real(C_DOUBLE), dimension(*), intent(out) :: ro
401      real(C_DOUBLE), dimension(*), intent(out) :: io
402    end subroutine fftw_execute_split_dft_r2c
403
404    subroutine fftw_execute_split_dft_c2r(p,ri,ii,out) bind(C, name='fftw_execute_split_dft_c2r')
405      import
406      type(C_PTR), value :: p
407      real(C_DOUBLE), dimension(*), intent(inout) :: ri
408      real(C_DOUBLE), dimension(*), intent(inout) :: ii
409      real(C_DOUBLE), dimension(*), intent(out) :: out
410    end subroutine fftw_execute_split_dft_c2r
411
412    type(C_PTR) function fftw_plan_many_r2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,kind,flags) &
413                         bind(C, name='fftw_plan_many_r2r')
414      import
415      integer(C_INT), value :: rank
416      integer(C_INT), dimension(*), intent(in) :: n
417      integer(C_INT), value :: howmany
418      real(C_DOUBLE), dimension(*), intent(out) :: in
419      integer(C_INT), dimension(*), intent(in) :: inembed
420      integer(C_INT), value :: istride
421      integer(C_INT), value :: idist
422      real(C_DOUBLE), dimension(*), intent(out) :: out
423      integer(C_INT), dimension(*), intent(in) :: onembed
424      integer(C_INT), value :: ostride
425      integer(C_INT), value :: odist
426      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
427      integer(C_INT), value :: flags
428    end function fftw_plan_many_r2r
429
430    type(C_PTR) function fftw_plan_r2r(rank,n,in,out,kind,flags) bind(C, name='fftw_plan_r2r')
431      import
432      integer(C_INT), value :: rank
433      integer(C_INT), dimension(*), intent(in) :: n
434      real(C_DOUBLE), dimension(*), intent(out) :: in
435      real(C_DOUBLE), dimension(*), intent(out) :: out
436      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
437      integer(C_INT), value :: flags
438    end function fftw_plan_r2r
439
440    type(C_PTR) function fftw_plan_r2r_1d(n,in,out,kind,flags) bind(C, name='fftw_plan_r2r_1d')
441      import
442      integer(C_INT), value :: n
443      real(C_DOUBLE), dimension(*), intent(out) :: in
444      real(C_DOUBLE), dimension(*), intent(out) :: out
445      integer(C_FFTW_R2R_KIND), value :: kind
446      integer(C_INT), value :: flags
447    end function fftw_plan_r2r_1d
448
449    type(C_PTR) function fftw_plan_r2r_2d(n0,n1,in,out,kind0,kind1,flags) bind(C, name='fftw_plan_r2r_2d')
450      import
451      integer(C_INT), value :: n0
452      integer(C_INT), value :: n1
453      real(C_DOUBLE), dimension(*), intent(out) :: in
454      real(C_DOUBLE), dimension(*), intent(out) :: out
455      integer(C_FFTW_R2R_KIND), value :: kind0
456      integer(C_FFTW_R2R_KIND), value :: kind1
457      integer(C_INT), value :: flags
458    end function fftw_plan_r2r_2d
459
460    type(C_PTR) function fftw_plan_r2r_3d(n0,n1,n2,in,out,kind0,kind1,kind2,flags) bind(C, name='fftw_plan_r2r_3d')
461      import
462      integer(C_INT), value :: n0
463      integer(C_INT), value :: n1
464      integer(C_INT), value :: n2
465      real(C_DOUBLE), dimension(*), intent(out) :: in
466      real(C_DOUBLE), dimension(*), intent(out) :: out
467      integer(C_FFTW_R2R_KIND), value :: kind0
468      integer(C_FFTW_R2R_KIND), value :: kind1
469      integer(C_FFTW_R2R_KIND), value :: kind2
470      integer(C_INT), value :: flags
471    end function fftw_plan_r2r_3d
472
473    type(C_PTR) function fftw_plan_guru_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) &
474                         bind(C, name='fftw_plan_guru_r2r')
475      import
476      integer(C_INT), value :: rank
477      type(fftw_iodim), dimension(*), intent(in) :: dims
478      integer(C_INT), value :: howmany_rank
479      type(fftw_iodim), dimension(*), intent(in) :: howmany_dims
480      real(C_DOUBLE), dimension(*), intent(out) :: in
481      real(C_DOUBLE), dimension(*), intent(out) :: out
482      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
483      integer(C_INT), value :: flags
484    end function fftw_plan_guru_r2r
485
486    type(C_PTR) function fftw_plan_guru64_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) &
487                         bind(C, name='fftw_plan_guru64_r2r')
488      import
489      integer(C_INT), value :: rank
490      type(fftw_iodim64), dimension(*), intent(in) :: dims
491      integer(C_INT), value :: howmany_rank
492      type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims
493      real(C_DOUBLE), dimension(*), intent(out) :: in
494      real(C_DOUBLE), dimension(*), intent(out) :: out
495      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
496      integer(C_INT), value :: flags
497    end function fftw_plan_guru64_r2r
498
499    subroutine fftw_execute_r2r(p,in,out) bind(C, name='fftw_execute_r2r')
500      import
501      type(C_PTR), value :: p
502      real(C_DOUBLE), dimension(*), intent(inout) :: in
503      real(C_DOUBLE), dimension(*), intent(out) :: out
504    end subroutine fftw_execute_r2r
505
506    subroutine fftw_destroy_plan(p) bind(C, name='fftw_destroy_plan')
507      import
508      type(C_PTR), value :: p
509    end subroutine fftw_destroy_plan
510
511    subroutine fftw_forget_wisdom() bind(C, name='fftw_forget_wisdom')
512      import
513    end subroutine fftw_forget_wisdom
514
515    subroutine fftw_cleanup() bind(C, name='fftw_cleanup')
516      import
517    end subroutine fftw_cleanup
518
519    subroutine fftw_set_timelimit(t) bind(C, name='fftw_set_timelimit')
520      import
521      real(C_DOUBLE), value :: t
522    end subroutine fftw_set_timelimit
523
524    subroutine fftw_plan_with_nthreads(nthreads) bind(C, name='fftw_plan_with_nthreads')
525      import
526      integer(C_INT), value :: nthreads
527    end subroutine fftw_plan_with_nthreads
528
529    integer(C_INT) function fftw_planner_nthreads() bind(C, name='fftw_planner_nthreads')
530      import
531    end function fftw_planner_nthreads
532
533    integer(C_INT) function fftw_init_threads() bind(C, name='fftw_init_threads')
534      import
535    end function fftw_init_threads
536
537    subroutine fftw_cleanup_threads() bind(C, name='fftw_cleanup_threads')
538      import
539    end subroutine fftw_cleanup_threads
540
541! Unable to generate Fortran interface for fftw_threads_set_callback
542    subroutine fftw_make_planner_thread_safe() bind(C, name='fftw_make_planner_thread_safe')
543      import
544    end subroutine fftw_make_planner_thread_safe
545
546    integer(C_INT) function fftw_export_wisdom_to_filename(filename) bind(C, name='fftw_export_wisdom_to_filename')
547      import
548      character(C_CHAR), dimension(*), intent(in) :: filename
549    end function fftw_export_wisdom_to_filename
550
551    subroutine fftw_export_wisdom_to_file(output_file) bind(C, name='fftw_export_wisdom_to_file')
552      import
553      type(C_PTR), value :: output_file
554    end subroutine fftw_export_wisdom_to_file
555
556    type(C_PTR) function fftw_export_wisdom_to_string() bind(C, name='fftw_export_wisdom_to_string')
557      import
558    end function fftw_export_wisdom_to_string
559
560    subroutine fftw_export_wisdom(write_char,data) bind(C, name='fftw_export_wisdom')
561      import
562      type(C_FUNPTR), value :: write_char
563      type(C_PTR), value :: data
564    end subroutine fftw_export_wisdom
565
566    integer(C_INT) function fftw_import_system_wisdom() bind(C, name='fftw_import_system_wisdom')
567      import
568    end function fftw_import_system_wisdom
569
570    integer(C_INT) function fftw_import_wisdom_from_filename(filename) bind(C, name='fftw_import_wisdom_from_filename')
571      import
572      character(C_CHAR), dimension(*), intent(in) :: filename
573    end function fftw_import_wisdom_from_filename
574
575    integer(C_INT) function fftw_import_wisdom_from_file(input_file) bind(C, name='fftw_import_wisdom_from_file')
576      import
577      type(C_PTR), value :: input_file
578    end function fftw_import_wisdom_from_file
579
580    integer(C_INT) function fftw_import_wisdom_from_string(input_string) bind(C, name='fftw_import_wisdom_from_string')
581      import
582      character(C_CHAR), dimension(*), intent(in) :: input_string
583    end function fftw_import_wisdom_from_string
584
585    integer(C_INT) function fftw_import_wisdom(read_char,data) bind(C, name='fftw_import_wisdom')
586      import
587      type(C_FUNPTR), value :: read_char
588      type(C_PTR), value :: data
589    end function fftw_import_wisdom
590
591    subroutine fftw_fprint_plan(p,output_file) bind(C, name='fftw_fprint_plan')
592      import
593      type(C_PTR), value :: p
594      type(C_PTR), value :: output_file
595    end subroutine fftw_fprint_plan
596
597    subroutine fftw_print_plan(p) bind(C, name='fftw_print_plan')
598      import
599      type(C_PTR), value :: p
600    end subroutine fftw_print_plan
601
602    type(C_PTR) function fftw_sprint_plan(p) bind(C, name='fftw_sprint_plan')
603      import
604      type(C_PTR), value :: p
605    end function fftw_sprint_plan
606
607    type(C_PTR) function fftw_malloc(n) bind(C, name='fftw_malloc')
608      import
609      integer(C_SIZE_T), value :: n
610    end function fftw_malloc
611
612    type(C_PTR) function fftw_alloc_real(n) bind(C, name='fftw_alloc_real')
613      import
614      integer(C_SIZE_T), value :: n
615    end function fftw_alloc_real
616
617    type(C_PTR) function fftw_alloc_complex(n) bind(C, name='fftw_alloc_complex')
618      import
619      integer(C_SIZE_T), value :: n
620    end function fftw_alloc_complex
621
622    subroutine fftw_free(p) bind(C, name='fftw_free')
623      import
624      type(C_PTR), value :: p
625    end subroutine fftw_free
626
627    subroutine fftw_flops(p,add,mul,fmas) bind(C, name='fftw_flops')
628      import
629      type(C_PTR), value :: p
630      real(C_DOUBLE), intent(out) :: add
631      real(C_DOUBLE), intent(out) :: mul
632      real(C_DOUBLE), intent(out) :: fmas
633    end subroutine fftw_flops
634
635    real(C_DOUBLE) function fftw_estimate_cost(p) bind(C, name='fftw_estimate_cost')
636      import
637      type(C_PTR), value :: p
638    end function fftw_estimate_cost
639
640    real(C_DOUBLE) function fftw_cost(p) bind(C, name='fftw_cost')
641      import
642      type(C_PTR), value :: p
643    end function fftw_cost
644
645    integer(C_INT) function fftw_alignment_of(p) bind(C, name='fftw_alignment_of')
646      import
647      real(C_DOUBLE), dimension(*), intent(out) :: p
648    end function fftw_alignment_of
649
650  end interface
651
652  type, bind(C) :: fftwf_iodim
653     integer(C_INT) n, is, os
654  end type fftwf_iodim
655  type, bind(C) :: fftwf_iodim64
656     integer(C_INTPTR_T) n, is, os
657  end type fftwf_iodim64
658
659  interface
660    type(C_PTR) function fftwf_plan_dft(rank,n,in,out,sign,flags) bind(C, name='fftwf_plan_dft')
661      import
662      integer(C_INT), value :: rank
663      integer(C_INT), dimension(*), intent(in) :: n
664      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
665      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
666      integer(C_INT), value :: sign
667      integer(C_INT), value :: flags
668    end function fftwf_plan_dft
669
670    type(C_PTR) function fftwf_plan_dft_1d(n,in,out,sign,flags) bind(C, name='fftwf_plan_dft_1d')
671      import
672      integer(C_INT), value :: n
673      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
674      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
675      integer(C_INT), value :: sign
676      integer(C_INT), value :: flags
677    end function fftwf_plan_dft_1d
678
679    type(C_PTR) function fftwf_plan_dft_2d(n0,n1,in,out,sign,flags) bind(C, name='fftwf_plan_dft_2d')
680      import
681      integer(C_INT), value :: n0
682      integer(C_INT), value :: n1
683      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
684      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
685      integer(C_INT), value :: sign
686      integer(C_INT), value :: flags
687    end function fftwf_plan_dft_2d
688
689    type(C_PTR) function fftwf_plan_dft_3d(n0,n1,n2,in,out,sign,flags) bind(C, name='fftwf_plan_dft_3d')
690      import
691      integer(C_INT), value :: n0
692      integer(C_INT), value :: n1
693      integer(C_INT), value :: n2
694      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
695      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
696      integer(C_INT), value :: sign
697      integer(C_INT), value :: flags
698    end function fftwf_plan_dft_3d
699
700    type(C_PTR) function fftwf_plan_many_dft(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,sign,flags) &
701                         bind(C, name='fftwf_plan_many_dft')
702      import
703      integer(C_INT), value :: rank
704      integer(C_INT), dimension(*), intent(in) :: n
705      integer(C_INT), value :: howmany
706      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
707      integer(C_INT), dimension(*), intent(in) :: inembed
708      integer(C_INT), value :: istride
709      integer(C_INT), value :: idist
710      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
711      integer(C_INT), dimension(*), intent(in) :: onembed
712      integer(C_INT), value :: ostride
713      integer(C_INT), value :: odist
714      integer(C_INT), value :: sign
715      integer(C_INT), value :: flags
716    end function fftwf_plan_many_dft
717
718    type(C_PTR) function fftwf_plan_guru_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) &
719                         bind(C, name='fftwf_plan_guru_dft')
720      import
721      integer(C_INT), value :: rank
722      type(fftwf_iodim), dimension(*), intent(in) :: dims
723      integer(C_INT), value :: howmany_rank
724      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
725      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
726      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
727      integer(C_INT), value :: sign
728      integer(C_INT), value :: flags
729    end function fftwf_plan_guru_dft
730
731    type(C_PTR) function fftwf_plan_guru_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) &
732                         bind(C, name='fftwf_plan_guru_split_dft')
733      import
734      integer(C_INT), value :: rank
735      type(fftwf_iodim), dimension(*), intent(in) :: dims
736      integer(C_INT), value :: howmany_rank
737      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
738      real(C_FLOAT), dimension(*), intent(out) :: ri
739      real(C_FLOAT), dimension(*), intent(out) :: ii
740      real(C_FLOAT), dimension(*), intent(out) :: ro
741      real(C_FLOAT), dimension(*), intent(out) :: io
742      integer(C_INT), value :: flags
743    end function fftwf_plan_guru_split_dft
744
745    type(C_PTR) function fftwf_plan_guru64_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) &
746                         bind(C, name='fftwf_plan_guru64_dft')
747      import
748      integer(C_INT), value :: rank
749      type(fftwf_iodim64), dimension(*), intent(in) :: dims
750      integer(C_INT), value :: howmany_rank
751      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
752      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
753      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
754      integer(C_INT), value :: sign
755      integer(C_INT), value :: flags
756    end function fftwf_plan_guru64_dft
757
758    type(C_PTR) function fftwf_plan_guru64_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) &
759                         bind(C, name='fftwf_plan_guru64_split_dft')
760      import
761      integer(C_INT), value :: rank
762      type(fftwf_iodim64), dimension(*), intent(in) :: dims
763      integer(C_INT), value :: howmany_rank
764      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
765      real(C_FLOAT), dimension(*), intent(out) :: ri
766      real(C_FLOAT), dimension(*), intent(out) :: ii
767      real(C_FLOAT), dimension(*), intent(out) :: ro
768      real(C_FLOAT), dimension(*), intent(out) :: io
769      integer(C_INT), value :: flags
770    end function fftwf_plan_guru64_split_dft
771
772    subroutine fftwf_execute_dft(p,in,out) bind(C, name='fftwf_execute_dft')
773      import
774      type(C_PTR), value :: p
775      complex(C_FLOAT_COMPLEX), dimension(*), intent(inout) :: in
776      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
777    end subroutine fftwf_execute_dft
778
779    subroutine fftwf_execute_split_dft(p,ri,ii,ro,io) bind(C, name='fftwf_execute_split_dft')
780      import
781      type(C_PTR), value :: p
782      real(C_FLOAT), dimension(*), intent(inout) :: ri
783      real(C_FLOAT), dimension(*), intent(inout) :: ii
784      real(C_FLOAT), dimension(*), intent(out) :: ro
785      real(C_FLOAT), dimension(*), intent(out) :: io
786    end subroutine fftwf_execute_split_dft
787
788    type(C_PTR) function fftwf_plan_many_dft_r2c(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) &
789                         bind(C, name='fftwf_plan_many_dft_r2c')
790      import
791      integer(C_INT), value :: rank
792      integer(C_INT), dimension(*), intent(in) :: n
793      integer(C_INT), value :: howmany
794      real(C_FLOAT), dimension(*), intent(out) :: in
795      integer(C_INT), dimension(*), intent(in) :: inembed
796      integer(C_INT), value :: istride
797      integer(C_INT), value :: idist
798      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
799      integer(C_INT), dimension(*), intent(in) :: onembed
800      integer(C_INT), value :: ostride
801      integer(C_INT), value :: odist
802      integer(C_INT), value :: flags
803    end function fftwf_plan_many_dft_r2c
804
805    type(C_PTR) function fftwf_plan_dft_r2c(rank,n,in,out,flags) bind(C, name='fftwf_plan_dft_r2c')
806      import
807      integer(C_INT), value :: rank
808      integer(C_INT), dimension(*), intent(in) :: n
809      real(C_FLOAT), dimension(*), intent(out) :: in
810      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
811      integer(C_INT), value :: flags
812    end function fftwf_plan_dft_r2c
813
814    type(C_PTR) function fftwf_plan_dft_r2c_1d(n,in,out,flags) bind(C, name='fftwf_plan_dft_r2c_1d')
815      import
816      integer(C_INT), value :: n
817      real(C_FLOAT), dimension(*), intent(out) :: in
818      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
819      integer(C_INT), value :: flags
820    end function fftwf_plan_dft_r2c_1d
821
822    type(C_PTR) function fftwf_plan_dft_r2c_2d(n0,n1,in,out,flags) bind(C, name='fftwf_plan_dft_r2c_2d')
823      import
824      integer(C_INT), value :: n0
825      integer(C_INT), value :: n1
826      real(C_FLOAT), dimension(*), intent(out) :: in
827      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
828      integer(C_INT), value :: flags
829    end function fftwf_plan_dft_r2c_2d
830
831    type(C_PTR) function fftwf_plan_dft_r2c_3d(n0,n1,n2,in,out,flags) bind(C, name='fftwf_plan_dft_r2c_3d')
832      import
833      integer(C_INT), value :: n0
834      integer(C_INT), value :: n1
835      integer(C_INT), value :: n2
836      real(C_FLOAT), dimension(*), intent(out) :: in
837      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
838      integer(C_INT), value :: flags
839    end function fftwf_plan_dft_r2c_3d
840
841    type(C_PTR) function fftwf_plan_many_dft_c2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) &
842                         bind(C, name='fftwf_plan_many_dft_c2r')
843      import
844      integer(C_INT), value :: rank
845      integer(C_INT), dimension(*), intent(in) :: n
846      integer(C_INT), value :: howmany
847      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
848      integer(C_INT), dimension(*), intent(in) :: inembed
849      integer(C_INT), value :: istride
850      integer(C_INT), value :: idist
851      real(C_FLOAT), dimension(*), intent(out) :: out
852      integer(C_INT), dimension(*), intent(in) :: onembed
853      integer(C_INT), value :: ostride
854      integer(C_INT), value :: odist
855      integer(C_INT), value :: flags
856    end function fftwf_plan_many_dft_c2r
857
858    type(C_PTR) function fftwf_plan_dft_c2r(rank,n,in,out,flags) bind(C, name='fftwf_plan_dft_c2r')
859      import
860      integer(C_INT), value :: rank
861      integer(C_INT), dimension(*), intent(in) :: n
862      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
863      real(C_FLOAT), dimension(*), intent(out) :: out
864      integer(C_INT), value :: flags
865    end function fftwf_plan_dft_c2r
866
867    type(C_PTR) function fftwf_plan_dft_c2r_1d(n,in,out,flags) bind(C, name='fftwf_plan_dft_c2r_1d')
868      import
869      integer(C_INT), value :: n
870      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
871      real(C_FLOAT), dimension(*), intent(out) :: out
872      integer(C_INT), value :: flags
873    end function fftwf_plan_dft_c2r_1d
874
875    type(C_PTR) function fftwf_plan_dft_c2r_2d(n0,n1,in,out,flags) bind(C, name='fftwf_plan_dft_c2r_2d')
876      import
877      integer(C_INT), value :: n0
878      integer(C_INT), value :: n1
879      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
880      real(C_FLOAT), dimension(*), intent(out) :: out
881      integer(C_INT), value :: flags
882    end function fftwf_plan_dft_c2r_2d
883
884    type(C_PTR) function fftwf_plan_dft_c2r_3d(n0,n1,n2,in,out,flags) bind(C, name='fftwf_plan_dft_c2r_3d')
885      import
886      integer(C_INT), value :: n0
887      integer(C_INT), value :: n1
888      integer(C_INT), value :: n2
889      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
890      real(C_FLOAT), dimension(*), intent(out) :: out
891      integer(C_INT), value :: flags
892    end function fftwf_plan_dft_c2r_3d
893
894    type(C_PTR) function fftwf_plan_guru_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
895                         bind(C, name='fftwf_plan_guru_dft_r2c')
896      import
897      integer(C_INT), value :: rank
898      type(fftwf_iodim), dimension(*), intent(in) :: dims
899      integer(C_INT), value :: howmany_rank
900      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
901      real(C_FLOAT), dimension(*), intent(out) :: in
902      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
903      integer(C_INT), value :: flags
904    end function fftwf_plan_guru_dft_r2c
905
906    type(C_PTR) function fftwf_plan_guru_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
907                         bind(C, name='fftwf_plan_guru_dft_c2r')
908      import
909      integer(C_INT), value :: rank
910      type(fftwf_iodim), dimension(*), intent(in) :: dims
911      integer(C_INT), value :: howmany_rank
912      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
913      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
914      real(C_FLOAT), dimension(*), intent(out) :: out
915      integer(C_INT), value :: flags
916    end function fftwf_plan_guru_dft_c2r
917
918    type(C_PTR) function fftwf_plan_guru_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) &
919                         bind(C, name='fftwf_plan_guru_split_dft_r2c')
920      import
921      integer(C_INT), value :: rank
922      type(fftwf_iodim), dimension(*), intent(in) :: dims
923      integer(C_INT), value :: howmany_rank
924      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
925      real(C_FLOAT), dimension(*), intent(out) :: in
926      real(C_FLOAT), dimension(*), intent(out) :: ro
927      real(C_FLOAT), dimension(*), intent(out) :: io
928      integer(C_INT), value :: flags
929    end function fftwf_plan_guru_split_dft_r2c
930
931    type(C_PTR) function fftwf_plan_guru_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) &
932                         bind(C, name='fftwf_plan_guru_split_dft_c2r')
933      import
934      integer(C_INT), value :: rank
935      type(fftwf_iodim), dimension(*), intent(in) :: dims
936      integer(C_INT), value :: howmany_rank
937      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
938      real(C_FLOAT), dimension(*), intent(out) :: ri
939      real(C_FLOAT), dimension(*), intent(out) :: ii
940      real(C_FLOAT), dimension(*), intent(out) :: out
941      integer(C_INT), value :: flags
942    end function fftwf_plan_guru_split_dft_c2r
943
944    type(C_PTR) function fftwf_plan_guru64_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
945                         bind(C, name='fftwf_plan_guru64_dft_r2c')
946      import
947      integer(C_INT), value :: rank
948      type(fftwf_iodim64), dimension(*), intent(in) :: dims
949      integer(C_INT), value :: howmany_rank
950      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
951      real(C_FLOAT), dimension(*), intent(out) :: in
952      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
953      integer(C_INT), value :: flags
954    end function fftwf_plan_guru64_dft_r2c
955
956    type(C_PTR) function fftwf_plan_guru64_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
957                         bind(C, name='fftwf_plan_guru64_dft_c2r')
958      import
959      integer(C_INT), value :: rank
960      type(fftwf_iodim64), dimension(*), intent(in) :: dims
961      integer(C_INT), value :: howmany_rank
962      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
963      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in
964      real(C_FLOAT), dimension(*), intent(out) :: out
965      integer(C_INT), value :: flags
966    end function fftwf_plan_guru64_dft_c2r
967
968    type(C_PTR) function fftwf_plan_guru64_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) &
969                         bind(C, name='fftwf_plan_guru64_split_dft_r2c')
970      import
971      integer(C_INT), value :: rank
972      type(fftwf_iodim64), dimension(*), intent(in) :: dims
973      integer(C_INT), value :: howmany_rank
974      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
975      real(C_FLOAT), dimension(*), intent(out) :: in
976      real(C_FLOAT), dimension(*), intent(out) :: ro
977      real(C_FLOAT), dimension(*), intent(out) :: io
978      integer(C_INT), value :: flags
979    end function fftwf_plan_guru64_split_dft_r2c
980
981    type(C_PTR) function fftwf_plan_guru64_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) &
982                         bind(C, name='fftwf_plan_guru64_split_dft_c2r')
983      import
984      integer(C_INT), value :: rank
985      type(fftwf_iodim64), dimension(*), intent(in) :: dims
986      integer(C_INT), value :: howmany_rank
987      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
988      real(C_FLOAT), dimension(*), intent(out) :: ri
989      real(C_FLOAT), dimension(*), intent(out) :: ii
990      real(C_FLOAT), dimension(*), intent(out) :: out
991      integer(C_INT), value :: flags
992    end function fftwf_plan_guru64_split_dft_c2r
993
994    subroutine fftwf_execute_dft_r2c(p,in,out) bind(C, name='fftwf_execute_dft_r2c')
995      import
996      type(C_PTR), value :: p
997      real(C_FLOAT), dimension(*), intent(inout) :: in
998      complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out
999    end subroutine fftwf_execute_dft_r2c
1000
1001    subroutine fftwf_execute_dft_c2r(p,in,out) bind(C, name='fftwf_execute_dft_c2r')
1002      import
1003      type(C_PTR), value :: p
1004      complex(C_FLOAT_COMPLEX), dimension(*), intent(inout) :: in
1005      real(C_FLOAT), dimension(*), intent(out) :: out
1006    end subroutine fftwf_execute_dft_c2r
1007
1008    subroutine fftwf_execute_split_dft_r2c(p,in,ro,io) bind(C, name='fftwf_execute_split_dft_r2c')
1009      import
1010      type(C_PTR), value :: p
1011      real(C_FLOAT), dimension(*), intent(inout) :: in
1012      real(C_FLOAT), dimension(*), intent(out) :: ro
1013      real(C_FLOAT), dimension(*), intent(out) :: io
1014    end subroutine fftwf_execute_split_dft_r2c
1015
1016    subroutine fftwf_execute_split_dft_c2r(p,ri,ii,out) bind(C, name='fftwf_execute_split_dft_c2r')
1017      import
1018      type(C_PTR), value :: p
1019      real(C_FLOAT), dimension(*), intent(inout) :: ri
1020      real(C_FLOAT), dimension(*), intent(inout) :: ii
1021      real(C_FLOAT), dimension(*), intent(out) :: out
1022    end subroutine fftwf_execute_split_dft_c2r
1023
1024    type(C_PTR) function fftwf_plan_many_r2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,kind,flags) &
1025                         bind(C, name='fftwf_plan_many_r2r')
1026      import
1027      integer(C_INT), value :: rank
1028      integer(C_INT), dimension(*), intent(in) :: n
1029      integer(C_INT), value :: howmany
1030      real(C_FLOAT), dimension(*), intent(out) :: in
1031      integer(C_INT), dimension(*), intent(in) :: inembed
1032      integer(C_INT), value :: istride
1033      integer(C_INT), value :: idist
1034      real(C_FLOAT), dimension(*), intent(out) :: out
1035      integer(C_INT), dimension(*), intent(in) :: onembed
1036      integer(C_INT), value :: ostride
1037      integer(C_INT), value :: odist
1038      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
1039      integer(C_INT), value :: flags
1040    end function fftwf_plan_many_r2r
1041
1042    type(C_PTR) function fftwf_plan_r2r(rank,n,in,out,kind,flags) bind(C, name='fftwf_plan_r2r')
1043      import
1044      integer(C_INT), value :: rank
1045      integer(C_INT), dimension(*), intent(in) :: n
1046      real(C_FLOAT), dimension(*), intent(out) :: in
1047      real(C_FLOAT), dimension(*), intent(out) :: out
1048      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
1049      integer(C_INT), value :: flags
1050    end function fftwf_plan_r2r
1051
1052    type(C_PTR) function fftwf_plan_r2r_1d(n,in,out,kind,flags) bind(C, name='fftwf_plan_r2r_1d')
1053      import
1054      integer(C_INT), value :: n
1055      real(C_FLOAT), dimension(*), intent(out) :: in
1056      real(C_FLOAT), dimension(*), intent(out) :: out
1057      integer(C_FFTW_R2R_KIND), value :: kind
1058      integer(C_INT), value :: flags
1059    end function fftwf_plan_r2r_1d
1060
1061    type(C_PTR) function fftwf_plan_r2r_2d(n0,n1,in,out,kind0,kind1,flags) bind(C, name='fftwf_plan_r2r_2d')
1062      import
1063      integer(C_INT), value :: n0
1064      integer(C_INT), value :: n1
1065      real(C_FLOAT), dimension(*), intent(out) :: in
1066      real(C_FLOAT), dimension(*), intent(out) :: out
1067      integer(C_FFTW_R2R_KIND), value :: kind0
1068      integer(C_FFTW_R2R_KIND), value :: kind1
1069      integer(C_INT), value :: flags
1070    end function fftwf_plan_r2r_2d
1071
1072    type(C_PTR) function fftwf_plan_r2r_3d(n0,n1,n2,in,out,kind0,kind1,kind2,flags) bind(C, name='fftwf_plan_r2r_3d')
1073      import
1074      integer(C_INT), value :: n0
1075      integer(C_INT), value :: n1
1076      integer(C_INT), value :: n2
1077      real(C_FLOAT), dimension(*), intent(out) :: in
1078      real(C_FLOAT), dimension(*), intent(out) :: out
1079      integer(C_FFTW_R2R_KIND), value :: kind0
1080      integer(C_FFTW_R2R_KIND), value :: kind1
1081      integer(C_FFTW_R2R_KIND), value :: kind2
1082      integer(C_INT), value :: flags
1083    end function fftwf_plan_r2r_3d
1084
1085    type(C_PTR) function fftwf_plan_guru_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) &
1086                         bind(C, name='fftwf_plan_guru_r2r')
1087      import
1088      integer(C_INT), value :: rank
1089      type(fftwf_iodim), dimension(*), intent(in) :: dims
1090      integer(C_INT), value :: howmany_rank
1091      type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims
1092      real(C_FLOAT), dimension(*), intent(out) :: in
1093      real(C_FLOAT), dimension(*), intent(out) :: out
1094      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
1095      integer(C_INT), value :: flags
1096    end function fftwf_plan_guru_r2r
1097
1098    type(C_PTR) function fftwf_plan_guru64_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) &
1099                         bind(C, name='fftwf_plan_guru64_r2r')
1100      import
1101      integer(C_INT), value :: rank
1102      type(fftwf_iodim64), dimension(*), intent(in) :: dims
1103      integer(C_INT), value :: howmany_rank
1104      type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims
1105      real(C_FLOAT), dimension(*), intent(out) :: in
1106      real(C_FLOAT), dimension(*), intent(out) :: out
1107      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
1108      integer(C_INT), value :: flags
1109    end function fftwf_plan_guru64_r2r
1110
1111    subroutine fftwf_execute_r2r(p,in,out) bind(C, name='fftwf_execute_r2r')
1112      import
1113      type(C_PTR), value :: p
1114      real(C_FLOAT), dimension(*), intent(inout) :: in
1115      real(C_FLOAT), dimension(*), intent(out) :: out
1116    end subroutine fftwf_execute_r2r
1117
1118    subroutine fftwf_destroy_plan(p) bind(C, name='fftwf_destroy_plan')
1119      import
1120      type(C_PTR), value :: p
1121    end subroutine fftwf_destroy_plan
1122
1123    subroutine fftwf_forget_wisdom() bind(C, name='fftwf_forget_wisdom')
1124      import
1125    end subroutine fftwf_forget_wisdom
1126
1127    subroutine fftwf_cleanup() bind(C, name='fftwf_cleanup')
1128      import
1129    end subroutine fftwf_cleanup
1130
1131    subroutine fftwf_set_timelimit(t) bind(C, name='fftwf_set_timelimit')
1132      import
1133      real(C_DOUBLE), value :: t
1134    end subroutine fftwf_set_timelimit
1135
1136    subroutine fftwf_plan_with_nthreads(nthreads) bind(C, name='fftwf_plan_with_nthreads')
1137      import
1138      integer(C_INT), value :: nthreads
1139    end subroutine fftwf_plan_with_nthreads
1140
1141    integer(C_INT) function fftwf_planner_nthreads() bind(C, name='fftwf_planner_nthreads')
1142      import
1143    end function fftwf_planner_nthreads
1144
1145    integer(C_INT) function fftwf_init_threads() bind(C, name='fftwf_init_threads')
1146      import
1147    end function fftwf_init_threads
1148
1149    subroutine fftwf_cleanup_threads() bind(C, name='fftwf_cleanup_threads')
1150      import
1151    end subroutine fftwf_cleanup_threads
1152
1153! Unable to generate Fortran interface for fftwf_threads_set_callback
1154    subroutine fftwf_make_planner_thread_safe() bind(C, name='fftwf_make_planner_thread_safe')
1155      import
1156    end subroutine fftwf_make_planner_thread_safe
1157
1158    integer(C_INT) function fftwf_export_wisdom_to_filename(filename) bind(C, name='fftwf_export_wisdom_to_filename')
1159      import
1160      character(C_CHAR), dimension(*), intent(in) :: filename
1161    end function fftwf_export_wisdom_to_filename
1162
1163    subroutine fftwf_export_wisdom_to_file(output_file) bind(C, name='fftwf_export_wisdom_to_file')
1164      import
1165      type(C_PTR), value :: output_file
1166    end subroutine fftwf_export_wisdom_to_file
1167
1168    type(C_PTR) function fftwf_export_wisdom_to_string() bind(C, name='fftwf_export_wisdom_to_string')
1169      import
1170    end function fftwf_export_wisdom_to_string
1171
1172    subroutine fftwf_export_wisdom(write_char,data) bind(C, name='fftwf_export_wisdom')
1173      import
1174      type(C_FUNPTR), value :: write_char
1175      type(C_PTR), value :: data
1176    end subroutine fftwf_export_wisdom
1177
1178    integer(C_INT) function fftwf_import_system_wisdom() bind(C, name='fftwf_import_system_wisdom')
1179      import
1180    end function fftwf_import_system_wisdom
1181
1182    integer(C_INT) function fftwf_import_wisdom_from_filename(filename) bind(C, name='fftwf_import_wisdom_from_filename')
1183      import
1184      character(C_CHAR), dimension(*), intent(in) :: filename
1185    end function fftwf_import_wisdom_from_filename
1186
1187    integer(C_INT) function fftwf_import_wisdom_from_file(input_file) bind(C, name='fftwf_import_wisdom_from_file')
1188      import
1189      type(C_PTR), value :: input_file
1190    end function fftwf_import_wisdom_from_file
1191
1192    integer(C_INT) function fftwf_import_wisdom_from_string(input_string) bind(C, name='fftwf_import_wisdom_from_string')
1193      import
1194      character(C_CHAR), dimension(*), intent(in) :: input_string
1195    end function fftwf_import_wisdom_from_string
1196
1197    integer(C_INT) function fftwf_import_wisdom(read_char,data) bind(C, name='fftwf_import_wisdom')
1198      import
1199      type(C_FUNPTR), value :: read_char
1200      type(C_PTR), value :: data
1201    end function fftwf_import_wisdom
1202
1203    subroutine fftwf_fprint_plan(p,output_file) bind(C, name='fftwf_fprint_plan')
1204      import
1205      type(C_PTR), value :: p
1206      type(C_PTR), value :: output_file
1207    end subroutine fftwf_fprint_plan
1208
1209    subroutine fftwf_print_plan(p) bind(C, name='fftwf_print_plan')
1210      import
1211      type(C_PTR), value :: p
1212    end subroutine fftwf_print_plan
1213
1214    type(C_PTR) function fftwf_sprint_plan(p) bind(C, name='fftwf_sprint_plan')
1215      import
1216      type(C_PTR), value :: p
1217    end function fftwf_sprint_plan
1218
1219    type(C_PTR) function fftwf_malloc(n) bind(C, name='fftwf_malloc')
1220      import
1221      integer(C_SIZE_T), value :: n
1222    end function fftwf_malloc
1223
1224    type(C_PTR) function fftwf_alloc_real(n) bind(C, name='fftwf_alloc_real')
1225      import
1226      integer(C_SIZE_T), value :: n
1227    end function fftwf_alloc_real
1228
1229    type(C_PTR) function fftwf_alloc_complex(n) bind(C, name='fftwf_alloc_complex')
1230      import
1231      integer(C_SIZE_T), value :: n
1232    end function fftwf_alloc_complex
1233
1234    subroutine fftwf_free(p) bind(C, name='fftwf_free')
1235      import
1236      type(C_PTR), value :: p
1237    end subroutine fftwf_free
1238
1239    subroutine fftwf_flops(p,add,mul,fmas) bind(C, name='fftwf_flops')
1240      import
1241      type(C_PTR), value :: p
1242      real(C_DOUBLE), intent(out) :: add
1243      real(C_DOUBLE), intent(out) :: mul
1244      real(C_DOUBLE), intent(out) :: fmas
1245    end subroutine fftwf_flops
1246
1247    real(C_DOUBLE) function fftwf_estimate_cost(p) bind(C, name='fftwf_estimate_cost')
1248      import
1249      type(C_PTR), value :: p
1250    end function fftwf_estimate_cost
1251
1252    real(C_DOUBLE) function fftwf_cost(p) bind(C, name='fftwf_cost')
1253      import
1254      type(C_PTR), value :: p
1255    end function fftwf_cost
1256
1257    integer(C_INT) function fftwf_alignment_of(p) bind(C, name='fftwf_alignment_of')
1258      import
1259      real(C_FLOAT), dimension(*), intent(out) :: p
1260    end function fftwf_alignment_of
1261
1262  end interface
1263