1! Generated automatically.  DO NOT EDIT!
2
3
4  type, bind(C) :: fftwl_iodim
5     integer(C_INT) n, is, os
6  end type fftwl_iodim
7  type, bind(C) :: fftwl_iodim64
8     integer(C_INTPTR_T) n, is, os
9  end type fftwl_iodim64
10
11  interface
12    type(C_PTR) function fftwl_plan_dft(rank,n,in,out,sign,flags) bind(C, name='fftwl_plan_dft')
13      import
14      integer(C_INT), value :: rank
15      integer(C_INT), dimension(*), intent(in) :: n
16      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
17      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
18      integer(C_INT), value :: sign
19      integer(C_INT), value :: flags
20    end function fftwl_plan_dft
21
22    type(C_PTR) function fftwl_plan_dft_1d(n,in,out,sign,flags) bind(C, name='fftwl_plan_dft_1d')
23      import
24      integer(C_INT), value :: n
25      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
26      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
27      integer(C_INT), value :: sign
28      integer(C_INT), value :: flags
29    end function fftwl_plan_dft_1d
30
31    type(C_PTR) function fftwl_plan_dft_2d(n0,n1,in,out,sign,flags) bind(C, name='fftwl_plan_dft_2d')
32      import
33      integer(C_INT), value :: n0
34      integer(C_INT), value :: n1
35      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
36      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
37      integer(C_INT), value :: sign
38      integer(C_INT), value :: flags
39    end function fftwl_plan_dft_2d
40
41    type(C_PTR) function fftwl_plan_dft_3d(n0,n1,n2,in,out,sign,flags) bind(C, name='fftwl_plan_dft_3d')
42      import
43      integer(C_INT), value :: n0
44      integer(C_INT), value :: n1
45      integer(C_INT), value :: n2
46      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
47      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
48      integer(C_INT), value :: sign
49      integer(C_INT), value :: flags
50    end function fftwl_plan_dft_3d
51
52    type(C_PTR) function fftwl_plan_many_dft(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,sign,flags) &
53                         bind(C, name='fftwl_plan_many_dft')
54      import
55      integer(C_INT), value :: rank
56      integer(C_INT), dimension(*), intent(in) :: n
57      integer(C_INT), value :: howmany
58      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
59      integer(C_INT), dimension(*), intent(in) :: inembed
60      integer(C_INT), value :: istride
61      integer(C_INT), value :: idist
62      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
63      integer(C_INT), dimension(*), intent(in) :: onembed
64      integer(C_INT), value :: ostride
65      integer(C_INT), value :: odist
66      integer(C_INT), value :: sign
67      integer(C_INT), value :: flags
68    end function fftwl_plan_many_dft
69
70    type(C_PTR) function fftwl_plan_guru_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) &
71                         bind(C, name='fftwl_plan_guru_dft')
72      import
73      integer(C_INT), value :: rank
74      type(fftwl_iodim), dimension(*), intent(in) :: dims
75      integer(C_INT), value :: howmany_rank
76      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
77      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
78      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
79      integer(C_INT), value :: sign
80      integer(C_INT), value :: flags
81    end function fftwl_plan_guru_dft
82
83    type(C_PTR) function fftwl_plan_guru_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) &
84                         bind(C, name='fftwl_plan_guru_split_dft')
85      import
86      integer(C_INT), value :: rank
87      type(fftwl_iodim), dimension(*), intent(in) :: dims
88      integer(C_INT), value :: howmany_rank
89      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
90      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ri
91      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ii
92      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ro
93      real(C_LONG_DOUBLE), dimension(*), intent(out) :: io
94      integer(C_INT), value :: flags
95    end function fftwl_plan_guru_split_dft
96
97    type(C_PTR) function fftwl_plan_guru64_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) &
98                         bind(C, name='fftwl_plan_guru64_dft')
99      import
100      integer(C_INT), value :: rank
101      type(fftwl_iodim64), dimension(*), intent(in) :: dims
102      integer(C_INT), value :: howmany_rank
103      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
104      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
105      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
106      integer(C_INT), value :: sign
107      integer(C_INT), value :: flags
108    end function fftwl_plan_guru64_dft
109
110    type(C_PTR) function fftwl_plan_guru64_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) &
111                         bind(C, name='fftwl_plan_guru64_split_dft')
112      import
113      integer(C_INT), value :: rank
114      type(fftwl_iodim64), dimension(*), intent(in) :: dims
115      integer(C_INT), value :: howmany_rank
116      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
117      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ri
118      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ii
119      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ro
120      real(C_LONG_DOUBLE), dimension(*), intent(out) :: io
121      integer(C_INT), value :: flags
122    end function fftwl_plan_guru64_split_dft
123
124    subroutine fftwl_execute_dft(p,in,out) bind(C, name='fftwl_execute_dft')
125      import
126      type(C_PTR), value :: p
127      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(inout) :: in
128      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
129    end subroutine fftwl_execute_dft
130
131    subroutine fftwl_execute_split_dft(p,ri,ii,ro,io) bind(C, name='fftwl_execute_split_dft')
132      import
133      type(C_PTR), value :: p
134      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: ri
135      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: ii
136      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ro
137      real(C_LONG_DOUBLE), dimension(*), intent(out) :: io
138    end subroutine fftwl_execute_split_dft
139
140    type(C_PTR) function fftwl_plan_many_dft_r2c(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) &
141                         bind(C, name='fftwl_plan_many_dft_r2c')
142      import
143      integer(C_INT), value :: rank
144      integer(C_INT), dimension(*), intent(in) :: n
145      integer(C_INT), value :: howmany
146      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
147      integer(C_INT), dimension(*), intent(in) :: inembed
148      integer(C_INT), value :: istride
149      integer(C_INT), value :: idist
150      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
151      integer(C_INT), dimension(*), intent(in) :: onembed
152      integer(C_INT), value :: ostride
153      integer(C_INT), value :: odist
154      integer(C_INT), value :: flags
155    end function fftwl_plan_many_dft_r2c
156
157    type(C_PTR) function fftwl_plan_dft_r2c(rank,n,in,out,flags) bind(C, name='fftwl_plan_dft_r2c')
158      import
159      integer(C_INT), value :: rank
160      integer(C_INT), dimension(*), intent(in) :: n
161      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
162      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
163      integer(C_INT), value :: flags
164    end function fftwl_plan_dft_r2c
165
166    type(C_PTR) function fftwl_plan_dft_r2c_1d(n,in,out,flags) bind(C, name='fftwl_plan_dft_r2c_1d')
167      import
168      integer(C_INT), value :: n
169      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
170      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
171      integer(C_INT), value :: flags
172    end function fftwl_plan_dft_r2c_1d
173
174    type(C_PTR) function fftwl_plan_dft_r2c_2d(n0,n1,in,out,flags) bind(C, name='fftwl_plan_dft_r2c_2d')
175      import
176      integer(C_INT), value :: n0
177      integer(C_INT), value :: n1
178      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
179      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
180      integer(C_INT), value :: flags
181    end function fftwl_plan_dft_r2c_2d
182
183    type(C_PTR) function fftwl_plan_dft_r2c_3d(n0,n1,n2,in,out,flags) bind(C, name='fftwl_plan_dft_r2c_3d')
184      import
185      integer(C_INT), value :: n0
186      integer(C_INT), value :: n1
187      integer(C_INT), value :: n2
188      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
189      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
190      integer(C_INT), value :: flags
191    end function fftwl_plan_dft_r2c_3d
192
193    type(C_PTR) function fftwl_plan_many_dft_c2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) &
194                         bind(C, name='fftwl_plan_many_dft_c2r')
195      import
196      integer(C_INT), value :: rank
197      integer(C_INT), dimension(*), intent(in) :: n
198      integer(C_INT), value :: howmany
199      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
200      integer(C_INT), dimension(*), intent(in) :: inembed
201      integer(C_INT), value :: istride
202      integer(C_INT), value :: idist
203      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
204      integer(C_INT), dimension(*), intent(in) :: onembed
205      integer(C_INT), value :: ostride
206      integer(C_INT), value :: odist
207      integer(C_INT), value :: flags
208    end function fftwl_plan_many_dft_c2r
209
210    type(C_PTR) function fftwl_plan_dft_c2r(rank,n,in,out,flags) bind(C, name='fftwl_plan_dft_c2r')
211      import
212      integer(C_INT), value :: rank
213      integer(C_INT), dimension(*), intent(in) :: n
214      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
215      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
216      integer(C_INT), value :: flags
217    end function fftwl_plan_dft_c2r
218
219    type(C_PTR) function fftwl_plan_dft_c2r_1d(n,in,out,flags) bind(C, name='fftwl_plan_dft_c2r_1d')
220      import
221      integer(C_INT), value :: n
222      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
223      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
224      integer(C_INT), value :: flags
225    end function fftwl_plan_dft_c2r_1d
226
227    type(C_PTR) function fftwl_plan_dft_c2r_2d(n0,n1,in,out,flags) bind(C, name='fftwl_plan_dft_c2r_2d')
228      import
229      integer(C_INT), value :: n0
230      integer(C_INT), value :: n1
231      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
232      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
233      integer(C_INT), value :: flags
234    end function fftwl_plan_dft_c2r_2d
235
236    type(C_PTR) function fftwl_plan_dft_c2r_3d(n0,n1,n2,in,out,flags) bind(C, name='fftwl_plan_dft_c2r_3d')
237      import
238      integer(C_INT), value :: n0
239      integer(C_INT), value :: n1
240      integer(C_INT), value :: n2
241      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
242      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
243      integer(C_INT), value :: flags
244    end function fftwl_plan_dft_c2r_3d
245
246    type(C_PTR) function fftwl_plan_guru_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
247                         bind(C, name='fftwl_plan_guru_dft_r2c')
248      import
249      integer(C_INT), value :: rank
250      type(fftwl_iodim), dimension(*), intent(in) :: dims
251      integer(C_INT), value :: howmany_rank
252      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
253      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
254      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
255      integer(C_INT), value :: flags
256    end function fftwl_plan_guru_dft_r2c
257
258    type(C_PTR) function fftwl_plan_guru_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
259                         bind(C, name='fftwl_plan_guru_dft_c2r')
260      import
261      integer(C_INT), value :: rank
262      type(fftwl_iodim), dimension(*), intent(in) :: dims
263      integer(C_INT), value :: howmany_rank
264      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
265      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
266      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
267      integer(C_INT), value :: flags
268    end function fftwl_plan_guru_dft_c2r
269
270    type(C_PTR) function fftwl_plan_guru_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) &
271                         bind(C, name='fftwl_plan_guru_split_dft_r2c')
272      import
273      integer(C_INT), value :: rank
274      type(fftwl_iodim), dimension(*), intent(in) :: dims
275      integer(C_INT), value :: howmany_rank
276      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
277      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
278      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ro
279      real(C_LONG_DOUBLE), dimension(*), intent(out) :: io
280      integer(C_INT), value :: flags
281    end function fftwl_plan_guru_split_dft_r2c
282
283    type(C_PTR) function fftwl_plan_guru_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) &
284                         bind(C, name='fftwl_plan_guru_split_dft_c2r')
285      import
286      integer(C_INT), value :: rank
287      type(fftwl_iodim), dimension(*), intent(in) :: dims
288      integer(C_INT), value :: howmany_rank
289      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
290      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ri
291      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ii
292      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
293      integer(C_INT), value :: flags
294    end function fftwl_plan_guru_split_dft_c2r
295
296    type(C_PTR) function fftwl_plan_guru64_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
297                         bind(C, name='fftwl_plan_guru64_dft_r2c')
298      import
299      integer(C_INT), value :: rank
300      type(fftwl_iodim64), dimension(*), intent(in) :: dims
301      integer(C_INT), value :: howmany_rank
302      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
303      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
304      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
305      integer(C_INT), value :: flags
306    end function fftwl_plan_guru64_dft_r2c
307
308    type(C_PTR) function fftwl_plan_guru64_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) &
309                         bind(C, name='fftwl_plan_guru64_dft_c2r')
310      import
311      integer(C_INT), value :: rank
312      type(fftwl_iodim64), dimension(*), intent(in) :: dims
313      integer(C_INT), value :: howmany_rank
314      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
315      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: in
316      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
317      integer(C_INT), value :: flags
318    end function fftwl_plan_guru64_dft_c2r
319
320    type(C_PTR) function fftwl_plan_guru64_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) &
321                         bind(C, name='fftwl_plan_guru64_split_dft_r2c')
322      import
323      integer(C_INT), value :: rank
324      type(fftwl_iodim64), dimension(*), intent(in) :: dims
325      integer(C_INT), value :: howmany_rank
326      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
327      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
328      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ro
329      real(C_LONG_DOUBLE), dimension(*), intent(out) :: io
330      integer(C_INT), value :: flags
331    end function fftwl_plan_guru64_split_dft_r2c
332
333    type(C_PTR) function fftwl_plan_guru64_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) &
334                         bind(C, name='fftwl_plan_guru64_split_dft_c2r')
335      import
336      integer(C_INT), value :: rank
337      type(fftwl_iodim64), dimension(*), intent(in) :: dims
338      integer(C_INT), value :: howmany_rank
339      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
340      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ri
341      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ii
342      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
343      integer(C_INT), value :: flags
344    end function fftwl_plan_guru64_split_dft_c2r
345
346    subroutine fftwl_execute_dft_r2c(p,in,out) bind(C, name='fftwl_execute_dft_r2c')
347      import
348      type(C_PTR), value :: p
349      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: in
350      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out) :: out
351    end subroutine fftwl_execute_dft_r2c
352
353    subroutine fftwl_execute_dft_c2r(p,in,out) bind(C, name='fftwl_execute_dft_c2r')
354      import
355      type(C_PTR), value :: p
356      complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(inout) :: in
357      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
358    end subroutine fftwl_execute_dft_c2r
359
360    subroutine fftwl_execute_split_dft_r2c(p,in,ro,io) bind(C, name='fftwl_execute_split_dft_r2c')
361      import
362      type(C_PTR), value :: p
363      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: in
364      real(C_LONG_DOUBLE), dimension(*), intent(out) :: ro
365      real(C_LONG_DOUBLE), dimension(*), intent(out) :: io
366    end subroutine fftwl_execute_split_dft_r2c
367
368    subroutine fftwl_execute_split_dft_c2r(p,ri,ii,out) bind(C, name='fftwl_execute_split_dft_c2r')
369      import
370      type(C_PTR), value :: p
371      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: ri
372      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: ii
373      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
374    end subroutine fftwl_execute_split_dft_c2r
375
376    type(C_PTR) function fftwl_plan_many_r2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,kind,flags) &
377                         bind(C, name='fftwl_plan_many_r2r')
378      import
379      integer(C_INT), value :: rank
380      integer(C_INT), dimension(*), intent(in) :: n
381      integer(C_INT), value :: howmany
382      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
383      integer(C_INT), dimension(*), intent(in) :: inembed
384      integer(C_INT), value :: istride
385      integer(C_INT), value :: idist
386      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
387      integer(C_INT), dimension(*), intent(in) :: onembed
388      integer(C_INT), value :: ostride
389      integer(C_INT), value :: odist
390      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
391      integer(C_INT), value :: flags
392    end function fftwl_plan_many_r2r
393
394    type(C_PTR) function fftwl_plan_r2r(rank,n,in,out,kind,flags) bind(C, name='fftwl_plan_r2r')
395      import
396      integer(C_INT), value :: rank
397      integer(C_INT), dimension(*), intent(in) :: n
398      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
399      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
400      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
401      integer(C_INT), value :: flags
402    end function fftwl_plan_r2r
403
404    type(C_PTR) function fftwl_plan_r2r_1d(n,in,out,kind,flags) bind(C, name='fftwl_plan_r2r_1d')
405      import
406      integer(C_INT), value :: n
407      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
408      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
409      integer(C_FFTW_R2R_KIND), value :: kind
410      integer(C_INT), value :: flags
411    end function fftwl_plan_r2r_1d
412
413    type(C_PTR) function fftwl_plan_r2r_2d(n0,n1,in,out,kind0,kind1,flags) bind(C, name='fftwl_plan_r2r_2d')
414      import
415      integer(C_INT), value :: n0
416      integer(C_INT), value :: n1
417      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
418      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
419      integer(C_FFTW_R2R_KIND), value :: kind0
420      integer(C_FFTW_R2R_KIND), value :: kind1
421      integer(C_INT), value :: flags
422    end function fftwl_plan_r2r_2d
423
424    type(C_PTR) function fftwl_plan_r2r_3d(n0,n1,n2,in,out,kind0,kind1,kind2,flags) bind(C, name='fftwl_plan_r2r_3d')
425      import
426      integer(C_INT), value :: n0
427      integer(C_INT), value :: n1
428      integer(C_INT), value :: n2
429      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
430      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
431      integer(C_FFTW_R2R_KIND), value :: kind0
432      integer(C_FFTW_R2R_KIND), value :: kind1
433      integer(C_FFTW_R2R_KIND), value :: kind2
434      integer(C_INT), value :: flags
435    end function fftwl_plan_r2r_3d
436
437    type(C_PTR) function fftwl_plan_guru_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) &
438                         bind(C, name='fftwl_plan_guru_r2r')
439      import
440      integer(C_INT), value :: rank
441      type(fftwl_iodim), dimension(*), intent(in) :: dims
442      integer(C_INT), value :: howmany_rank
443      type(fftwl_iodim), dimension(*), intent(in) :: howmany_dims
444      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
445      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
446      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
447      integer(C_INT), value :: flags
448    end function fftwl_plan_guru_r2r
449
450    type(C_PTR) function fftwl_plan_guru64_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) &
451                         bind(C, name='fftwl_plan_guru64_r2r')
452      import
453      integer(C_INT), value :: rank
454      type(fftwl_iodim64), dimension(*), intent(in) :: dims
455      integer(C_INT), value :: howmany_rank
456      type(fftwl_iodim64), dimension(*), intent(in) :: howmany_dims
457      real(C_LONG_DOUBLE), dimension(*), intent(out) :: in
458      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
459      integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind
460      integer(C_INT), value :: flags
461    end function fftwl_plan_guru64_r2r
462
463    subroutine fftwl_execute_r2r(p,in,out) bind(C, name='fftwl_execute_r2r')
464      import
465      type(C_PTR), value :: p
466      real(C_LONG_DOUBLE), dimension(*), intent(inout) :: in
467      real(C_LONG_DOUBLE), dimension(*), intent(out) :: out
468    end subroutine fftwl_execute_r2r
469
470    subroutine fftwl_destroy_plan(p) bind(C, name='fftwl_destroy_plan')
471      import
472      type(C_PTR), value :: p
473    end subroutine fftwl_destroy_plan
474
475    subroutine fftwl_forget_wisdom() bind(C, name='fftwl_forget_wisdom')
476      import
477    end subroutine fftwl_forget_wisdom
478
479    subroutine fftwl_cleanup() bind(C, name='fftwl_cleanup')
480      import
481    end subroutine fftwl_cleanup
482
483    subroutine fftwl_set_timelimit(t) bind(C, name='fftwl_set_timelimit')
484      import
485      real(C_DOUBLE), value :: t
486    end subroutine fftwl_set_timelimit
487
488    subroutine fftwl_plan_with_nthreads(nthreads) bind(C, name='fftwl_plan_with_nthreads')
489      import
490      integer(C_INT), value :: nthreads
491    end subroutine fftwl_plan_with_nthreads
492
493    integer(C_INT) function fftwl_planner_nthreads() bind(C, name='fftwl_planner_nthreads')
494      import
495    end function fftwl_planner_nthreads
496
497    integer(C_INT) function fftwl_init_threads() bind(C, name='fftwl_init_threads')
498      import
499    end function fftwl_init_threads
500
501    subroutine fftwl_cleanup_threads() bind(C, name='fftwl_cleanup_threads')
502      import
503    end subroutine fftwl_cleanup_threads
504
505! Unable to generate Fortran interface for fftwl_threads_set_callback
506    subroutine fftwl_make_planner_thread_safe() bind(C, name='fftwl_make_planner_thread_safe')
507      import
508    end subroutine fftwl_make_planner_thread_safe
509
510    integer(C_INT) function fftwl_export_wisdom_to_filename(filename) bind(C, name='fftwl_export_wisdom_to_filename')
511      import
512      character(C_CHAR), dimension(*), intent(in) :: filename
513    end function fftwl_export_wisdom_to_filename
514
515    subroutine fftwl_export_wisdom_to_file(output_file) bind(C, name='fftwl_export_wisdom_to_file')
516      import
517      type(C_PTR), value :: output_file
518    end subroutine fftwl_export_wisdom_to_file
519
520    type(C_PTR) function fftwl_export_wisdom_to_string() bind(C, name='fftwl_export_wisdom_to_string')
521      import
522    end function fftwl_export_wisdom_to_string
523
524    subroutine fftwl_export_wisdom(write_char,data) bind(C, name='fftwl_export_wisdom')
525      import
526      type(C_FUNPTR), value :: write_char
527      type(C_PTR), value :: data
528    end subroutine fftwl_export_wisdom
529
530    integer(C_INT) function fftwl_import_system_wisdom() bind(C, name='fftwl_import_system_wisdom')
531      import
532    end function fftwl_import_system_wisdom
533
534    integer(C_INT) function fftwl_import_wisdom_from_filename(filename) bind(C, name='fftwl_import_wisdom_from_filename')
535      import
536      character(C_CHAR), dimension(*), intent(in) :: filename
537    end function fftwl_import_wisdom_from_filename
538
539    integer(C_INT) function fftwl_import_wisdom_from_file(input_file) bind(C, name='fftwl_import_wisdom_from_file')
540      import
541      type(C_PTR), value :: input_file
542    end function fftwl_import_wisdom_from_file
543
544    integer(C_INT) function fftwl_import_wisdom_from_string(input_string) bind(C, name='fftwl_import_wisdom_from_string')
545      import
546      character(C_CHAR), dimension(*), intent(in) :: input_string
547    end function fftwl_import_wisdom_from_string
548
549    integer(C_INT) function fftwl_import_wisdom(read_char,data) bind(C, name='fftwl_import_wisdom')
550      import
551      type(C_FUNPTR), value :: read_char
552      type(C_PTR), value :: data
553    end function fftwl_import_wisdom
554
555    subroutine fftwl_fprint_plan(p,output_file) bind(C, name='fftwl_fprint_plan')
556      import
557      type(C_PTR), value :: p
558      type(C_PTR), value :: output_file
559    end subroutine fftwl_fprint_plan
560
561    subroutine fftwl_print_plan(p) bind(C, name='fftwl_print_plan')
562      import
563      type(C_PTR), value :: p
564    end subroutine fftwl_print_plan
565
566    type(C_PTR) function fftwl_sprint_plan(p) bind(C, name='fftwl_sprint_plan')
567      import
568      type(C_PTR), value :: p
569    end function fftwl_sprint_plan
570
571    type(C_PTR) function fftwl_malloc(n) bind(C, name='fftwl_malloc')
572      import
573      integer(C_SIZE_T), value :: n
574    end function fftwl_malloc
575
576    type(C_PTR) function fftwl_alloc_real(n) bind(C, name='fftwl_alloc_real')
577      import
578      integer(C_SIZE_T), value :: n
579    end function fftwl_alloc_real
580
581    type(C_PTR) function fftwl_alloc_complex(n) bind(C, name='fftwl_alloc_complex')
582      import
583      integer(C_SIZE_T), value :: n
584    end function fftwl_alloc_complex
585
586    subroutine fftwl_free(p) bind(C, name='fftwl_free')
587      import
588      type(C_PTR), value :: p
589    end subroutine fftwl_free
590
591    subroutine fftwl_flops(p,add,mul,fmas) bind(C, name='fftwl_flops')
592      import
593      type(C_PTR), value :: p
594      real(C_DOUBLE), intent(out) :: add
595      real(C_DOUBLE), intent(out) :: mul
596      real(C_DOUBLE), intent(out) :: fmas
597    end subroutine fftwl_flops
598
599    real(C_DOUBLE) function fftwl_estimate_cost(p) bind(C, name='fftwl_estimate_cost')
600      import
601      type(C_PTR), value :: p
602    end function fftwl_estimate_cost
603
604    real(C_DOUBLE) function fftwl_cost(p) bind(C, name='fftwl_cost')
605      import
606      type(C_PTR), value :: p
607    end function fftwl_cost
608
609    integer(C_INT) function fftwl_alignment_of(p) bind(C, name='fftwl_alignment_of')
610      import
611      real(C_LONG_DOUBLE), dimension(*), intent(out) :: p
612    end function fftwl_alignment_of
613
614  end interface
615