ScaFaCoS  1.0.1
Scalable Fast Coulomb Solvers
fcs4fortran.f90
Go to the documentation of this file.
1 !
2 ! Copyright (C) 2011, 2012, 2013 Rene Halver, Michael Hofmann
3 !
4 ! This file is part of ScaFaCoS.
5 !
6 ! ScaFaCoS is free software: you can redistribute it and/or modify
7 ! it under the terms of the GNU Lesser Public License as published by
8 ! the Free Software Foundation, either version 3 of the License, or
9 ! (at your option) any later version.
10 !
11 ! ScaFaCoS is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU Lesser Public License for more details.
15 !
16 ! You should have received a copy of the GNU Lesser Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
18 !
19 
20 
21 
22 #ifdef HAVE_FCONFIG_H
23 #include <fconfig.h>
24 #endif
25 
26 #include <fcs_fconfig.h>
27 
28 #include "fcs4fortran_definitions.h"
29 
30 
31 module fcs_module
32 
33  use iso_c_binding
34 
35  implicit none
36 
37  ! boolean data type
38 
39  integer, parameter :: fcs_boolean_kind = fcs_integer_kind
40  integer(kind = fcs_boolean_kind), parameter :: fcs_true = 1
41  integer(kind = fcs_boolean_kind), parameter :: fcs_false = 0
42 
43  ! ScaFaCoS return values
44 
45  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_success = fcs4fortran_success
46  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_null_argument = fcs4fortran_error_null_argument
47  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_alloc_failed = fcs4fortran_error_alloc_failed
48  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_wrong_argument = fcs4fortran_error_wrong_argument
49  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_missing_element = fcs4fortran_error_missing_element
50  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_logical_error = fcs4fortran_error_logical_error
51  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_incompatible_method = fcs4fortran_error_incompatible_method
52  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_not_implemented = fcs4fortran_error_not_implemented
53  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_fortran_call_error = fcs4fortran_error_fortran_call
54  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_error_result_create = fcs4fortran_error_result_create
55 
56  ! definitions of method flags
57 
58  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_none = fcs4fortran_method_none
59  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_direct = fcs4fortran_method_direct
60  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_ewald = fcs4fortran_method_ewald
61  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_fmm = fcs4fortran_method_fmm
62  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_memd = fcs4fortran_method_memd
63  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_mmm1d = fcs4fortran_method_mmm1d
64  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_mmm2d = fcs4fortran_method_mmm2d
65  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_p2nfft = fcs4fortran_method_p2nfft
66  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_p3m = fcs4fortran_method_p3m
67  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_pepc = fcs4fortran_method_pepc
68  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_pp3mg = fcs4fortran_method_pp3mg
69  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_vmg = fcs4fortran_method_vmg
70  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_method_wolf = fcs4fortran_method_wolf
71 
72 #ifdef FCS_ENABLE_FMM
73  ! fmm specific parameter definition
74 
75  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_coulomb = 64
76  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_cusp = 65
77  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_no_dipole_correction = -1
78  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_standard_dipole_correction = 0
79  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_active_dipole_correction = 1
80  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_standard_error = 0
81  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_custom_absolute = 1
82  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_fmm_custom_relative = 2
83 #endif
84 
85  ! length of function names and description messages of the return state
86  integer, parameter :: max_function_length = 64
87  integer, parameter :: max_message_length = 512
88 
89  ! definitions of tolerance type flags
90  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_undefined = 0
91  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_energy = 1
92  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_energy_rel = 2
93  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_potential = 3
94  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_potential_rel = 4
95  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_field = 5
96  integer(kind = fcs_integer_kind_isoc), parameter :: fcs_tolerance_type_field_rel = 6
97 
98  ! interface containing the calls to the wrapper functions in C
99 
100  interface
101 
102 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
103 ! return value handling
104 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
105 
106  subroutine fcs_result_destroy(res) bind(C, name="fcs_result_destroy")
107  use iso_c_binding
108  type(c_ptr), value :: res
109  end subroutine
110 
111  function fcs_result_get_return_code_f(res) bind(C, name="fcs_result_get_return_code")
112  use iso_c_binding
113  implicit none
114  type(c_ptr), value :: res
115  integer(kind = fcs_integer_kind_isoc) :: fcs_result_get_return_code_f
116  end function
117 
118  function fcs_result_get_message_f(res) bind(C, name="fcs_result_get_message")
119  use iso_c_binding
120  import max_message_length
121  implicit none
122  type(c_ptr), value :: res
123  type(c_ptr) :: fcs_result_get_message_f
124  end function
125 
126  function fcs_result_get_function_f(res) bind(C, name="fcs_result_get_function")
127  use iso_c_binding
128  import max_function_length
129  implicit none
130  type(c_ptr), value :: res
131  type(c_ptr) :: fcs_result_get_function_f
132  end function
133 
134 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
135 ! basic ScaFaCoS functions
136 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
137 
138  function fcs_init(handle,method_name,communicator) bind(C,name="fcs_init_f")
139  use iso_c_binding
140  implicit none
141  type(c_ptr) :: handle
142  character(kind = c_char) :: method_name(*)
143  integer, value :: communicator
144  type(c_ptr) :: fcs_init
145  end function
146 
147  function fcs_tune(handle,n_locparts,positions,charges) bind(C,name="fcs_tune")
148  use iso_c_binding
149  implicit none
150  type(c_ptr), value :: handle
151  integer(kind = fcs_integer_kind_isoc),value :: n_locparts
152  real(kind = fcs_real_kind_isoc) :: positions(3*n_locparts)
153  real(kind = fcs_real_kind_isoc) :: charges(n_locparts)
154  type(c_ptr) :: fcs_tune
155  end function
156 
157 
158  function fcs_run(handle,n_locparts,positions,charges,fields,&
159  potentials) bind(C,name="fcs_run")
160  use iso_c_binding
161  implicit none
162  type(c_ptr),value :: handle
163  integer(kind = fcs_integer_kind_isoc),value :: n_locparts
164  real(kind = fcs_real_kind_isoc) :: positions(3*n_locparts)
165  real(kind = fcs_real_kind_isoc) :: charges(n_locparts)
166  real(kind = fcs_real_kind_isoc) :: fields(3*n_locparts)
167  real(kind = fcs_real_kind_isoc) :: potentials(n_locparts)
168  type(c_ptr) :: fcs_run
169  end function
170 
171  function fcs_destroy(handle) bind(C,name="fcs_destroy")
172  use iso_c_binding
173  implicit none
174  type(c_ptr), value :: handle
175  type(c_ptr) :: fcs_destroy
176  end function
177 
178 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
179 ! general parameter handling
180 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
181 
182  function fcs_get_method(handle) bind(C,name="fcs_get_method")
183  use iso_c_binding
184  implicit none
185  type(c_ptr), value :: handle
186  integer(kind = fcs_integer_kind_isoc) :: fcs_get_method
187  end function
188 
189 ! Missing: fcs_get_method_name
190  function fcs_get_communicator(handle) bind(C,name="fcs_get_communicator")
191  use iso_c_binding
192  implicit none
193  type(c_ptr), value :: handle
194  integer :: fcs_get_communicator
195  end function
196 
197  function fcs_set_common_f(handle, near_field_flag, box_a, box_b, box_c, &
198  box_origin, periodicity, total_parts) bind(C,name="fcs_set_common")
199  use iso_c_binding
200  implicit none
201  type(c_ptr),value :: handle
202  integer(kind = fcs_integer_kind_isoc), value :: near_field_flag
203  real(kind = fcs_real_kind_isoc) :: box_a(3)
204  real(kind = fcs_real_kind_isoc) :: box_b(3)
205  real(kind = fcs_real_kind_isoc) :: box_c(3)
206  real(kind = fcs_real_kind_isoc) :: box_origin(3)
207  integer(kind = fcs_integer_kind_isoc) :: periodicity(3)
208  integer(kind = fcs_integer_kind_isoc), value :: total_parts
209  type(c_ptr) :: fcs_set_common_f
210  end function
211 
212  function fcs_set_dimensions(handle, dim_) &
213  bind(c,name="fcs_set_dimensions")
214  use iso_c_binding
215  implicit none
216  type(c_ptr),value :: handle
217  integer(kind = fcs_integer_kind_isoc), value :: dim_
218  type(c_ptr) :: fcs_set_dimensions
219  end function
220 
221  function fcs_get_dimensions(handle) &
222  bind(c,name="fcs_get_dimensions")
223  use iso_c_binding
224  implicit none
225  type(c_ptr),value :: handle
226  integer(kind = fcs_integer_kind_isoc) :: fcs_get_dimensions
227  end function
228 
229  function fcs_set_near_field_flag(handle, near_field_flag) &
230  bind(c,name="fcs_set_near_field_flag")
231  use iso_c_binding
232  implicit none
233  type(c_ptr),value :: handle
234  integer(kind = fcs_integer_kind_isoc),value :: near_field_flag
235  type(c_ptr) :: fcs_set_near_field_flag
236  end function
237 
238  function fcs_get_near_field_flag(handle) &
239  bind(c,name="fcs_get_near_field_flag")
240  use iso_c_binding
241  implicit none
242  type(c_ptr), value :: handle
243  integer(kind = fcs_integer_kind_isoc) :: fcs_get_near_field_flag
244  end function
245 
246  function fcs_set_box_a(handle, box_a) bind(C,name="fcs_set_box_a")
247  use iso_c_binding
248  implicit none
249  type(c_ptr),value :: handle
250  real(kind = fcs_real_kind_isoc) :: box_a(3)
251  type(c_ptr) :: fcs_set_box_a
252  end function
253 
254  ! requires helper function to transform C pointer to Fortran pointer to
255  ! real(3)
256 ! function fcs_get_box_a(handle) BIND(C,name="fcs_get_box_a")
257 ! use iso_c_binding
258 ! implicit none
259 ! type(c_ptr),value :: handle
260 ! real(kind = fcs_real_kind_isoc), dimension(3) :: fcs_get_box_a
261 ! end function
262 
263  function fcs_set_box_b(handle, box_b) bind(C,name="fcs_set_box_b")
264  use iso_c_binding
265  implicit none
266  type(c_ptr),value :: handle
267  real(kind = fcs_real_kind_isoc) :: box_b(3)
268  type(c_ptr) :: fcs_set_box_b
269  end function
270 
271 ! Missing: fcs_get_box_b
272 
273  function fcs_set_box_c(handle, box_c) bind(C,name="fcs_set_box_c")
274  use iso_c_binding
275  implicit none
276  type(c_ptr),value :: handle
277  real(kind = fcs_real_kind_isoc) :: box_c(3)
278  type(c_ptr) :: fcs_set_box_c
279  end function
280 
281 ! Missing: fcs_get_box_c
282 
283  function fcs_set_box_origin(handle, box_origin) bind(C,name="fcs_set_box_origin")
284  use iso_c_binding
285  implicit none
286  type(c_ptr),value :: handle
287  real(kind = fcs_real_kind_isoc) :: box_origin(3)
288  type(c_ptr) :: fcs_set_box_origin
289  end function
290 
291 ! Missing: fcs_get_box_origin
292 
293  function fcs_set_periodicity_f(handle, periodicity) &
294  bind(c,name="fcs_set_periodicity")
295  use iso_c_binding
296  implicit none
297  type(c_ptr),value :: handle
298  integer(kind = fcs_integer_kind_isoc) :: periodicity(3)
299  type(c_ptr) :: fcs_set_periodicity_f
300  end function
301 
302 ! Missing: fcs_get_periodicity_f
303 
304  function fcs_set_total_particles(handle, total_particles) &
305  bind(c,name="fcs_set_total_particles")
306  use iso_c_binding
307  implicit none
308  type(c_ptr),value :: handle
309  integer(kind = fcs_integer_kind_isoc),value :: total_particles
310  type(c_ptr) :: fcs_set_total_particles
311  end function
312 
313  function fcs_get_total_particles(handle) &
314  bind(c,name="fcs_get_total_particles")
315  use iso_c_binding
316  implicit none
317  type(c_ptr),value :: handle
318  integer(kind = fcs_integer_kind_isoc) :: fcs_get_total_particles
319  end function
320 
321  function fcs_set_max_local_particles(handle, max_local_particles) &
322  bind(c,name="fcs_set_max_local_particles")
323  use iso_c_binding
324  implicit none
325  type(c_ptr),value :: handle
326  integer(kind = fcs_integer_kind_isoc),value :: max_local_particles
327  type(c_ptr) :: fcs_set_max_local_particles
328  end function
329 
330  function fcs_get_max_local_particles(handle) &
331  bind(c,name="fcs_get_max_local_particles")
332  use iso_c_binding
333  implicit none
334  type(c_ptr),value :: handle
335  integer(kind = fcs_integer_kind_isoc) :: fcs_get_max_local_particles
336  end function
337 
338  function fcs_set_tolerance(handle, tolerance_type, tolerance) &
339  bind(c,name="fcs_set_tolerance")
340  use iso_c_binding
341  implicit none
342  type(c_ptr),value :: handle
343  integer(kind = fcs_integer_kind_isoc),value :: tolerance_type
344  real(kind = fcs_real_kind_isoc), value :: tolerance
345  type(c_ptr) :: fcs_set_tolerance
346  end function
347 
348 
349  function fcs_get_tolerance(handle,tolerance_type,tolerance) &
350  bind(c,name="fcs_get_tolerance")
351  use iso_c_binding
352  implicit none
353  type(c_ptr), value :: handle
354  integer(kind = fcs_integer_kind_isoc) :: tolerance_type
355  real(kind = fcs_real_kind_isoc), value :: tolerance
356  type(c_ptr) :: fcs_get_tolerance
357  end function
358 
359  function fcs_set_r_cut(handle, r_cut) bind(C,name="fcs_set_r_cut")
360  use iso_c_binding
361  implicit none
362  type(c_ptr), value :: handle
363  real(kind = fcs_real_kind_isoc), value :: r_cut
364  type(c_ptr) :: fcs_set_r_cut
365  end function
366 
367  function fcs_unset_r_cut(handle) bind(C,name="fcs_unset_r_cut")
368  use iso_c_binding
369  implicit none
370  type(c_ptr), value :: handle
371  type(c_ptr) :: fcs_unset_r_cut
372  end function
373 
374  function fcs_get_r_cut(handle, r_cut) bind(C,name="fcs_get_r_cut")
375  use iso_c_binding
376  implicit none
377  type(c_ptr), value :: handle
378  real(kind = fcs_real_kind_isoc) :: r_cut
379  type(c_ptr) :: fcs_get_r_cut
380  end function
381 
382  function fcs_set_parameters(handle,parameters,continue_on_errors) bind(C,name="fcs_set_parameters")
383  use iso_c_binding
384  implicit none
385  type(c_ptr), value :: handle
386  character(kind = c_char) :: parameters(*)
387  type(c_ptr) :: fcs_set_parameters
388  integer(kind = fcs_boolean_kind_isoc) :: continue_on_errors
389  end function
390 
391  subroutine fcs_print_parameters(handle) bind(C,name="fcs_print_parameters")
392  use iso_c_binding
393  implicit none
394  type(c_ptr), value :: handle
395  end subroutine
396 
397 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
398 ! misc functions
399 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
400 
401  function fcs_compute_dipole_correction(handle, local_particles, positions, &
402  charges, epsilon, field_correction, &
403  energy_correction) &
404  bind(c,name="fcs_compute_dipole_correction")
405  use iso_c_binding
406  implicit none
407  type(c_ptr), value :: handle
408  integer(kind = fcs_integer_kind_isoc), value :: local_particles
409  real(kind = fcs_real_kind_isoc), dimension(3*local_particles) :: positions
410  real(kind = fcs_real_kind_isoc), dimension(local_particles) :: charges
411  real(kind = fcs_real_kind_isoc), value :: epsilon
412  real(kind = fcs_real_kind_isoc), dimension(3) :: field_correction
413  real(kind = fcs_real_kind_isoc) :: energy_correction
414  type(c_ptr) :: fcs_compute_dipole_correction
415  end function
416 
417  function fcs_get_near_field_delegation_f(handle, has_near) bind(C,name="fcs_get_near_field_delegation")
418  use iso_c_binding
419  implicit none
420  type(c_ptr), value :: handle
421  integer(kind = fcs_integer_kind_isoc) :: has_near
422  type(c_ptr) :: fcs_get_near_field_delegation_f
423  end function
424 
425  function fcs_compute_near(handle, dist, pot, field) bind(C,name="fcs_compute_near")
426  use iso_c_binding
427  implicit none
428  type(c_ptr), value :: handle
429  real(kind = fcs_real_kind_isoc), value :: dist
430  real(kind = fcs_real_kind_isoc) :: pot
431  real(kind = fcs_real_kind_isoc) :: field
432  type(c_ptr) :: fcs_compute_near
433  end function
434 
435  function fcs_compute_near_potential(handle, dist, pot) bind(C,name="fcs_compute_near_potential")
436  use iso_c_binding
437  implicit none
438  type(c_ptr), value :: handle
439  real(kind = fcs_real_kind_isoc), value :: dist
440  real(kind = fcs_real_kind_isoc) :: pot
441  type(c_ptr) :: fcs_compute_near_potential
442  end function
443 
444  function fcs_compute_near_field(handle, dist, field) bind(C,name="fcs_compute_near_field")
445  use iso_c_binding
446  implicit none
447  type(c_ptr), value :: handle
448  real(kind = fcs_real_kind_isoc), value :: dist
449  real(kind = fcs_real_kind_isoc) :: field
450  type(c_ptr) :: fcs_compute_near_field
451  end function
452 
453  function fcs_set_compute_virial_f(handle, flag) bind(C,name="fcs_set_compute_virial")
454  use iso_c_binding
455  implicit none
456  type(c_ptr), value :: handle
457  integer(kind = fcs_integer_kind_isoc),value :: flag
458  type(c_ptr) :: fcs_set_compute_virial_f
459  end function
460 
461 ! Missing: fcs_get_compute_virial
462 
463  function fcs_get_virial(handle, virial) bind(C,name="fcs_get_virial")
464  use iso_c_binding
465  implicit none
466  type(c_ptr), value :: handle
467  real(kind = fcs_real_kind_isoc) :: virial(9)
468  type(c_ptr) :: fcs_get_virial
469  end function
470 
471 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
472 ! method specific setups
473 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
474 
475 #ifdef FCS_ENABLE_DIRECT
476  function fcs_direct_setup(handle, cutoff) &
477  bind(c,name="fcs_direct_setup")
478  use iso_c_binding
479  implicit none
480  type(c_ptr),value :: handle
481  real(kind = fcs_real_kind_isoc),value :: cutoff
482  type(c_ptr) :: fcs_direct_setup
483  end function
484 #endif
485 #ifdef FCS_ENABLE_EWALD
486  function fcs_ewald_set_tolerance_field_abs(handle, tolerance_field_abs) &
487  bind(c,name="fcs_ewald_set_tolerance_field_abs")
488  use iso_c_binding
489  implicit none
490  type(c_ptr),value :: handle
491  real(kind = fcs_real_kind_isoc),value :: tolerance_field_abs
492  type(c_ptr) :: fcs_ewald_set_tolerance_field_abs
493  end function
494 #endif
495 #ifdef FCS_ENABLE_FMM
496  function fcs_fmm_setup(handle, absrel, energy_tolerance, dipole_correction, system, maxdepth, unroll_limit, balanceload) &
497  bind(c,name="fcs_fmm_setup")
498  use iso_c_binding
499  implicit none
500  type(c_ptr),value :: handle
501  integer(kind = fcs_integer_kind_isoc), value :: absrel
502  real(kind = fcs_real_kind_isoc), value :: energy_tolerance
503  integer(kind = fcs_integer_kind_isoc), value :: dipole_correction
504  integer(kind = c_long_long), value :: system
505  integer(kind = c_long_long), value :: maxdepth
506  integer(kind = c_long_long), value :: unroll_limit
507  integer(kind = c_long_long), value :: balanceload
508  type(c_ptr) :: fcs_fmm_setup
509  end function
510 #endif
511 #ifdef FCS_ENABLE_PEPC
512  function fcs_pepc_setup(handle, epsilon, theta, level) &
513  bind(c,name="fcs_pepc_setup")
514  use iso_c_binding
515  implicit none
516  type(c_ptr),value :: handle
517  real(kind = fcs_real_kind_isoc), value :: epsilon
518  real(kind = fcs_real_kind_isoc), value :: theta
519  integer(kind = fcs_integer_kind_isoc), value :: level
520  type(c_ptr) :: fcs_pepc_setup
521  end function
522 #endif
523 
524 #ifdef FCS_ENABLE_VMG
525  function fcs_vmg_setup(handle, max_level, max_iterations, smooth_steps, &
526  gamma, precision, near_field_cells) &
527  bind(c,name="fcs_vmg_setup")
528  use iso_c_binding
529  implicit none
530  type(c_ptr),value :: handle
531  integer(kind = fcs_integer_kind_isoc), value :: max_level
532  integer(kind = fcs_integer_kind_isoc), value :: max_iterations
533  integer(kind = fcs_integer_kind_isoc), value :: smooth_steps
534  integer(kind = fcs_integer_kind_isoc), value :: gamma
535  integer(kind = fcs_integer_kind_isoc), value :: near_field_cells
536  real(kind = fcs_real_kind_isoc), value :: precision
537 
538  type(c_ptr) :: fcs_vmg_setup
539  end function
540 #endif
541 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
542 ! method-specific getters and setters
543 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
544 
545 #ifdef FCS_ENABLE_DIRECT
546 
547  function fcs_direct_set_cutoff(handle, cutoff) &
548  bind(c,name="fcs_direct_set_cutoff")
549  use iso_c_binding
550  implicit none
551  type(c_ptr), value :: handle
552  real(kind = fcs_real_kind_isoc), value :: cutoff
553  type(c_ptr) :: fcs_direct_set_cutoff
554  end function
555 
556  function fcs_direct_get_cutoff(handle, cutoff) &
557  bind(c,name="fcs_direct_get_cutoff")
558  use iso_c_binding
559  implicit none
560  type(c_ptr), value :: handle
561  real(kind = fcs_real_kind_isoc) :: cutoff
562  type(c_ptr) :: fcs_direct_get_cutoff
563  end function
564 #endif
565 #ifdef FCS_ENABLE_FMM
566  function fcs_fmm_set_absrel(handle, absrel) &
567  bind(c,name="fcs_fmm_set_absrel")
568  use iso_c_binding
569  implicit none
570  type(c_ptr), value :: handle
571  integer(kind = fcs_integer_kind_isoc), value :: absrel
572  type(c_ptr) :: fcs_fmm_set_absrel
573  end function
574 
575  function fcs_fmm_get_absrel(handle, absrel) &
576  bind(c,name="fcs_fmm_get_absrel")
577  use iso_c_binding
578  implicit none
579  type(c_ptr), value :: handle
580  integer(kind = fcs_integer_kind_isoc) :: absrel
581  type(c_ptr) :: fcs_fmm_get_absrel
582  end function
583 
584  function fcs_fmm_set_dipole_correction(handle, dipole_correction) &
585  bind(c,name="fcs_fmm_set_dipole_correction")
586  use iso_c_binding
587  implicit none
588  type(c_ptr), value :: handle
589  integer(kind = fcs_integer_kind_isoc), value :: dipole_correction
590  type(c_ptr) :: fcs_fmm_set_dipole_correction
591  end function
592 
593  function fcs_fmm_get_dipole_correction(handle, dipole_correction) &
594  bind(c,name="fcs_fmm_get_dipole_correction")
595  use iso_c_binding
596  implicit none
597  type(c_ptr), value :: handle
598  integer(kind = fcs_integer_kind_isoc) :: dipole_correction
599  type(c_ptr) :: fcs_fmm_get_dipole_correction
600  end function
601 
602  function fcs_fmm_set_potential(handle, potential) &
603  bind(c,name="fcs_fmm_set_potential")
604  use iso_c_binding
605  implicit none
606  type(c_ptr), value :: handle
607  integer(kind = fcs_integer_kind_isoc), value :: potential
608  type(c_ptr) :: fcs_fmm_set_potential
609  end function
610 
611  function fcs_fmm_get_potential(handle, potential) &
612  bind(c,name="fcs_fmm_get_potential")
613  use iso_c_binding
614  implicit none
615  type(c_ptr), value :: handle
616  integer(kind = fcs_integer_kind_isoc) :: potential
617  type(c_ptr) :: fcs_fmm_get_potential
618  end function
619 
620  function fcs_fmm_set_cusp_radius(handle, cusp_radius) &
621  bind(c,name="fcs_fmm_set_cusp_radius")
622  use iso_c_binding
623  implicit none
624  type(c_ptr), value :: handle
625  real(kind = fcs_real_kind_isoc), value :: cusp_radius
626  type(c_ptr) :: fcs_fmm_set_cusp_radius
627  end function
628 
629  function fcs_fmm_get_cusp_radius(handle, cusp_radius) &
630  bind(c,name="fcs_fmm_get_cusp_radius")
631  use iso_c_binding
632  implicit none
633  type(c_ptr), value :: handle
634  real(kind = fcs_real_kind_isoc) :: cusp_radius
635  type(c_ptr) :: fcs_fmm_get_cusp_radius
636  end function
637 
638  function fcs_fmm_set_tolerance_energy(handle, tolerance) &
639  bind(c,name="fcs_fmm_set_tolerance_energy")
640  use iso_c_binding
641  implicit none
642  type(c_ptr), value :: handle
643  real(kind = fcs_real_kind_isoc), value :: tolerance
644  type(c_ptr) :: fcs_fmm_set_tolerance_energy
645  end function
646 
647  function fcs_fmm_get_tolerance_energy(handle, tolerance) &
648  bind(c,name="fcs_fmm_get_tolerance_energy")
649  use iso_c_binding
650  implicit none
651  type(c_ptr), value :: handle
652  real(kind = fcs_real_kind_isoc) :: tolerance
653  type(c_ptr) :: fcs_fmm_get_tolerance_energy
654  end function
655 
656  function fcs_fmm_set_maxdepth(handle, maxdepth) &
657  bind(c,name="fcs_fmm_set_maxdepth")
658  use iso_c_binding
659  implicit none
660  type(c_ptr), value :: handle
661  integer(kind = c_long_long), value :: maxdepth
662  type(c_ptr) :: fcs_fmm_set_maxdepth
663  end function
664 
665  function fcs_fmm_get_maxdepth(handle, maxdepth) &
666  bind(c,name="fcs_fmm_get_maxdepth")
667  use iso_c_binding
668  implicit none
669  type(c_ptr), value :: handle
670  integer(kind = c_long_long), value :: maxdepth
671  type(c_ptr) :: fcs_fmm_get_maxdepth
672  end function
673 
674  function fcs_fmm_set_unroll_limit(handle, unroll_limit) &
675  bind(c,name="fcs_fmm_set_unroll_limit")
676  use iso_c_binding
677  implicit none
678  type(c_ptr), value :: handle
679  integer(kind = c_long_long), value :: unroll_limit
680  type(c_ptr) :: fcs_fmm_set_unroll_limit
681  end function
682 
683  function fcs_fmm_get_unroll_limit(handle, unroll_limit) &
684  bind(c,name="fcs_fmm_get_unroll_limit")
685  use iso_c_binding
686  implicit none
687  type(c_ptr), value :: handle
688  integer(kind = c_long_long), value :: unroll_limit
689  type(c_ptr) :: fcs_fmm_get_unroll_limit
690  end function
691 
692  function fcs_fmm_set_balanceload(handle, balanceload) &
693  bind(c,name="fcs_fmm_set_balanceload")
694  use iso_c_binding
695  implicit none
696  type(c_ptr), value :: handle
697  integer(kind = c_long_long), value :: balanceload
698  type(c_ptr) :: fcs_fmm_set_balanceload
699  end function
700 
701  function fcs_fmm_get_balanceload(handle, balanceload) &
702  bind(c,name="fcs_fmm_get_balanceload")
703  use iso_c_binding
704  implicit none
705  type(c_ptr), value :: handle
706  integer(kind = c_long_long), value :: balanceload
707  type(c_ptr) :: fcs_fmm_get_balanceload
708  end function
709 
710  function fcs_fmm_set_internal_tuning(handle, tuning) &
711  bind(c,name="fcs_fmm_set_internal_tuning")
712  use iso_c_binding
713  implicit none
714  type(c_ptr), value :: handle
715  integer(kind = c_long_long), value :: tuning
716  type(c_ptr) :: fcs_fmm_set_internal_tuning
717  end function
718 
719  function fcs_fmm_get_internal_tuning(handle, tuning) &
720  bind(c,name="fcs_fmm_get_internal_tuning")
721  use iso_c_binding
722  implicit none
723  type(c_ptr), value :: handle
724  integer(kind = c_long_long), value :: tuning
725  type(c_ptr) :: fcs_fmm_get_internal_tuning
726  end function
727 
728 #endif
729 #ifdef FCS_ENABLE_MEMD
730  function fcs_memd_set_periodicity(handle, periodicity) &
731  bind(c,name="fcs_memd_set_periodicity")
732  use iso_c_binding
733  implicit none
734  type(c_ptr), value :: handle
735  integer(kind = fcs_integer_kind_isoc), value :: periodicity
736  type(c_ptr) :: fcs_memd_set_periodicity
737  end function
738 
739  function fcs_memd_get_periodicity(handle, periodicity) &
740  bind(c,name="fcs_memd_get_periodicity")
741  use iso_c_binding
742  implicit none
743  type(c_ptr), value :: handle
744  integer(kind = fcs_integer_kind_isoc) :: periodicity
745  type(c_ptr) :: fcs_memd_get_periodicity
746  end function
747 #endif
748 #ifdef FCS_ENABLE_MMM1D
749  function fcs_mmm1d_set_far_switch_radius(handle, radius) &
750  bind(c,name="fcs_mmm1d_set_far_switch_radius")
751  use iso_c_binding
752  implicit none
753  type(c_ptr), value :: handle
754  real(kind = fcs_real_kind_isoc), value :: radius
755  type(c_ptr) :: fcs_mmm1d_set_far_switch_radius
756  end function
757 
758  function fcs_mmm1d_get_far_switch_radius(handle, radius) &
759  bind(c,name="fcs_mmm1d_get_far_switch_radius")
760  use iso_c_binding
761  implicit none
762  type(c_ptr), value :: handle
763  real(kind = fcs_real_kind_isoc) :: radius
764  type(c_ptr) :: fcs_mmm1d_get_far_switch_radius
765  end function
766 
767  function fcs_mmm1d_set_maxpwerror(handle, error) &
768  bind(c,name="fcs_mmm1d_set_maxPWerror")
769  use iso_c_binding
770  implicit none
771  type(c_ptr), value :: handle
772  real(kind = fcs_real_kind_isoc), value :: error
773  type(c_ptr) :: fcs_mmm1d_set_maxPWerror
774  end function
775 
776  function fcs_mmm1d_get_maxpwerror(handle, error) &
777  bind(c,name="fcs_mmm1d_get_maxPWerror")
778  use iso_c_binding
779  implicit none
780  type(c_ptr), value :: handle
781  real(kind = fcs_real_kind_isoc) :: error
782  type(c_ptr) :: fcs_mmm1d_get_maxPWerror
783  end function
784 
785  function fcs_mmm1d_set_coulomb_prefactor(handle, prefac) &
786  bind(c,name="fcs_mmm1d_set_coulomb_prefactor")
787  use iso_c_binding
788  implicit none
789  type(c_ptr), value :: handle
790  real(kind = fcs_real_kind_isoc), value :: prefac
791  type(c_ptr) :: fcs_mmm1d_set_coulomb_prefactor
792  end function
793 
794  function fcs_mmm1d_get_coulomb_prefactor(handle, prefac) &
795  bind(c,name="fcs_mmm1d_get_coulomb_prefactor")
796  use iso_c_binding
797  implicit none
798  type(c_ptr), value :: handle
799  real(kind = fcs_real_kind_isoc) :: prefac
800  type(c_ptr) :: fcs_mmm1d_get_coulomb_prefactor
801  end function
802 
803  function fcs_mmm1d_set_bessel_cutoff(handle, cutoff) &
804  bind(c,name="fcs_mmm1d_set_bessel_cutoff")
805  use iso_c_binding
806  implicit none
807  type(c_ptr), value :: handle
808  integer(kind = fcs_integer_kind_isoc), value :: cutoff
809  type(c_ptr) :: fcs_mmm1d_set_bessel_cutoff
810  end function
811 
812  function fcs_mmm1d_get_bessel_cutoff(handle, cutoff) &
813  bind(c,name="fcs_mmm1d_get_bessel_cutoff")
814  use iso_c_binding
815  implicit none
816  type(c_ptr), value :: handle
817  integer(kind = fcs_integer_kind_isoc) :: cutoff
818  type(c_ptr) :: fcs_mmm1d_get_bessel_cutoff
819  end function
820 #endif
821 #ifdef FCS_ENABLE_P2NFFT
822  function fcs_p2nfft_set_required_accuracy(handle, required_accuracy) &
823  bind(c,name="fcs_p2nfft_set_required_accuracy")
824  use iso_c_binding
825  implicit none
826  type(c_ptr),value :: handle
827  real(kind = fcs_real_kind_isoc),value :: required_accuracy
828  type(c_ptr) :: fcs_p2nfft_set_required_accuracy
829  end function
830 #endif
831 
832 #ifdef FCS_ENABLE_P3M
833  function fcs_p3m_set_tolerance_field_abs(handle, tolerance_field_abs) &
834  bind(c,name="fcs_p3m_set_tolerance_field_abs")
835  use iso_c_binding
836  implicit none
837  type(c_ptr),value :: handle
838  real(kind = fcs_real_kind_isoc),value :: tolerance_field_abs
839  type(c_ptr) :: fcs_p3m_set_tolerance_field_abs
840  end function
841 #endif
842 
843 #ifdef FCS_ENABLE_VMG
844  function fcs_vmg_set_gamma(handle, gamma) &
845  bind(c,name="fcs_vmg_set_gamma")
846  use iso_c_binding
847  implicit none
848  type(c_ptr),value :: handle
849  integer(kind = fcs_integer_kind_isoc),value :: gamma
850  type(c_ptr) :: fcs_vmg_set_gamma
851  end function
852 
853  function fcs_vmg_get_gamma(handle,gamma) &
854  bind(c,name="fcs_vmg_get_gamma")
855  use iso_c_binding
856  implicit none
857  type(c_ptr), value :: handle
858  integer(kind = fcs_integer_kind_isoc) :: gamma
859  type(c_ptr) :: fcs_vmg_get_gamma
860  end function
861 
862  function fcs_vmg_set_max_iterations(handle, max_iterations) &
863  bind(c,name="fcs_vmg_set_max_iterations")
864  use iso_c_binding
865  implicit none
866  type(c_ptr),value :: handle
867  integer(kind = fcs_integer_kind_isoc),value :: max_iterations
868  type(c_ptr) :: fcs_vmg_set_max_iterations
869  end function
870 
871  function fcs_vmg_get_max_iterations(handle,max_iterations) &
872  bind(c,name="fcs_vmg_get_max_iterations")
873  use iso_c_binding
874  implicit none
875  type(c_ptr), value :: handle
876  integer(kind = fcs_integer_kind_isoc) :: max_iterations
877  type(c_ptr) :: fcs_vmg_get_max_iterations
878  end function
879 
880  function fcs_vmg_set_max_level(handle, max_level) &
881  bind(c,name="fcs_vmg_set_max_level")
882  use iso_c_binding
883  implicit none
884  type(c_ptr),value :: handle
885  integer(kind = fcs_integer_kind_isoc),value :: max_level
886  type(c_ptr) :: fcs_vmg_set_max_level
887  end function
888 
889  function fcs_vmg_get_max_level(handle,max_level) &
890  bind(c,name="fcs_vmg_get_max_level")
891  use iso_c_binding
892  implicit none
893  type(c_ptr), value :: handle
894  integer(kind = fcs_integer_kind_isoc) :: max_level
895  type(c_ptr) :: fcs_vmg_get_max_level
896  end function
897 
898  function fcs_vmg_set_near_field_cells(handle, near_field_cells) &
899  bind(c,name="fcs_vmg_set_near_field_cells")
900  use iso_c_binding
901  implicit none
902  type(c_ptr),value :: handle
903  integer(kind = fcs_integer_kind_isoc),value :: near_field_cells
904  type(c_ptr) :: fcs_vmg_set_near_field_cells
905  end function
906 
907  function fcs_vmg_get_near_field_cells(handle,near_field_cells) &
908  bind(c,name="fcs_vmg_get_near_field_cells")
909  use iso_c_binding
910  implicit none
911  type(c_ptr), value :: handle
912  integer(kind = fcs_integer_kind_isoc) :: near_field_cells
913  type(c_ptr) :: fcs_vmg_get_near_field_cells
914  end function
915 
916  function fcs_vmg_set_precision(handle, prec) &
917  bind(c,name="fcs_vmg_set_precision")
918  use iso_c_binding
919  implicit none
920  type(c_ptr),value :: handle
921  real(kind = fcs_real_kind_isoc),value :: prec
922  type(c_ptr) :: fcs_vmg_set_precision
923  end function
924 
925  function fcs_vmg_get_precision(handle,prec) &
926  bind(c,name="fcs_vmg_get_precision")
927  use iso_c_binding
928  implicit none
929  type(c_ptr), value :: handle
930  real(kind = fcs_real_kind_isoc) :: prec
931  type(c_ptr) :: fcs_vmg_get_precision
932  end function
933 
934  function fcs_vmg_set_smoothing_steps(handle, smoothing_steps) &
935  bind(c,name="fcs_vmg_set_smoothing_steps")
936  use iso_c_binding
937  implicit none
938  type(c_ptr),value :: handle
939  integer(kind = fcs_integer_kind_isoc),value :: smoothing_steps
940  type(c_ptr) :: fcs_vmg_set_smoothing_steps
941  end function
942 
943  function fcs_vmg_get_smoothing_steps(handle,smoothing_steps) &
944  bind(c,name="fcs_vmg_get_smoothing_steps")
945  use iso_c_binding
946  implicit none
947  type(c_ptr), value :: handle
948  integer(kind = fcs_integer_kind_isoc) :: smoothing_steps
949  type(c_ptr) :: fcs_vmg_get_smoothing_steps
950  end function
951 
952 #endif
953  end interface
954 
955 
956 
957 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
958 ! definitions for FORTRAN interface
959 ! (the functions / subroutines where data must
960 ! be converted in FORTRAN, before being passed
961 ! to C)
962 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
963 
964  contains
965 
966  function fcs_result_get_return_code(res)
967  use iso_c_binding
968  implicit none
969  type(c_ptr), target :: res
970  integer(kind = fcs_integer_kind_isoc) :: fcs_result_get_return_code
971 
972  if (c_associated(res)) then
973  fcs_result_get_return_code = fcs_result_get_return_code_f(res)
974  else
975  fcs_result_get_return_code = fcs_success
976  end if
977 
978  end function
979 
980  function fcs_result_get_message(res)
981  use iso_c_binding
982  implicit none
983  type(c_ptr), target :: res
984  character(kind = c_char, len = MAX_MESSAGE_LENGTH) :: fcs_result_get_message
985  character(kind = c_char, len = MAX_MESSAGE_LENGTH), dimension(:),pointer :: message
986  type(c_ptr) :: c_str
987 
988  if (c_associated(res)) then
989  c_str = fcs_result_get_message_f(res)
990  call c_f_pointer(cptr = c_str, fptr = message, shape = [1])
991  fcs_result_get_message = message(1)
992  if ( fcs_get_position_char(fcs_result_get_message,c_null_char) == 1) then
993  fcs_result_get_message = "no specific error message availiable"
994  else
995  fcs_result_get_message = fcs_result_get_message(1:fcs_get_position_char(fcs_result_get_message,c_null_char)-1)
996  end if
997  else
998  fcs_result_get_message = "call successful"
999  end if
1000  end function
1001 
1002  function fcs_result_get_function(res)
1003  use iso_c_binding
1004  implicit none
1005  type(c_ptr), target :: res
1006  character(kind = c_char, len = MAX_MESSAGE_LENGTH) :: fcs_result_get_function
1007  character(kind = c_char, len = MAX_MESSAGE_LENGTH), dimension(:), pointer :: message
1008  type(c_ptr) :: c_str
1009 
1010  if (c_associated(res)) then
1011  c_str = fcs_result_get_function_f(res)
1012  call c_f_pointer(cptr = c_str, fptr = message, shape = [1])
1013  fcs_result_get_function = message(1)
1014  if ( fcs_get_position_char(fcs_result_get_function,c_null_char) == 1) then
1015  fcs_result_get_function = "no specific error source availiable"
1016  else
1017  fcs_result_get_function = fcs_result_get_function(1:fcs_get_position_char(fcs_result_get_function,c_null_char)-1)
1018  end if
1019  else
1020  fcs_result_get_function = ""
1021  end if
1022 
1023  end function
1024 
1025  function fcs_set_common(handle, near_field_flag, box_a, box_b, box_c, &
1026  box_origin, periodicity, total_parts)
1027  use iso_c_binding
1028  implicit none
1029  type(c_ptr) :: handle
1030  logical :: near_field_flag
1031  real(kind = fcs_real_kind_isoc) :: box_a(3)
1032  real(kind = fcs_real_kind_isoc) :: box_b(3)
1033  real(kind = fcs_real_kind_isoc) :: box_c(3)
1034  real(kind = fcs_real_kind_isoc) :: box_origin(3)
1035  logical :: periodicity(3)
1036  integer(kind = fcs_integer_kind_isoc) :: total_parts
1037  integer(kind = fcs_integer_kind_isoc) :: p_c(3)
1038  integer(kind = fcs_integer_kind_isoc) :: srf_c
1039  type(c_ptr) :: fcs_set_common
1040 
1041  where (periodicity)
1042  p_c = 1
1043  elsewhere
1044  p_c = 0
1045  end where
1046 
1047  if (near_field_flag) then
1048  srf_c = 1
1049  else
1050  srf_c = 0
1051  end if
1052 
1053  fcs_set_common = fcs_set_common_f(handle, srf_c, box_a, box_b, box_c, box_origin, p_c, total_parts)
1054  end function
1055 
1056  function fcs_set_periodicity(handle, periodicity)
1057  use iso_c_binding
1058  implicit none
1059  type(c_ptr) :: handle
1060  integer(kind = fcs_integer_kind_isoc) :: p_c(3)
1061  logical :: periodicity(3)
1062  type(c_ptr) :: fcs_set_periodicity
1063 
1064  where (periodicity)
1065  p_c = 1
1066  elsewhere
1067  p_c = 0
1068  end where
1069 
1070  fcs_set_periodicity = fcs_set_periodicity_f(handle, p_c)
1071  end function
1072 
1073 
1074  function fcs_set_compute_virial(handle, flag)
1075  use iso_c_binding
1076  implicit none
1077  type(c_ptr) :: handle
1078  logical :: flag
1079  type(c_ptr) :: fcs_set_compute_virial
1080  integer(kind = fcs_integer_kind_isoc) :: c_flag
1081 
1082  if (flag) then
1083  c_flag = 1
1084  else
1085  c_flag = 0
1086  end if
1087 
1088  fcs_set_compute_virial = fcs_set_compute_virial_f(handle, c_flag)
1089  end function
1090 
1091  function fcs_get_near_field_delegation(handle, has_near)
1092  use iso_c_binding
1093  implicit none
1094  type(c_ptr), value :: handle
1095  logical :: has_near
1096  type(c_ptr) :: fcs_get_near_field_delegation
1097  integer(kind = fcs_integer_kind_isoc) :: c_has_near
1098 
1099  fcs_get_near_field_delegation = fcs_get_near_field_delegation_f(handle,c_has_near)
1100  if (c_has_near == 0) then
1101  has_near = .false.
1102  else
1103  has_near = .true.
1104  end if
1105 
1106  end function
1107 
1108 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1109 ! helper function
1110 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1111  function fcs_get_position_char(str,c) result(idx)
1112  use iso_c_binding
1113  implicit none
1114  character(kind = c_char, len = *) :: str
1115  character(kind = c_char) :: c
1116  integer :: idx
1117  integer :: i
1118 
1119  do i = 1,len(str)
1120  if (str(i:i) == c) then
1121  idx = i
1122  exit
1123  end if
1124  end do
1125  end function
1126 
1127 
1128 end module fcs_module
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_pp3mg
Definition: fcs4fortran.f90:68
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_no_dipole_correction
Definition: fcs4fortran.f90:77
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_energy
Definition: fcs4fortran.f90:91
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_vmg
Definition: fcs4fortran.f90:69
integer, parameter max_message_length
Definition: fcs4fortran.f90:87
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_coulomb
Definition: fcs4fortran.f90:75
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_alloc_failed
Definition: fcs4fortran.f90:47
FCSResult fcs_get_near_field_delegation(FCS handle, fcs_int *near_field_delegation)
function to return whether the solver method supports the delegation of near-field computations to an...
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_custom_absolute
Definition: fcs4fortran.f90:81
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_mmm2d
Definition: fcs4fortran.f90:64
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_incompatible_method
Definition: fcs4fortran.f90:51
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_potential_rel
Definition: fcs4fortran.f90:94
FCSResult fcs_set_common(FCS handle, fcs_int near_field_flag, const fcs_float *box_a, const fcs_float *box_b, const fcs_float *box_c, const fcs_float *box_origin, const fcs_int *periodicity, fcs_int total_particles)
function to set all obligatory parameters for an FCS solver
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_field_rel
Definition: fcs4fortran.f90:96
fcs_int fcs_result_get_return_code(FCSResult result)
function to return the return code associated with an return state
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_wrong_argument
Definition: fcs4fortran.f90:48
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_mmm1d
Definition: fcs4fortran.f90:63
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_standard_dipole_correction
Definition: fcs4fortran.f90:78
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_energy_rel
Definition: fcs4fortran.f90:92
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_logical_error
Definition: fcs4fortran.f90:50
const char * fcs_result_get_function(FCSResult result)
function to return the function name associated with an return state
const char * fcs_result_get_message(FCSResult result)
function to return the description message associated with an return state
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_direct
Definition: fcs4fortran.f90:59
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_missing_element
Definition: fcs4fortran.f90:49
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_not_implemented
Definition: fcs4fortran.f90:52
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_result_create
Definition: fcs4fortran.f90:54
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_fortran_call_error
Definition: fcs4fortran.f90:53
integer, parameter fcs_boolean_kind
Definition: fcs4fortran.f90:39
integer(kind=fcs_boolean_kind), parameter fcs_true
Definition: fcs4fortran.f90:40
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_custom_relative
Definition: fcs4fortran.f90:82
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_p2nfft
Definition: fcs4fortran.f90:65
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_wolf
Definition: fcs4fortran.f90:70
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_pepc
Definition: fcs4fortran.f90:67
integer function fcs_get_position_char(str, c)
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_fmm
Definition: fcs4fortran.f90:61
integer(kind=fcs_integer_kind_isoc), parameter fcs_error_null_argument
Definition: fcs4fortran.f90:46
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_potential
Definition: fcs4fortran.f90:93
FCSResult fcs_set_periodicity(FCS handle, const fcs_int *periodicity)
function to set the periodicity of the system
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_p3m
Definition: fcs4fortran.f90:66
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_standard_error
Definition: fcs4fortran.f90:80
FCSResult fcs_set_compute_virial(FCS handle, fcs_int compute_virial)
function to set whether the virial should be computed
integer(kind=fcs_boolean_kind), parameter fcs_false
Definition: fcs4fortran.f90:41
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_active_dipole_correction
Definition: fcs4fortran.f90:79
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_none
Definition: fcs4fortran.f90:58
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_undefined
Definition: fcs4fortran.f90:90
integer(kind=fcs_integer_kind_isoc), parameter fcs_tolerance_type_field
Definition: fcs4fortran.f90:95
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_ewald
Definition: fcs4fortran.f90:60
integer, parameter max_function_length
Definition: fcs4fortran.f90:86
integer(kind=fcs_integer_kind_isoc), parameter fcs_method_memd
Definition: fcs4fortran.f90:62
integer(kind=fcs_integer_kind_isoc), parameter fcs_fmm_cusp
Definition: fcs4fortran.f90:76
integer(kind=fcs_integer_kind_isoc), parameter fcs_success
Definition: fcs4fortran.f90:45