ddx 0.6.0
Libary for domain-decomposition methods for polarizable continuum models
ddx_cinterface.f90
1module ddx_cinterface
2 use, intrinsic :: iso_c_binding
3 use ddx
4 implicit none
5
7 type(ddx_params_type) :: params
8 type(ddx_constants_type) :: constants
9 type(ddx_workspace_type) :: workspace
10 end type ddx_setup_type
11
12contains
13!
14! Generic stuff
15!
16subroutine ddx_get_banner(message, maxlen) bind(C)
17 integer(c_int), intent(in), value :: maxlen
18 character(len=1, kind=C_char), intent(out) :: message(maxlen)
19 integer :: length, i
20 character (len=4095) :: header
21 call get_banner(header)
22 message(maxlen) = c_null_char
23 length = min(maxlen-1, 4095)
24 do i = length, 1, -1
25 if (header(i:i) .eq. ' ') then
26 length = i-1
27 else
28 exit
29 endif
30 enddo
31 message(length + 1) = c_null_char
32 do i = 1, length
33 message(i) = header(i:i)
34 enddo
35end
36
37function ddx_supported_lebedev_grids(n, grids) result(c_ngrids) bind(C)
38 integer(c_int), intent(in), value :: n
39 integer(c_int), intent(out) :: grids(n)
40 integer(c_int) :: c_ngrids
41 c_ngrids = min(n, nllg)
42 grids(1:c_ngrids) = ng0(1:c_ngrids)
43end
44
45! With reference to a atomic sphere `sphere` of radius `r` centred at `a` compute:
46! 4π |x - a|^l
47! ------ ----------- Y_l^m(|x - a|)
48! 2l + 1 r^l
49! lmax should be identical to the value stored inside c_ddx or less.
50subroutine ddx_scaled_ylm(c_ddx, lmax, x, sphere, ylm) bind(C)
51 type(c_ptr), intent(in), value :: c_ddx
52 integer(c_int), intent(in), value :: lmax
53 real(c_double), intent(in) :: x(3)
54 integer(c_int), intent(in), value :: sphere
55 real(c_double), intent(out) :: ylm((lmax+1)**2)
56 real(dp) :: delta(3)
57 real(dp) :: ratio, rho, ctheta, stheta, cphi, sphi, dnorm
58 real(dp) :: vplm((lmax+1)**2), vcos(lmax+1), vsin(lmax+1)
59 double precision, external :: dnrm2
60 integer :: ind, m, l
61 type(ddx_setup_type), pointer :: ddx_model
62 call c_f_pointer(c_ddx, ddx_model)
63
64 associate(rsph => ddx_model%params%rsph, lmax => ddx_model%params%lmax, vscales => ddx_model%constants%vscales)
65 delta = x(:) - ddx_model%params%csph(:, sphere)
66 dnorm = dnrm2(3, delta, 1)
67 delta = delta / dnorm
68 call ylmbas(delta, rho, ctheta, stheta, cphi, sphi, lmax, vscales, ylm, vplm, vcos, vsin)
69 do l = 0, lmax
70 ratio = ddx_model%constants%v4pi2lp1(l+1) * (dnorm / rsph(sphere))**l
71 do m = -l, l
72 ind = l*(l+1) + m + 1
73 ylm(ind) = ylm(ind) * ratio
74 enddo
75 enddo
76 end associate
77end
78
79!
80! Error
81!
82
83function ddx_allocate_error() result(c_error) bind(C)
84 type(c_ptr) :: c_error
85 type(ddx_error_type), pointer :: ddx_error
86 allocate(ddx_error)
87 c_error = c_loc(ddx_error)
88end function
89
90function ddx_get_error_flag(c_error) result(has_error) bind(C)
91 type(c_ptr), intent(in), value :: c_error
92 type(ddx_error_type), pointer :: ddx_error
93 integer(c_int) :: has_error
94 call c_f_pointer(c_error, ddx_error)
95 has_error = ddx_error%flag
96end
97
98subroutine ddx_get_error_message(c_error, message, maxlen) bind(C)
99 type(c_ptr), intent(in), value :: c_error
100 integer(c_int), intent(in), value :: maxlen
101 character(len=1, kind=C_char), intent(out) :: message(maxlen)
102 character(len=2047) :: error_message
103 type(ddx_error_type), pointer :: ddx_error
104 integer :: length, i
105 call c_f_pointer(c_error, ddx_error)
106 if (ddx_error%flag .ne. 0) then
107 error_message = ddx_error%message
108 else
109 error_message = ''
110 endif
111
112 ! Convert to C message
113 message(maxlen) = c_null_char
114 length = min(maxlen-1, ddx_error%message_length-1)
115 do i = length, 1, -1
116 if (error_message(i:i) .eq. ' ') then
117 length = i-1
118 else
119 exit
120 endif
121 enddo
122 message(length + 1) = c_null_char
123 do i = 1, length
124 message(i) = error_message(i:i)
125 enddo
126end
127
128!
129! Electrostatics container
130!
131function ddx_allocate_electrostatics(c_ddx, c_error) result(c_electrostatics) bind(C)
132 type(c_ptr), intent(in), value :: c_ddx, c_error
133 type(ddx_setup_type), pointer :: ddx_model
134 type(ddx_error_type), pointer :: ddx_error
135 type(c_ptr) :: c_electrostatics
136 type(ddx_electrostatics_type), pointer :: electrostatics
137 call c_f_pointer(c_ddx, ddx_model)
138 call c_f_pointer(c_error, ddx_error)
139 allocate(electrostatics)
140 call allocate_electrostatics(ddx_model%params, ddx_model%constants, electrostatics, ddx_error)
141 c_electrostatics = c_loc(electrostatics)
142end function
143
144subroutine ddx_deallocate_electrostatics(c_electrostatics, c_error) bind(C)
145 type(c_ptr), intent(in), value :: c_electrostatics, c_error
146 type(ddx_electrostatics_type), pointer :: electrostatics
147 type(ddx_error_type), pointer :: ddx_error
148 call c_f_pointer(c_electrostatics, electrostatics)
149 call c_f_pointer(c_error, ddx_error)
150 call deallocate_electrostatics(electrostatics, ddx_error)
151 deallocate(electrostatics)
152end
153
154subroutine ddx_multipole_electrostatics(c_ddx, nsph, nmultipoles, multipoles, &
155 & c_electrostatics, c_error) bind(C)
156 implicit none
157 type(c_ptr), intent(in), value :: c_ddx, c_electrostatics, c_error
158 integer(c_int), intent(in), value :: nsph, nmultipoles
159 real(c_double), intent(in) :: multipoles(nmultipoles, nsph)
160 type(ddx_setup_type), pointer :: ddx_model
161 type(ddx_error_type), pointer :: ddx_error
162 type(ddx_electrostatics_type), pointer :: electrostatics
163 integer :: mmax
164
165 call c_f_pointer(c_ddx, ddx_model)
166 call c_f_pointer(c_error, ddx_error)
167 call c_f_pointer(c_electrostatics, electrostatics)
168 mmax = int(sqrt(dble(nmultipoles)) - 1d0)
169
170 call multipole_electrostatics(ddx_model%params, ddx_model%constants, ddx_model%workspace, &
171 & multipoles, mmax, electrostatics, ddx_error)
172end
173!
174! Setup object
175!
176function ddx_allocate_model(model, enable_force, solvent_epsilon, solvent_kappa, eta, se, lmax, &
177 & n_lebedev, incore, maxiter, jacobi_n_diis, enable_fmm, fmm_multipole_lmax, fmm_local_lmax, &
178 & n_proc, n_spheres, sphere_centres, sphere_radii, length_logfile, c_logfile, c_error) result(c_ddx) bind(C)
179 integer(c_int), intent(in), value :: model, enable_force, lmax, n_lebedev, maxiter, &
180 & incore, jacobi_n_diis, enable_fmm, fmm_multipole_lmax, fmm_local_lmax, n_proc, &
181 & n_spheres, length_logfile
182 real(c_double), intent(in) :: sphere_centres(3, n_spheres), sphere_radii(n_spheres)
183 real(c_double), intent(in), value :: eta, se, solvent_epsilon, solvent_kappa
184 type(c_ptr), intent(in), value :: c_error
185 type(ddx_error_type), pointer :: ddx_error
186 !type(c_funptr), value :: printfctn
187 type(c_ptr) :: c_ddx
188 integer :: passproc, i
189 type(ddx_setup_type), pointer :: ddx_model
190 character(len=1, kind=C_char), intent(in) :: c_logfile(length_logfile)
191 character(len=255) :: logfile
192
193 call c_f_pointer(c_error, ddx_error)
194
195 ! Allocate DDX object
196 allocate(ddx_model)
197 c_ddx = c_loc(ddx_model)
198
199 ! Convert to Fortran objects
200 passproc = n_proc
201 logfile = ''
202 do i = 1, min(length_logfile, 255)
203 if (c_logfile(i) .ne. c_null_char) then
204 logfile(i:i) = c_logfile(i)
205 endif
206 enddo
207
208 call params_init(model, enable_force, solvent_epsilon, solvent_kappa, eta, se, lmax, &
209 & n_lebedev, incore, maxiter, jacobi_n_diis, enable_fmm, &
210 & fmm_multipole_lmax, fmm_local_lmax, passproc, n_spheres, &
211 & sphere_centres, sphere_radii, logfile, ddx_model%params, ddx_error)
212 if (ddx_error%flag .ne. 0) then
213 return
214 endif
215 call constants_init(ddx_model%params, ddx_model%constants, ddx_error)
216 if (ddx_error%flag .ne. 0) then
217 return
218 endif
219 call workspace_init(ddx_model%params, ddx_model%constants, ddx_model%workspace, ddx_error)
220 if (ddx_error%flag .ne. 0) then
221 return
222 endif
223end function
224
225subroutine ddx_deallocate_model(c_ddx, c_error) bind(C)
226 type(c_ptr), intent(in), value :: c_ddx, c_error
227 type(ddx_setup_type), pointer :: ddx_model
228 type(ddx_error_type), pointer :: ddx_error
229 call c_f_pointer(c_ddx, ddx_model)
230 call c_f_pointer(c_error, ddx_error)
231 call params_free(ddx_model%params, ddx_error)
232 call constants_free(ddx_model%constants, ddx_error)
233 call workspace_free(ddx_model%workspace, ddx_error)
234 deallocate(ddx_model)
235end
236
237subroutine ddx_get_logfile(c_ddx, message, maxlen) bind(C)
238 type(c_ptr), intent(in), value :: c_ddx
239 integer(c_int), intent(in), value :: maxlen
240 character(len=1, kind=C_char), intent(out) :: message(maxlen)
241 type(ddx_setup_type), pointer :: ddx_model
242 integer :: length, i
243 call c_f_pointer(c_ddx, ddx_model)
244 ! Convert to C message
245 message(maxlen) = c_null_char
246 length = min(maxlen-1, 255)
247 do i = length, 1, -1
248 if (ddx_model%params%output_filename(i:i) .eq. ' ') then
249 length = i-1
250 else
251 exit
252 endif
253 enddo
254 message(length + 1) = c_null_char
255 do i = 1, length
256 message(i) = ddx_model%params%output_filename(i:i)
257 enddo
258end
259
260! Generated block, see scripts/generate_cinterface.py
261function ddx_get_enable_fmm(c_ddx) result(c_fmm) bind(C)
262 type(c_ptr), intent(in), value :: c_ddx
263 type(ddx_setup_type), pointer :: ddx_model
264 integer(c_int) :: c_fmm
265 call c_f_pointer(c_ddx, ddx_model)
266 c_fmm = ddx_model % params % fmm
267end function
268
269function ddx_get_enable_force(c_ddx) result(c_force) bind(C)
270 type(c_ptr), intent(in), value :: c_ddx
271 type(ddx_setup_type), pointer :: ddx_model
272 integer(c_int) :: c_force
273 call c_f_pointer(c_ddx, ddx_model)
274 c_force = ddx_model % params % force
275end function
276
277function ddx_get_jacobi_n_diis(c_ddx) result(c_jacobi_ndiis) bind(C)
278 type(c_ptr), intent(in), value :: c_ddx
279 type(ddx_setup_type), pointer :: ddx_model
280 integer(c_int) :: c_jacobi_ndiis
281 call c_f_pointer(c_ddx, ddx_model)
282 c_jacobi_ndiis = ddx_model % params % jacobi_ndiis
283end function
284
285function ddx_get_lmax(c_ddx) result(c_lmax) bind(C)
286 type(c_ptr), intent(in), value :: c_ddx
287 type(ddx_setup_type), pointer :: ddx_model
288 integer(c_int) :: c_lmax
289 call c_f_pointer(c_ddx, ddx_model)
290 c_lmax = ddx_model % params % lmax
291end function
292
293function ddx_get_incore(c_ddx) result(c_matvecmem) bind(C)
294 type(c_ptr), intent(in), value :: c_ddx
295 type(ddx_setup_type), pointer :: ddx_model
296 integer(c_int) :: c_matvecmem
297 call c_f_pointer(c_ddx, ddx_model)
298 c_matvecmem = ddx_model % params % matvecmem
299end function
300
301function ddx_get_maxiter(c_ddx) result(c_maxiter) bind(C)
302 type(c_ptr), intent(in), value :: c_ddx
303 type(ddx_setup_type), pointer :: ddx_model
304 integer(c_int) :: c_maxiter
305 call c_f_pointer(c_ddx, ddx_model)
306 c_maxiter = ddx_model % params % maxiter
307end function
308
309function ddx_get_model(c_ddx) result(c_model) bind(C)
310 type(c_ptr), intent(in), value :: c_ddx
311 type(ddx_setup_type), pointer :: ddx_model
312 integer(c_int) :: c_model
313 call c_f_pointer(c_ddx, ddx_model)
314 c_model = ddx_model % params % model
315end function
316
317function ddx_get_n_lebedev(c_ddx) result(c_ngrid) bind(C)
318 type(c_ptr), intent(in), value :: c_ddx
319 type(ddx_setup_type), pointer :: ddx_model
320 integer(c_int) :: c_ngrid
321 call c_f_pointer(c_ddx, ddx_model)
322 c_ngrid = ddx_model % params % ngrid
323end function
324
325function ddx_get_n_spheres(c_ddx) result(c_nsph) bind(C)
326 type(c_ptr), intent(in), value :: c_ddx
327 type(ddx_setup_type), pointer :: ddx_model
328 integer(c_int) :: c_nsph
329 call c_f_pointer(c_ddx, ddx_model)
330 c_nsph = ddx_model % params % nsph
331end function
332
333function ddx_get_n_proc(c_ddx) result(c_nproc) bind(C)
334 type(c_ptr), intent(in), value :: c_ddx
335 type(ddx_setup_type), pointer :: ddx_model
336 integer(c_int) :: c_nproc
337 call c_f_pointer(c_ddx, ddx_model)
338 c_nproc = ddx_model % params % nproc
339end function
340
341function ddx_get_fmm_local_lmax(c_ddx) result(c_pl) bind(C)
342 type(c_ptr), intent(in), value :: c_ddx
343 type(ddx_setup_type), pointer :: ddx_model
344 integer(c_int) :: c_pl
345 call c_f_pointer(c_ddx, ddx_model)
346 c_pl = ddx_model % params % pl
347end function
348
349function ddx_get_fmm_multipole_lmax(c_ddx) result(c_pm) bind(C)
350 type(c_ptr), intent(in), value :: c_ddx
351 type(ddx_setup_type), pointer :: ddx_model
352 integer(c_int) :: c_pm
353 call c_f_pointer(c_ddx, ddx_model)
354 c_pm = ddx_model % params % pm
355end function
356
357function ddx_get_solvent_epsilon(c_ddx) result(c_eps) bind(C)
358 type(c_ptr), intent(in), value :: c_ddx
359 type(ddx_setup_type), pointer :: ddx_model
360 real(c_double) :: c_eps
361 call c_f_pointer(c_ddx, ddx_model)
362 c_eps = ddx_model % params % eps
363end function
364
365function ddx_get_eta(c_ddx) result(c_eta) bind(C)
366 type(c_ptr), intent(in), value :: c_ddx
367 type(ddx_setup_type), pointer :: ddx_model
368 real(c_double) :: c_eta
369 call c_f_pointer(c_ddx, ddx_model)
370 c_eta = ddx_model % params % eta
371end function
372
373function ddx_get_solvent_kappa(c_ddx) result(c_kappa) bind(C)
374 type(c_ptr), intent(in), value :: c_ddx
375 type(ddx_setup_type), pointer :: ddx_model
376 real(c_double) :: c_kappa
377 call c_f_pointer(c_ddx, ddx_model)
378 c_kappa = ddx_model % params % kappa
379end function
380
381function ddx_get_shift(c_ddx) result(c_se) bind(C)
382 type(c_ptr), intent(in), value :: c_ddx
383 type(ddx_setup_type), pointer :: ddx_model
384 real(c_double) :: c_se
385 call c_f_pointer(c_ddx, ddx_model)
386 c_se = ddx_model % params % se
387end function
388
389subroutine ddx_get_sphere_centres(c_ddx, nsph, c_csph) bind(C)
390 type(c_ptr), intent(in), value :: c_ddx
391 integer(c_int), intent(in), value :: nsph
392 real(c_double), intent(out) :: c_csph(3, nsph)
393 type(ddx_setup_type), pointer :: ddx_model
394 call c_f_pointer(c_ddx, ddx_model)
395 c_csph(:, :) = ddx_model % params % csph(:, :)
396end subroutine
397
398subroutine ddx_get_sphere_radii(c_ddx, nsph, c_rsph) bind(C)
399 type(c_ptr), intent(in), value :: c_ddx
400 integer(c_int), intent(in), value :: nsph
401 real(c_double), intent(out) :: c_rsph(nsph)
402 type(ddx_setup_type), pointer :: ddx_model
403 call c_f_pointer(c_ddx, ddx_model)
404 c_rsph(:) = ddx_model % params % rsph(:)
405end subroutine
406
407function ddx_get_n_basis(c_ddx) result(c_nbasis) bind(C)
408 type(c_ptr), intent(in), value :: c_ddx
409 type(ddx_setup_type), pointer :: ddx_model
410 integer(c_int) :: c_nbasis
411 call c_f_pointer(c_ddx, ddx_model)
412 c_nbasis = ddx_model % constants % nbasis
413end function
414
415function ddx_get_n_cav(c_ddx) result(c_ncav) bind(C)
416 type(c_ptr), intent(in), value :: c_ddx
417 type(ddx_setup_type), pointer :: ddx_model
418 integer(c_int) :: c_ncav
419 call c_f_pointer(c_ddx, ddx_model)
420 c_ncav = ddx_model % constants % ncav
421end function
422
423subroutine ddx_get_cavity(c_ddx, ncav, c_ccav) bind(C)
424 type(c_ptr), intent(in), value :: c_ddx
425 integer(c_int), intent(in), value :: ncav
426 real(c_double), intent(out) :: c_ccav(3, ncav)
427 type(ddx_setup_type), pointer :: ddx_model
428 call c_f_pointer(c_ddx, ddx_model)
429 c_ccav(:, :) = ddx_model % constants % ccav(:, :)
430end subroutine
431! end generated block
432
433!
434! State object
435!
436function ddx_allocate_state(c_ddx, c_error) result(c_state) bind(C)
437 type(c_ptr), intent(in), value :: c_ddx, c_error
438 type(ddx_setup_type), pointer :: ddx_model
439 type(ddx_error_type), pointer :: ddx_error
440 type(c_ptr) :: c_state
441 type(ddx_state_type), pointer :: state
442 call c_f_pointer(c_ddx, ddx_model)
443 call c_f_pointer(c_error, ddx_error)
444 allocate(state)
445 call allocate_state(ddx_model%params, ddx_model%constants, state, ddx_error)
446 c_state = c_loc(state)
447end function
448
449subroutine ddx_deallocate_state(c_state, c_error) bind(C)
450 type(c_ptr), intent(in), value :: c_state, c_error
451 type(ddx_state_type), pointer :: state
452 type(ddx_error_type), pointer :: ddx_error
453 call c_f_pointer(c_state, state)
454 call c_f_pointer(c_error, ddx_error)
455 call deallocate_state(state, ddx_error)
456 deallocate(state)
457end subroutine
458
459subroutine ddx_get_x(c_state, nbasis, nsph, x) bind(C)
460 type(c_ptr), intent(in), value :: c_state
461 type(ddx_state_type), pointer :: state
462 integer(c_int), intent(in), value :: nsph, nbasis
463 real(c_double), intent(out) :: x(nbasis, nsph)
464 call c_f_pointer(c_state, state)
465
466 if (allocated(state%x_lpb)) then ! Case for ddLPB
467 x(:, :) = state%x_lpb(:, :, 1) ! Use only the first of the two solutions
468 else
469 x(:, :) = state%xs(:, :)
470 endif
471end subroutine
472
473function ddx_get_x_niter(c_state) bind(C) result(c_niter)
474 type(c_ptr), intent(in), value :: c_state
475 type(ddx_state_type), pointer :: state
476 integer(c_int) :: c_niter
477 call c_f_pointer(c_state, state)
478 if (allocated(state%x_lpb)) then ! Case for ddLPB
479 c_niter = state%x_lpb_niter
480 else
481 c_niter = state%xs_niter
482 endif
483end function
484
485subroutine ddx_get_s(c_state, nbasis, nsph, s) bind(C)
486 type(c_ptr), intent(in), value :: c_state
487 type(ddx_state_type), pointer :: state
488 integer(c_int), intent(in), value :: nsph, nbasis
489 real(c_double), intent(out) :: s(nbasis, nsph)
490 call c_f_pointer(c_state, state)
491 if (allocated(state%x_adj_lpb)) then ! Case for ddLPB
492 s(:, :) = state%x_adj_lpb(:, :, 1) ! Use only the first of the two solutions
493 else
494 s(:, :) = state%s(:, :)
495 endif
496end subroutine
497
498function ddx_get_s_niter(c_state) bind(C) result(c_niter)
499 type(c_ptr), intent(in), value :: c_state
500 type(ddx_state_type), pointer :: state
501 integer(c_int) :: c_niter
502 call c_f_pointer(c_state, state)
503 if (allocated(state%x_adj_lpb)) then ! Case for ddLPB
504 c_niter = state%x_adj_lpb_niter
505 else
506 c_niter = state%s_niter
507 endif
508end function
509
510subroutine ddx_get_xi(c_state, c_ddx, ncav, xi) bind(C)
511 type(c_ptr), intent(in), value :: c_state, c_ddx
512 type(ddx_state_type), pointer :: state
513 type(ddx_setup_type), pointer :: ddx_model
514 integer(c_int), intent(in), value :: ncav
515 real(c_double), intent(out) :: xi(ncav)
516 call c_f_pointer(c_ddx, ddx_model)
517 call c_f_pointer(c_state, state)
518 call ddproject_cav(ddx_model%params, ddx_model%constants, state%q, xi)
519end subroutine
520
521subroutine ddx_get_zeta_dip(c_state, c_ddx, ncav, zeta_dip) bind(C)
522 type(c_ptr), intent(in), value :: c_state, c_ddx
523 type(ddx_state_type), pointer :: state
524 type(ddx_setup_type), pointer :: ddx_model
525 integer(c_int), intent(in), value :: ncav
526 real(c_double), intent(out) :: zeta_dip(3, ncav)
527 call c_f_pointer(c_ddx, ddx_model)
528 call c_f_pointer(c_state, state)
529 if (allocated(state%zeta_dip)) then
530 zeta_dip(:, :) = state%zeta_dip(:, :)
531 else
532 zeta_dip(:, :) = 0d0
533 endif
534end subroutine
535
536!
537! High level APIs (model nonspecific)
538!
539function ddx_ddrun(c_ddx, c_state, c_electrostatics, nbasis, nsph, &
540 & psi, tol, force, read_guess, c_error) result(c_energy) bind(C)
541 type(c_ptr), intent(in), value :: c_ddx, c_state, c_electrostatics, &
542 & c_error
543 integer(c_int), intent(in), value :: nbasis, nsph
544 real(c_double), intent(in) :: psi(nbasis, nsph)
545 real(c_double), intent(in), value :: tol
546 real(c_double), intent(out) :: force(3, nsph)
547 real(c_double) :: c_energy
548 integer(c_int), intent(in), value :: read_guess
549 type(ddx_setup_type), pointer :: ddx_model
550 logical :: do_guess
551
552 ! at least return something in case of errors
553 c_energy = zero
554
555 ! setup
556 do_guess = read_guess.ne.0
557 call c_f_pointer(c_ddx, ddx_model)
558 call ddx_setup(c_ddx, c_state, c_electrostatics, nbasis, nsph, psi, c_error)
559 if (ddx_get_error_flag(c_error) .ne. 0) return
560
561 ! primal linear system
562 if (do_guess) then
563 call ddx_fill_guess(c_ddx, c_state, tol, c_error)
564 if (ddx_get_error_flag(c_error) .ne. 0) return
565 end if
566 call ddx_solve(c_ddx, c_state, tol, c_error)
567 if (ddx_get_error_flag(c_error) .ne. 0) return
568
569 ! energy
570 c_energy = ddx_energy(c_ddx, c_state, c_error)
571 if (ddx_get_error_flag(c_error) .ne. 0) return
572
573 ! adjoint linear system
574 if (ddx_model%params%force .eq. 1) then
575 if (do_guess) then
576 call ddx_fill_guess(c_ddx, c_state, tol, c_error)
577 end if
578 if (ddx_get_error_flag(c_error) .ne. 0) return
579 call ddx_solve_adjoint(c_ddx, c_state, tol, c_error)
580 if (ddx_get_error_flag(c_error) .ne. 0) return
581 end if
582
583 ! forces
584 if (ddx_model%params%force .eq. 1) then
585 call ddx_solvation_force_terms(c_ddx, c_state, c_electrostatics, &
586 & nsph, force, c_error)
587 if (ddx_get_error_flag(c_error) .ne. 0) return
588 end if
589
590end function
591
592subroutine ddx_setup(c_ddx, c_state, c_electrostatics, nbasis, nsph, psi, c_error) bind(C)
593 type(c_ptr), intent(in), value :: c_ddx, c_state, c_electrostatics, &
594 & c_error
595 integer(c_int), intent(in), value :: nbasis, nsph
596 real(c_double), intent(in) :: psi(nbasis, nsph)
597 type(ddx_setup_type), pointer :: ddx_model
598 type(ddx_state_type), pointer :: state
599 type(ddx_electrostatics_type), pointer :: electrostatics
600 type(ddx_error_type), pointer :: ddx_error
601 call c_f_pointer(c_ddx, ddx_model)
602 call c_f_pointer(c_state, state)
603 call c_f_pointer(c_electrostatics, electrostatics)
604 call c_f_pointer(c_error, ddx_error)
605 call setup(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, &
606 & electrostatics, psi, ddx_error)
607end subroutine
608
609subroutine ddx_fill_guess(c_ddx, c_state, tol, c_error) bind(C)
610 type(c_ptr), intent(in), value :: c_ddx, c_state, c_error
611 real(c_double), intent(in), value :: tol
612 type(ddx_setup_type), pointer :: ddx_model
613 type(ddx_state_type), pointer :: state
614 type(ddx_error_type), pointer :: ddx_error
615 call c_f_pointer(c_ddx, ddx_model)
616 call c_f_pointer(c_state, state)
617 call c_f_pointer(c_error, ddx_error)
618 call fill_guess(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, &
619 & tol, ddx_error)
620end subroutine
621
622subroutine ddx_fill_guess_adjoint(c_ddx, c_state, tol, c_error) bind(C)
623 type(c_ptr), intent(in), value :: c_ddx, c_state, c_error
624 real(c_double), intent(in), value :: tol
625 type(ddx_setup_type), pointer :: ddx_model
626 type(ddx_state_type), pointer :: state
627 type(ddx_error_type), pointer :: ddx_error
628 call c_f_pointer(c_ddx, ddx_model)
629 call c_f_pointer(c_state, state)
630 call c_f_pointer(c_error, ddx_error)
631 call fill_guess_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, &
632 & tol, ddx_error)
633end subroutine
634
635subroutine ddx_solve(c_ddx, c_state, tol, c_error) bind(C)
636 type(c_ptr), intent(in), value :: c_ddx, c_state, c_error
637 real(c_double), intent(in), value :: tol
638 type(ddx_setup_type), pointer :: ddx_model
639 type(ddx_state_type), pointer :: state
640 type(ddx_error_type), pointer :: ddx_error
641 call c_f_pointer(c_ddx, ddx_model)
642 call c_f_pointer(c_state, state)
643 call c_f_pointer(c_error, ddx_error)
644 call solve(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
645end subroutine
646
647subroutine ddx_solve_adjoint(c_ddx, c_state, tol, c_error) bind(C)
648 type(c_ptr), intent(in), value :: c_ddx, c_state, c_error
649 real(c_double), intent(in), value :: tol
650 type(ddx_setup_type), pointer :: ddx_model
651 type(ddx_state_type), pointer :: state
652 type(ddx_error_type), pointer :: ddx_error
653 call c_f_pointer(c_ddx, ddx_model)
654 call c_f_pointer(c_state, state)
655 call c_f_pointer(c_error, ddx_error)
656 call solve_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, &
657 & tol, ddx_error)
658end subroutine
659
660function ddx_energy(c_ddx, c_state, c_error) result(c_energy) bind(C)
661 type(c_ptr), intent(in), value :: c_ddx, c_state, c_error
662 type(ddx_setup_type), pointer :: ddx_model
663 type(ddx_state_type), pointer :: state
664 type(ddx_error_type), pointer :: ddx_error
665 real(c_double) :: c_energy
666 call c_f_pointer(c_ddx, ddx_model)
667 call c_f_pointer(c_state, state)
668 call c_f_pointer(c_error, ddx_error)
669 call energy(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, &
670 & c_energy, ddx_error)
671end function
672
673subroutine ddx_solvation_force_terms(c_ddx, c_state, c_electrostatics, &
674 & nsph, forces, c_error) bind(C)
675 type(c_ptr), intent(in), value :: c_ddx, c_state, c_electrostatics, &
676 & c_error
677 integer(c_int), intent(in), value :: nsph
678 real(c_double), intent(out) :: forces(3, nsph)
679 type(ddx_setup_type), pointer :: ddx_model
680 type(ddx_state_type), pointer :: state
681 type(ddx_electrostatics_type), pointer :: electrostatics
682 type(ddx_error_type), pointer :: ddx_error
683 call c_f_pointer(c_ddx, ddx_model)
684 call c_f_pointer(c_state, state)
685 call c_f_pointer(c_electrostatics, electrostatics)
686 call c_f_pointer(c_error, ddx_error)
687 call solvation_force_terms(ddx_model%params, ddx_model%constants, ddx_model%workspace, &
688 & state, electrostatics, forces, ddx_error)
689end subroutine
690
691!
692! Cosmo
693!
694! Setup the problem in the state
695subroutine ddx_cosmo_setup(c_ddx, c_state, ncav, nbasis, nsph, psi, phi_cav, c_error) bind(C)
696 type(c_ptr), intent(in), value :: c_error
697 type(c_ptr), intent(in), value :: c_ddx, c_state
698 integer(c_int), intent(in), value :: ncav, nbasis, nsph
699 real(c_double), intent(in) :: phi_cav(ncav), psi(nbasis, nsph)
700 type(ddx_setup_type), pointer :: ddx_model
701 type(ddx_error_type), pointer :: ddx_error
702 type(ddx_state_type), pointer :: state
703 call c_f_pointer(c_ddx, ddx_model)
704 call c_f_pointer(c_error, ddx_error)
705 call c_f_pointer(c_state, state)
706 call cosmo_setup(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, phi_cav, psi, ddx_error)
707end subroutine
708
709! Put a guess for the problem into the state (optional)
710subroutine ddx_cosmo_guess(c_ddx, c_state, c_error) bind(C)
711 type(c_ptr), intent(in), value :: c_error
712 type(c_ptr), intent(in), value :: c_ddx, c_state
713 type(ddx_setup_type), pointer :: ddx_model
714 type(ddx_error_type), pointer :: ddx_error
715 type(ddx_state_type), pointer :: state
716 call c_f_pointer(c_ddx, ddx_model)
717 call c_f_pointer(c_error, ddx_error)
718 call c_f_pointer(c_state, state)
719 call cosmo_guess(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, ddx_error)
720end
721
722! Solve the problem
723subroutine ddx_cosmo_solve(c_ddx, c_state, tol, c_error) bind(C)
724 type(c_ptr), intent(in), value :: c_error
725 type(c_ptr), intent(in), value :: c_ddx, c_state
726 type(ddx_setup_type), pointer :: ddx_model
727 type(ddx_error_type), pointer :: ddx_error
728 type(ddx_state_type), pointer :: state
729 real(c_double), intent(in), value :: tol
730 call c_f_pointer(c_ddx, ddx_model)
731 call c_f_pointer(c_error, ddx_error)
732 call c_f_pointer(c_state, state)
733 call cosmo_solve(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
734end subroutine
735
736! Put a guess for the adjoint problem into the state (optional)
737subroutine ddx_cosmo_guess_adjoint(c_ddx, c_state, c_error) bind(C)
738 type(c_ptr), intent(in), value :: c_error
739 type(c_ptr), intent(in), value :: c_ddx, c_state
740 type(ddx_setup_type), pointer :: ddx_model
741 type(ddx_error_type), pointer :: ddx_error
742 type(ddx_state_type), pointer :: state
743 call c_f_pointer(c_ddx, ddx_model)
744 call c_f_pointer(c_error, ddx_error)
745 call c_f_pointer(c_state, state)
746 call cosmo_guess_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, ddx_error)
747end
748
749! Solve the adjoint problem inside the state
750subroutine ddx_cosmo_solve_adjoint(c_ddx, c_state, tol, c_error) bind(C)
751 type(c_ptr), intent(in), value :: c_error
752 type(c_ptr), intent(in), value :: c_ddx, c_state
753 type(ddx_setup_type), pointer :: ddx_model
754 type(ddx_error_type), pointer :: ddx_error
755 type(ddx_state_type), pointer :: state
756 real(c_double), intent(in), value :: tol
757 call c_f_pointer(c_ddx, ddx_model)
758 call c_f_pointer(c_error, ddx_error)
759 call c_f_pointer(c_state, state)
760 call cosmo_solve_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
761end
762
763! Compute the ddCOSMO energy
764function ddx_cosmo_energy(c_ddx, c_state, c_error) result(c_energy) bind(C)
765 type(c_ptr), intent(in), value :: c_error
766 type(c_ptr), intent(in), value :: c_ddx, c_state
767 type(ddx_setup_type), pointer :: ddx_model
768 type(ddx_error_type), pointer :: ddx_error
769 type(ddx_state_type), pointer :: state
770 real(c_double) :: c_energy
771 call c_f_pointer(c_ddx, ddx_model)
772 call c_f_pointer(c_error, ddx_error)
773 call c_f_pointer(c_state, state)
774 call cosmo_energy(ddx_model%constants, state, c_energy, ddx_error)
775end function
776
777! Compute the forces
778subroutine ddx_cosmo_solvation_force_terms(c_ddx, c_state, nsph, ncav, e_cav, forces, c_error) bind(C)
779 type(c_ptr), intent(in), value :: c_error
780 type(c_ptr), intent(in), value :: c_ddx, c_state
781 type(ddx_setup_type), pointer :: ddx_model
782 type(ddx_error_type), pointer :: ddx_error
783 type(ddx_state_type), pointer :: state
784 integer(c_int), intent(in), value :: nsph, ncav
785 real(c_double), intent(in) :: e_cav(3, ncav)
786 real(c_double), intent(out) :: forces(3, nsph)
787 call c_f_pointer(c_ddx, ddx_model)
788 call c_f_pointer(c_error, ddx_error)
789 call c_f_pointer(c_state, state)
790 call cosmo_solvation_force_terms(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, e_cav, forces, ddx_error)
791end
792
793!
794! PCM
795!
796subroutine ddx_pcm_setup(c_ddx, c_state, ncav, nbasis, nsph, psi, phi_cav, c_error) bind(C)
797 type(c_ptr), intent(in), value :: c_error
798 type(c_ptr), intent(in), value :: c_ddx, c_state
799 integer(c_int), intent(in), value :: ncav, nbasis, nsph
800 real(c_double), intent(in) :: phi_cav(ncav), psi(nbasis, nsph)
801 type(ddx_setup_type), pointer :: ddx_model
802 type(ddx_error_type), pointer :: ddx_error
803 type(ddx_state_type), pointer :: state
804 call c_f_pointer(c_ddx, ddx_model)
805 call c_f_pointer(c_error, ddx_error)
806 call c_f_pointer(c_state, state)
807 call pcm_setup(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, phi_cav, psi, ddx_error)
808end subroutine
809
810subroutine ddx_pcm_guess(c_ddx, c_state, c_error) bind(C)
811 type(c_ptr), intent(in), value :: c_error
812 type(c_ptr), intent(in), value :: c_ddx, c_state
813 type(ddx_setup_type), pointer :: ddx_model
814 type(ddx_error_type), pointer :: ddx_error
815 type(ddx_state_type), pointer :: state
816 call c_f_pointer(c_ddx, ddx_model)
817 call c_f_pointer(c_error, ddx_error)
818 call c_f_pointer(c_state, state)
819 call pcm_guess(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, ddx_error)
820end
821
822subroutine ddx_pcm_solve(c_ddx, c_state, tol, c_error) bind(C)
823 type(c_ptr), intent(in), value :: c_error
824 type(c_ptr), intent(in), value :: c_ddx, c_state
825 type(ddx_setup_type), pointer :: ddx_model
826 type(ddx_error_type), pointer :: ddx_error
827 type(ddx_state_type), pointer :: state
828 real(c_double), intent(in), value :: tol
829 call c_f_pointer(c_ddx, ddx_model)
830 call c_f_pointer(c_error, ddx_error)
831 call c_f_pointer(c_state, state)
832 call pcm_solve(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
833end subroutine
834
835subroutine ddx_pcm_guess_adjoint(c_ddx, c_state, c_error) bind(C)
836 type(c_ptr), intent(in), value :: c_error
837 type(c_ptr), intent(in), value :: c_ddx, c_state
838 type(ddx_setup_type), pointer :: ddx_model
839 type(ddx_error_type), pointer :: ddx_error
840 type(ddx_state_type), pointer :: state
841 call c_f_pointer(c_ddx, ddx_model)
842 call c_f_pointer(c_error, ddx_error)
843 call c_f_pointer(c_state, state)
844 call pcm_guess_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, ddx_error)
845end
846
847subroutine ddx_pcm_solve_adjoint(c_ddx, c_state, tol, c_error) bind(C)
848 type(c_ptr), intent(in), value :: c_error
849 type(c_ptr), intent(in), value :: c_ddx, c_state
850 type(ddx_setup_type), pointer :: ddx_model
851 type(ddx_error_type), pointer :: ddx_error
852 type(ddx_state_type), pointer :: state
853 real(c_double), intent(in), value :: tol
854 call c_f_pointer(c_ddx, ddx_model)
855 call c_f_pointer(c_error, ddx_error)
856 call c_f_pointer(c_state, state)
857 call pcm_solve_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
858end
859
860function ddx_pcm_energy(c_ddx, c_state, c_error) result(c_energy) bind(C)
861 type(c_ptr), intent(in), value :: c_error
862 type(c_ptr), intent(in), value :: c_ddx, c_state
863 type(ddx_setup_type), pointer :: ddx_model
864 type(ddx_error_type), pointer :: ddx_error
865 type(ddx_state_type), pointer :: state
866 real(c_double) :: c_energy
867 call c_f_pointer(c_ddx, ddx_model)
868 call c_f_pointer(c_error, ddx_error)
869 call c_f_pointer(c_state, state)
870 call pcm_energy(ddx_model%constants, state, c_energy, ddx_error)
871end function
872
873subroutine ddx_pcm_solvation_force_terms(c_ddx, c_state, nsph, ncav, e_cav, forces, c_error) bind(C)
874 type(c_ptr), intent(in), value :: c_error
875 type(c_ptr), intent(in), value :: c_ddx, c_state
876 type(ddx_setup_type), pointer :: ddx_model
877 type(ddx_error_type), pointer :: ddx_error
878 type(ddx_state_type), pointer :: state
879 integer(c_int), intent(in), value :: nsph, ncav
880 real(c_double), intent(in) :: e_cav(3, ncav)
881 real(c_double), intent(out) :: forces(3, nsph)
882 call c_f_pointer(c_ddx, ddx_model)
883 call c_f_pointer(c_error, ddx_error)
884 call c_f_pointer(c_state, state)
885 call pcm_solvation_force_terms(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, e_cav, forces, ddx_error)
886end
887
888!
889! LPB
890!
891subroutine ddx_lpb_setup(c_ddx, c_state, ncav, nbasis, nsph, psi, phi_cav, gradphi_cav, c_error) bind(C)
892 type(c_ptr), intent(in), value :: c_error
893 type(c_ptr), intent(in), value :: c_ddx, c_state
894 integer(c_int), intent(in), value :: ncav, nbasis, nsph
895 real(c_double), intent(in) :: phi_cav(ncav), psi(nbasis, nsph), gradphi_cav(3, ncav)
896 type(ddx_setup_type), pointer :: ddx_model
897 type(ddx_error_type), pointer :: ddx_error
898 type(ddx_state_type), pointer :: state
899 call c_f_pointer(c_ddx, ddx_model)
900 call c_f_pointer(c_error, ddx_error)
901 call c_f_pointer(c_state, state)
902 call lpb_setup(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, phi_cav, gradphi_cav, psi, ddx_error)
903end subroutine
904
905subroutine ddx_lpb_guess(c_ddx, c_state, tol, c_error) bind(C)
906 type(c_ptr), intent(in), value :: c_error
907 type(c_ptr), intent(in), value :: c_ddx, c_state
908 real(c_double), intent(in), value :: tol
909 type(ddx_setup_type), pointer :: ddx_model
910 type(ddx_error_type), pointer :: ddx_error
911 type(ddx_state_type), pointer :: state
912 call c_f_pointer(c_ddx, ddx_model)
913 call c_f_pointer(c_error, ddx_error)
914 call c_f_pointer(c_state, state)
915 call lpb_guess(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
916end
917
918subroutine ddx_lpb_solve(c_ddx, c_state, tol, c_error) bind(C)
919 type(c_ptr), intent(in), value :: c_error
920 type(c_ptr), intent(in), value :: c_ddx, c_state
921 type(ddx_setup_type), pointer :: ddx_model
922 type(ddx_error_type), pointer :: ddx_error
923 type(ddx_state_type), pointer :: state
924 real(c_double), intent(in), value :: tol
925 call c_f_pointer(c_ddx, ddx_model)
926 call c_f_pointer(c_error, ddx_error)
927 call c_f_pointer(c_state, state)
928 call lpb_solve(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
929end subroutine
930
931subroutine ddx_lpb_guess_adjoint(c_ddx, c_state, tol, c_error) bind(C)
932 type(c_ptr), intent(in), value :: c_error
933 type(c_ptr), intent(in), value :: c_ddx, c_state
934 real(c_double), intent(in), value :: tol
935 type(ddx_setup_type), pointer :: ddx_model
936 type(ddx_error_type), pointer :: ddx_error
937 type(ddx_state_type), pointer :: state
938 call c_f_pointer(c_ddx, ddx_model)
939 call c_f_pointer(c_error, ddx_error)
940 call c_f_pointer(c_state, state)
941 call lpb_guess_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
942end
943
944subroutine ddx_lpb_solve_adjoint(c_ddx, c_state, tol, c_error) bind(C)
945 type(c_ptr), intent(in), value :: c_error
946 type(c_ptr), intent(in), value :: c_ddx, c_state
947 type(ddx_setup_type), pointer :: ddx_model
948 type(ddx_error_type), pointer :: ddx_error
949 type(ddx_state_type), pointer :: state
950 real(c_double), intent(in), value :: tol
951 call c_f_pointer(c_ddx, ddx_model)
952 call c_f_pointer(c_error, ddx_error)
953 call c_f_pointer(c_state, state)
954 call lpb_solve_adjoint(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, tol, ddx_error)
955end
956
957function ddx_lpb_energy(c_ddx, c_state, c_error) result(c_energy) bind(C)
958 type(c_ptr), intent(in), value :: c_error
959 type(c_ptr), intent(in), value :: c_ddx, c_state
960 type(ddx_setup_type), pointer :: ddx_model
961 type(ddx_error_type), pointer :: ddx_error
962 type(ddx_state_type), pointer :: state
963 real(c_double) :: c_energy
964 call c_f_pointer(c_ddx, ddx_model)
965 call c_f_pointer(c_error, ddx_error)
966 call c_f_pointer(c_state, state)
967 call lpb_energy(ddx_model%constants, state, c_energy, ddx_error)
968end function
969
970subroutine ddx_lpb_solvation_force_terms(c_ddx, c_state, nsph, ncav, g_cav, forces, c_error) bind(C)
971 type(c_ptr), intent(in), value :: c_error
972 type(c_ptr), intent(in), value :: c_ddx, c_state
973 type(ddx_setup_type), pointer :: ddx_model
974 type(ddx_error_type), pointer :: ddx_error
975 type(ddx_state_type), pointer :: state
976 integer(c_int), intent(in), value :: nsph, ncav
977 real(c_double), intent(in) :: g_cav(3, 3, ncav)
978 real(c_double), intent(out) :: forces(3, nsph)
979 call c_f_pointer(c_ddx, ddx_model)
980 call c_f_pointer(c_error, ddx_error)
981 call c_f_pointer(c_state, state)
982 call lpb_solvation_force_terms(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, g_cav, forces, ddx_error)
983end
984
985!
986! multipolar solutes
987!
988subroutine ddx_multipole_electrostatics_0(c_ddx, nsph, ncav, nmultipoles, multipoles, &
989 & phi_cav, c_error) bind(C)
990 type(c_ptr), intent(in), value :: c_ddx
991 type(ddx_setup_type), pointer :: ddx_model
992 integer(c_int), intent(in), value :: nsph, ncav, nmultipoles
993 real(c_double), intent(in) :: multipoles(nmultipoles, nsph)
994 real(c_double), intent(out) :: phi_cav(ncav)
995 type(c_ptr), intent(in), value :: c_error
996 type(ddx_error_type), pointer :: ddx_error
997 integer :: mmax
998 call c_f_pointer(c_error, ddx_error)
999 call c_f_pointer(c_ddx, ddx_model)
1000 mmax = int(sqrt(dble(nmultipoles)) - 1d0)
1001 call multipole_electrostatics_0(ddx_model%params, ddx_model%constants, &
1002 & ddx_model%workspace, multipoles, mmax, phi_cav, ddx_error)
1003end
1004
1005subroutine ddx_multipole_electrostatics_1(c_ddx, nsph, ncav, nmultipoles, multipoles, &
1006 & phi_cav, e_cav, c_error) bind(C)
1007 type(c_ptr), intent(in), value :: c_error
1008 type(c_ptr), intent(in), value :: c_ddx
1009 type(ddx_setup_type), pointer :: ddx_model
1010 type(ddx_error_type), pointer :: ddx_error
1011 integer(c_int), intent(in), value :: nsph, ncav, nmultipoles
1012 real(c_double), intent(in) :: multipoles(nmultipoles, nsph)
1013 real(c_double), intent(out) :: phi_cav(ncav), e_cav(3, ncav)
1014 integer :: mmax
1015 call c_f_pointer(c_ddx, ddx_model)
1016 call c_f_pointer(c_error, ddx_error)
1017 mmax = int(sqrt(dble(nmultipoles)) - 1d0)
1018 call multipole_electrostatics_1(ddx_model%params, ddx_model%constants, &
1019 & ddx_model%workspace, multipoles, mmax, phi_cav, e_cav, ddx_error)
1020end
1021
1022subroutine ddx_multipole_electrostatics_2(c_ddx, nsph, ncav, nmultipoles, multipoles, &
1023 & phi_cav, e_cav, g_cav, c_error) bind(C)
1024 type(c_ptr), intent(in), value :: c_error
1025 type(c_ptr), intent(in), value :: c_ddx
1026 type(ddx_setup_type), pointer :: ddx_model
1027 type(ddx_error_type), pointer :: ddx_error
1028 integer(c_int), intent(in), value :: nsph, ncav, nmultipoles
1029 real(c_double), intent(in) :: multipoles(nmultipoles, nsph)
1030 real(c_double), intent(out) :: phi_cav(ncav), e_cav(3, ncav), g_cav(3, 3, ncav)
1031 integer :: mmax
1032 call c_f_pointer(c_ddx, ddx_model)
1033 call c_f_pointer(c_error, ddx_error)
1034 mmax = int(sqrt(dble(nmultipoles)) - 1d0)
1035 call multipole_electrostatics_2(ddx_model%params, ddx_model%constants, &
1036 & ddx_model%workspace, multipoles, mmax, phi_cav, e_cav, g_cav, ddx_error)
1037end
1038
1039subroutine ddx_multipole_psi(c_ddx, nbasis, nsph, nmultipoles, multipoles, psi, c_error) bind(C)
1040 type(c_ptr), intent(in), value :: c_error
1041 type(c_ptr), intent(in), value :: c_ddx
1042 type(ddx_setup_type), pointer :: ddx_model
1043 type(ddx_error_type), pointer :: ddx_error
1044 integer(c_int), intent(in), value :: nmultipoles, nsph, nbasis
1045 real(c_double), intent(in) :: multipoles(nmultipoles, nsph)
1046 real(c_double), intent(out) :: psi(nbasis, nsph)
1047 integer :: mmax
1048 call c_f_pointer(c_ddx, ddx_model)
1049 call c_f_pointer(c_error, ddx_error)
1050 mmax = int(sqrt(dble(nmultipoles)) - 1d0)
1051 call multipole_psi(ddx_model%params, multipoles, mmax, psi)
1052end
1053
1054subroutine ddx_multipole_force_terms(c_ddx, c_state, nsph, nmultipoles, multipoles, &
1055 & forces, c_error) bind(C)
1056 type(c_ptr), intent(in), value :: c_error
1057 type(c_ptr), intent(in), value :: c_ddx, c_state
1058 type(ddx_setup_type), pointer :: ddx_model
1059 type(ddx_error_type), pointer :: ddx_error
1060 type(ddx_state_type), pointer :: state
1061 integer(c_int), intent(in), value :: nmultipoles, nsph
1062 integer :: mmax
1063 real(c_double), intent(in) :: multipoles(nmultipoles, nsph)
1064 real(c_double), intent(inout) :: forces(3, nsph)
1065 call c_f_pointer(c_ddx, ddx_model)
1066 call c_f_pointer(c_error, ddx_error)
1067 call c_f_pointer(c_state, state)
1068 mmax = int(sqrt(dble(nmultipoles)) - 1d0)
1069 forces = zero
1070 call multipole_force_terms(ddx_model%params, ddx_model%constants, ddx_model%workspace, state, mmax, &
1071 & multipoles, forces, ddx_error)
1072end
1073
1074end
void ddx_get_sphere_centres(const void *ddx, int nsph, double *c_csph)
void ddx_multipole_electrostatics_2(const void *ddx, int nsph, int ncav, int nmultipoles, const double *multipoles, double *phi_cav, double *e_cav, double *g_cav, void *error)
void ddx_get_logfile(const void *ddx, char *logfile, int maxlen)
void ddx_get_cavity(const void *ddx, int ncav, double *c_ccav)
void ddx_multipole_electrostatics_0(const void *ddx, int nsph, int ncav, int nmultipoles, const double *multipoles, double *phi_cav, void *error)
void ddx_lpb_guess_adjoint(const void *ddx, void *state, double tol, void *error)
void ddx_fill_guess(const void *ddx, void *state, double tol, void *error)
void ddx_get_s(const void *state, int nbasis, int nsph, double *s)
void ddx_lpb_solvation_force_terms(const void *ddx, void *state, int nsph, int ncav, const double *g_cav, double *forces, const void *error)
void * ddx_allocate_state(const void *ddx, void *error)
void ddx_solve_adjoint(const void *ddx, void *state, double tol, void *error)
double ddx_cosmo_energy(const void *ddx, void *state, void *error)
double ddx_get_solvent_kappa(const void *ddx)
void ddx_pcm_solve_adjoint(const void *ddx, void *state, double tol, void *error)
void ddx_cosmo_solve_adjoint(const void *ddx, void *state, double tol, void *error)
int ddx_get_n_cav(const void *ddx)
int ddx_get_error_flag(const void *error)
double ddx_pcm_energy(const void *ddx, void *state, void *error)
void ddx_cosmo_guess_adjoint(const void *ddx, void *state, void *error)
void ddx_solvation_force_terms(const void *ddx, void *state, void *electrostatics, int nsph, double *forces, void *error)
void ddx_multipole_electrostatics(void *ddx, int nsph, int nmultipoles, const double *multipoles, void *electrostatics, void *error)
void ddx_pcm_setup(const void *ddx, void *state, int ncav, int nbasis, int nsph, const double *psi, const double *phi_cav, void *error)
void ddx_lpb_setup(const void *ddx, void *state, int ncav, int nbasis, int nsph, const double *psi, const double *phi_cav, const double *e_cav, void *error)
void ddx_cosmo_setup(const void *ddx, void *state, int ncav, int nbasis, int nsph, const double *psi, const double *phi_cav, void *error)
void ddx_pcm_guess_adjoint(const void *ddx, void *state, void *error)
int ddx_get_n_lebedev(const void *ddx)
double ddx_get_solvent_epsilon(const void *ddx)
void ddx_get_error_message(const void *error, char *message, int maxlen)
int ddx_get_n_proc(const void *ddx)
void ddx_multipole_psi(const void *ddx, int nbasis, int nsph, int nmultipoles, const double *multipoles, double *psi, void *error)
void ddx_cosmo_guess(const void *ddx, void *state, void *error)
int ddx_get_n_spheres(const void *ddx)
void ddx_get_zeta_dip(const void *state, const void *ddx, int ncav, double *zeta_dip)
int ddx_get_s_niter(const void *state)
void ddx_get_banner(char *banner, int maxlen)
int ddx_get_enable_fmm(const void *ddx)
int ddx_get_lmax(const void *ddx)
void ddx_get_x(const void *state, int nbasis, int nsph, double *x)
void ddx_multipole_force_terms(const void *ddx, void *state, int nsph, int nmultipoles, const double *multipoles, double *forces, void *error)
double ddx_lpb_energy(const void *ddx, void *state, void *error)
void ddx_get_xi(const void *state, const void *ddx, int ncav, double *xi)
int ddx_get_incore(const void *ddx)
int ddx_get_x_niter(const void *state)
double ddx_energy(const void *ddx, void *state, void *error)
void ddx_deallocate_electrostatics(void *electrostatics, void *error)
void ddx_deallocate_model(void *ddx, void *error)
void ddx_scaled_ylm(const void *ddx, int lmax, const double *x, int sphere, double *ylm)
void ddx_pcm_solvation_force_terms(const void *ddx, void *state, int nsph, int ncav, const double *e_cav, double *forces, void *error)
void ddx_setup(const void *ddx, void *state, const void *electrostatics, int nbasis, int nsph, const double *psi, void *error)
double ddx_get_eta(const void *ddx)
void ddx_cosmo_solvation_force_terms(const void *ddx, void *state, int nsph, int ncav, const double *e_cav, double *forces, void *error)
void ddx_lpb_solve(const void *ddx, void *state, double tol, void *error)
int ddx_get_maxiter(const void *ddx)
int ddx_get_enable_force(const void *ddx)
int ddx_get_model(const void *ddx)
double ddx_get_shift(const void *ddx)
double ddx_ddrun(const void *ddx, void *state, void *electrostatics, int nbasis, int nsph, double *psi, const double tol, double *forces, int read_guess, void *error)
int ddx_supported_lebedev_grids(int maxlen, int *grids)
void ddx_deallocate_state(void *state, void *error)
int ddx_get_n_basis(const void *ddx)
void ddx_lpb_guess(const void *ddx, void *state, double tol, void *error)
void ddx_cosmo_solve(const void *ddx, void *state, double tol, void *error)
void ddx_lpb_solve_adjoint(const void *ddx, void *state, double tol, void *error)
void ddx_get_sphere_radii(const void *ddx, int nsph, double *c_rsph)
void * ddx_allocate_error()
void ddx_fill_guess_adjoint(const void *ddx, void *state, double tol, void *error)
void * ddx_allocate_electrostatics(void *ddx, void *error)
int ddx_get_jacobi_n_diis(const void *ddx)
void * ddx_allocate_model(int model, int enable_force, double solvent_epsilon, double solvent_kappa, double eta, double shift, int lmax, int n_lebedev, int incore, int maxiter, int jacobi_n_diis, int enable_fmm, int fmm_multipole_lmax, int fmm_local_lmax, int n_proc, int n_spheres, const double *sphere_centres, const double *sphere_radii, int length_logfile, const char *logfile, void *error)
void ddx_pcm_guess(const void *ddx, void *state, void *error)
void ddx_solve(const void *ddx, void *state, double tol, void *error)
void ddx_pcm_solve(const void *ddx, void *state, double tol, void *error)
int ddx_get_fmm_multipole_lmax(const void *ddx)
int ddx_get_fmm_local_lmax(const void *ddx)
void ddx_multipole_electrostatics_1(const void *ddx, int nsph, int ncav, int nmultipoles, const double *multipoles, double *phi_cav, double *e_cav, void *error)
High-level module of the ddX software.
Definition: ddx.f90:2