(git:6ba6522)
Loading...
Searching...
No Matches
grid_api.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: BSD-3-Clause !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Fortran API for the grid package, which is written in C.
10!> \author Ole Schuett
11! **************************************************************************************************
12MODULE grid_api
13 USE iso_c_binding, ONLY: &
14 c_associated, c_bool, c_char, c_double, c_funloc, c_funptr, c_int, c_loc, c_null_ptr, c_ptr
15 USE kinds, ONLY: dp
16 USE message_passing, ONLY: mp_comm_type
17 USE offload_api, ONLY: offload_buffer_type
18 USE realspace_grid_types, ONLY: realspace_grid_type
19#include "../base/base_uses.f90"
20
21 IMPLICIT NONE
22
23 PRIVATE
24
25 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'grid_api'
26
27 INTEGER, PARAMETER, PUBLIC :: grid_func_ab = 100
28 INTEGER, PARAMETER, PUBLIC :: grid_func_dadb = 200
29 INTEGER, PARAMETER, PUBLIC :: grid_func_adbmdab_x = 301
30 INTEGER, PARAMETER, PUBLIC :: grid_func_adbmdab_y = 302
31 INTEGER, PARAMETER, PUBLIC :: grid_func_adbmdab_z = 303
32 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_xx = 411
33 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_xy = 412
34 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_xz = 413
35 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_yx = 421
36 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_yy = 422
37 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_yz = 423
38 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_zx = 431
39 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_zy = 432
40 INTEGER, PARAMETER, PUBLIC :: grid_func_ardbmdarb_zz = 433
41 INTEGER, PARAMETER, PUBLIC :: grid_func_dabpadb_x = 501
42 INTEGER, PARAMETER, PUBLIC :: grid_func_dabpadb_y = 502
43 INTEGER, PARAMETER, PUBLIC :: grid_func_dabpadb_z = 503
44 INTEGER, PARAMETER, PUBLIC :: grid_func_dx = 601
45 INTEGER, PARAMETER, PUBLIC :: grid_func_dy = 602
46 INTEGER, PARAMETER, PUBLIC :: grid_func_dz = 603
47 INTEGER, PARAMETER, PUBLIC :: grid_func_dxdy = 701
48 INTEGER, PARAMETER, PUBLIC :: grid_func_dydz = 702
49 INTEGER, PARAMETER, PUBLIC :: grid_func_dzdx = 703
50 INTEGER, PARAMETER, PUBLIC :: grid_func_dxdx = 801
51 INTEGER, PARAMETER, PUBLIC :: grid_func_dydy = 802
52 INTEGER, PARAMETER, PUBLIC :: grid_func_dzdz = 803
53 INTEGER, PARAMETER, PUBLIC :: grid_func_dab_x = 901
54 INTEGER, PARAMETER, PUBLIC :: grid_func_dab_y = 902
55 INTEGER, PARAMETER, PUBLIC :: grid_func_dab_z = 903
56 INTEGER, PARAMETER, PUBLIC :: grid_func_adb_x = 904
57 INTEGER, PARAMETER, PUBLIC :: grid_func_adb_y = 905
58 INTEGER, PARAMETER, PUBLIC :: grid_func_adb_z = 906
59
60 INTEGER, PARAMETER, PUBLIC :: grid_func_core_x = 1001
61 INTEGER, PARAMETER, PUBLIC :: grid_func_core_y = 1002
62 INTEGER, PARAMETER, PUBLIC :: grid_func_core_z = 1003
63
64 INTEGER, PARAMETER, PUBLIC :: grid_backend_auto = 10
65 INTEGER, PARAMETER, PUBLIC :: grid_backend_ref = 11
66 INTEGER, PARAMETER, PUBLIC :: grid_backend_cpu = 12
67 INTEGER, PARAMETER, PUBLIC :: grid_backend_dgemm = 13
68 INTEGER, PARAMETER, PUBLIC :: grid_backend_gpu = 14
69
70 PUBLIC :: grid_library_init, grid_library_finalize
71 PUBLIC :: grid_library_set_config, grid_library_print_stats
72 PUBLIC :: collocate_pgf_product, integrate_pgf_product
73 PUBLIC :: grid_basis_set_type, grid_create_basis_set, grid_free_basis_set
74 PUBLIC :: grid_task_list_type, grid_create_task_list, grid_free_task_list
75 PUBLIC :: grid_collocate_task_list, grid_integrate_task_list
76
77 TYPE grid_basis_set_type
78 PRIVATE
79 TYPE(C_PTR) :: c_ptr = c_null_ptr
80 END TYPE grid_basis_set_type
81
82 TYPE grid_task_list_type
83 PRIVATE
84 TYPE(C_PTR) :: c_ptr = c_null_ptr
85 END TYPE grid_task_list_type
86
87CONTAINS
88
89! **************************************************************************************************
90!> \brief low level collocation of primitive gaussian functions
91!> \param la_max ...
92!> \param zeta ...
93!> \param la_min ...
94!> \param lb_max ...
95!> \param zetb ...
96!> \param lb_min ...
97!> \param ra ...
98!> \param rab ...
99!> \param scale ...
100!> \param pab ...
101!> \param o1 ...
102!> \param o2 ...
103!> \param rsgrid ...
104!> \param ga_gb_function ...
105!> \param radius ...
106!> \param use_subpatch ...
107!> \param subpatch_pattern ...
108!> \author Ole Schuett
109! **************************************************************************************************
110 SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
111 lb_max, zetb, lb_min, &
112 ra, rab, scale, pab, o1, o2, &
113 rsgrid, &
114 ga_gb_function, radius, &
115 use_subpatch, subpatch_pattern)
116
117 INTEGER, INTENT(IN) :: la_max
118 REAL(kind=dp), INTENT(IN) :: zeta
119 INTEGER, INTENT(IN) :: la_min, lb_max
120 REAL(kind=dp), INTENT(IN) :: zetb
121 INTEGER, INTENT(IN) :: lb_min
122 REAL(kind=dp), DIMENSION(3), INTENT(IN), TARGET :: ra, rab
123 REAL(kind=dp), INTENT(IN) :: scale
124 REAL(kind=dp), DIMENSION(:, :), POINTER :: pab
125 INTEGER, INTENT(IN) :: o1, o2
126 TYPE(realspace_grid_type) :: rsgrid
127 INTEGER, INTENT(IN) :: ga_gb_function
128 REAL(kind=dp), INTENT(IN) :: radius
129 LOGICAL, OPTIONAL :: use_subpatch
130 INTEGER, INTENT(IN), OPTIONAL :: subpatch_pattern
131
132 INTEGER :: border_mask
133 INTEGER, DIMENSION(3), TARGET :: border_width, npts_global, npts_local, &
134 shift_local
135 LOGICAL(KIND=C_BOOL) :: orthorhombic
136 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: grid
137 INTERFACE
138 SUBROUTINE grid_cpu_collocate_pgf_product_c(orthorhombic, &
139 border_mask, func, &
140 la_max, la_min, lb_max, lb_min, &
141 zeta, zetb, rscale, dh, dh_inv, ra, rab, &
142 npts_global, npts_local, shift_local, border_width, &
143 radius, o1, o2, n1, n2, pab, &
144 grid) &
145 BIND(C, name="grid_cpu_collocate_pgf_product")
146 IMPORT :: c_ptr, c_int, c_double, c_bool
147 LOGICAL(KIND=C_BOOL), VALUE :: orthorhombic
148 INTEGER(KIND=C_INT), VALUE :: border_mask
149 INTEGER(KIND=C_INT), VALUE :: func
150 INTEGER(KIND=C_INT), VALUE :: la_max
151 INTEGER(KIND=C_INT), VALUE :: la_min
152 INTEGER(KIND=C_INT), VALUE :: lb_max
153 INTEGER(KIND=C_INT), VALUE :: lb_min
154 REAL(kind=c_double), VALUE :: zeta
155 REAL(kind=c_double), VALUE :: zetb
156 REAL(kind=c_double), VALUE :: rscale
157 TYPE(c_ptr), VALUE :: dh
158 TYPE(c_ptr), VALUE :: dh_inv
159 TYPE(c_ptr), VALUE :: ra
160 TYPE(c_ptr), VALUE :: rab
161 TYPE(c_ptr), VALUE :: npts_global
162 TYPE(c_ptr), VALUE :: npts_local
163 TYPE(c_ptr), VALUE :: shift_local
164 TYPE(c_ptr), VALUE :: border_width
165 REAL(kind=c_double), VALUE :: radius
166 INTEGER(KIND=C_INT), VALUE :: o1
167 INTEGER(KIND=C_INT), VALUE :: o2
168 INTEGER(KIND=C_INT), VALUE :: n1
169 INTEGER(KIND=C_INT), VALUE :: n2
170 TYPE(c_ptr), VALUE :: pab
171 TYPE(c_ptr), VALUE :: grid
172 END SUBROUTINE grid_cpu_collocate_pgf_product_c
173 END INTERFACE
174
175 border_mask = 0
176 IF (PRESENT(use_subpatch)) THEN
177 IF (use_subpatch) THEN
178 cpassert(PRESENT(subpatch_pattern))
179 border_mask = iand(63, not(subpatch_pattern)) ! invert last 6 bits
180 END IF
181 END IF
182
183 orthorhombic = LOGICAL(rsgrid%desc%orthorhombic, c_bool)
184
185 cpassert(lbound(pab, 1) == 1)
186 cpassert(lbound(pab, 2) == 1)
187
188 CALL get_rsgrid_properties(rsgrid, npts_global=npts_global, &
189 npts_local=npts_local, &
190 shift_local=shift_local, &
191 border_width=border_width)
192
193 grid(1:, 1:, 1:) => rsgrid%r(:, :, :) ! pointer assignment
194
195 cpassert(is_contiguous(rsgrid%desc%dh))
196 cpassert(is_contiguous(rsgrid%desc%dh_inv))
197 cpassert(is_contiguous(ra))
198 cpassert(is_contiguous(rab))
199 cpassert(is_contiguous(npts_global))
200 cpassert(is_contiguous(npts_local))
201 cpassert(is_contiguous(shift_local))
202 cpassert(is_contiguous(border_width))
203 cpassert(is_contiguous(pab))
204 cpassert(is_contiguous(grid))
205
206 ! For collocating a single pgf product we use the optimized cpu backend.
207
208 CALL grid_cpu_collocate_pgf_product_c(orthorhombic=orthorhombic, &
209 border_mask=border_mask, &
210 func=ga_gb_function, &
211 la_max=la_max, &
212 la_min=la_min, &
213 lb_max=lb_max, &
214 lb_min=lb_min, &
215 zeta=zeta, &
216 zetb=zetb, &
217 rscale=scale, &
218 dh=c_loc(rsgrid%desc%dh(1, 1)), &
219 dh_inv=c_loc(rsgrid%desc%dh_inv(1, 1)), &
220 ra=c_loc(ra(1)), &
221 rab=c_loc(rab(1)), &
222 npts_global=c_loc(npts_global(1)), &
223 npts_local=c_loc(npts_local(1)), &
224 shift_local=c_loc(shift_local(1)), &
225 border_width=c_loc(border_width(1)), &
226 radius=radius, &
227 o1=o1, &
228 o2=o2, &
229 n1=SIZE(pab, 1), &
230 n2=SIZE(pab, 2), &
231 pab=c_loc(pab(1, 1)), &
232 grid=c_loc(grid(1, 1, 1)))
233
234 END SUBROUTINE collocate_pgf_product
235
236! **************************************************************************************************
237!> \brief low level function to compute matrix elements of primitive gaussian functions
238!> \param la_max ...
239!> \param zeta ...
240!> \param la_min ...
241!> \param lb_max ...
242!> \param zetb ...
243!> \param lb_min ...
244!> \param ra ...
245!> \param rab ...
246!> \param rsgrid ...
247!> \param hab ...
248!> \param pab ...
249!> \param o1 ...
250!> \param o2 ...
251!> \param radius ...
252!> \param calculate_forces ...
253!> \param force_a ...
254!> \param force_b ...
255!> \param compute_tau ...
256!> \param use_virial ...
257!> \param my_virial_a ...
258!> \param my_virial_b ...
259!> \param hdab Derivative with respect to the primitive on the left.
260!> \param hadb Derivative with respect to the primitive on the right.
261!> \param a_hdab ...
262!> \param use_subpatch ...
263!> \param subpatch_pattern ...
264! **************************************************************************************************
265 SUBROUTINE integrate_pgf_product(la_max, zeta, la_min, &
266 lb_max, zetb, lb_min, &
267 ra, rab, rsgrid, &
268 hab, pab, o1, o2, &
269 radius, &
270 calculate_forces, force_a, force_b, &
271 compute_tau, &
272 use_virial, my_virial_a, &
273 my_virial_b, hdab, hadb, a_hdab, use_subpatch, subpatch_pattern)
274
275 INTEGER, INTENT(IN) :: la_max
276 REAL(kind=dp), INTENT(IN) :: zeta
277 INTEGER, INTENT(IN) :: la_min, lb_max
278 REAL(kind=dp), INTENT(IN) :: zetb
279 INTEGER, INTENT(IN) :: lb_min
280 REAL(kind=dp), DIMENSION(3), INTENT(IN), TARGET :: ra, rab
281 TYPE(realspace_grid_type), INTENT(IN) :: rsgrid
282 REAL(kind=dp), DIMENSION(:, :), POINTER :: hab
283 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: pab
284 INTEGER, INTENT(IN) :: o1, o2
285 REAL(kind=dp), INTENT(IN) :: radius
286 LOGICAL, INTENT(IN) :: calculate_forces
287 REAL(kind=dp), DIMENSION(3), INTENT(INOUT), &
288 OPTIONAL :: force_a, force_b
289 LOGICAL, INTENT(IN), OPTIONAL :: compute_tau, use_virial
290 REAL(kind=dp), DIMENSION(3, 3), OPTIONAL :: my_virial_a, my_virial_b
291 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
292 POINTER :: hdab, hadb
293 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, &
294 POINTER :: a_hdab
295 LOGICAL, OPTIONAL :: use_subpatch
296 INTEGER, INTENT(IN), OPTIONAL :: subpatch_pattern
297
298 INTEGER :: border_mask
299 INTEGER, DIMENSION(3), TARGET :: border_width, npts_global, npts_local, &
300 shift_local
301 LOGICAL :: my_use_virial
302 LOGICAL(KIND=C_BOOL) :: my_compute_tau, orthorhombic
303 REAL(kind=dp), DIMENSION(3, 2), TARGET :: forces
304 REAL(kind=dp), DIMENSION(3, 3, 2), TARGET :: virials
305 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: grid
306 TYPE(c_ptr) :: a_hdab_cptr, forces_cptr, hadb_cptr, &
307 hdab_cptr, pab_cptr, virials_cptr
308 INTERFACE
309 SUBROUTINE grid_cpu_integrate_pgf_product_c(orthorhombic, compute_tau, &
310 border_mask, &
311 la_max, la_min, lb_max, lb_min, &
312 zeta, zetb, dh, dh_inv, ra, rab, &
313 npts_global, npts_local, shift_local, border_width, &
314 radius, o1, o2, n1, n2, grid, hab, pab, &
315 forces, virials, hdab, hadb, a_hdab) &
316 BIND(C, name="grid_cpu_integrate_pgf_product")
317 IMPORT :: c_ptr, c_int, c_double, c_bool
318 LOGICAL(KIND=C_BOOL), VALUE :: orthorhombic
319 LOGICAL(KIND=C_BOOL), VALUE :: compute_tau
320 INTEGER(KIND=C_INT), VALUE :: border_mask
321 INTEGER(KIND=C_INT), VALUE :: la_max
322 INTEGER(KIND=C_INT), VALUE :: la_min
323 INTEGER(KIND=C_INT), VALUE :: lb_max
324 INTEGER(KIND=C_INT), VALUE :: lb_min
325 REAL(kind=c_double), VALUE :: zeta
326 REAL(kind=c_double), VALUE :: zetb
327 TYPE(c_ptr), VALUE :: dh
328 TYPE(c_ptr), VALUE :: dh_inv
329 TYPE(c_ptr), VALUE :: ra
330 TYPE(c_ptr), VALUE :: rab
331 TYPE(c_ptr), VALUE :: npts_global
332 TYPE(c_ptr), VALUE :: npts_local
333 TYPE(c_ptr), VALUE :: shift_local
334 TYPE(c_ptr), VALUE :: border_width
335 REAL(kind=c_double), VALUE :: radius
336 INTEGER(KIND=C_INT), VALUE :: o1
337 INTEGER(KIND=C_INT), VALUE :: o2
338 INTEGER(KIND=C_INT), VALUE :: n1
339 INTEGER(KIND=C_INT), VALUE :: n2
340 TYPE(c_ptr), VALUE :: grid
341 TYPE(c_ptr), VALUE :: hab
342 TYPE(c_ptr), VALUE :: pab
343 TYPE(c_ptr), VALUE :: forces
344 TYPE(c_ptr), VALUE :: virials
345 TYPE(c_ptr), VALUE :: hdab
346 TYPE(c_ptr), VALUE :: hadb
347 TYPE(c_ptr), VALUE :: a_hdab
348 END SUBROUTINE grid_cpu_integrate_pgf_product_c
349 END INTERFACE
350
351 IF (radius == 0.0_dp) THEN
352 RETURN
353 END IF
354
355 border_mask = 0
356 IF (PRESENT(use_subpatch)) THEN
357 IF (use_subpatch) THEN
358 cpassert(PRESENT(subpatch_pattern))
359 border_mask = iand(63, not(subpatch_pattern)) ! invert last 6 bits
360 END IF
361 END IF
362
363 ! When true then 0.5 * (nabla x_a).(v(r) nabla x_b) is computed.
364 IF (PRESENT(compute_tau)) THEN
365 my_compute_tau = LOGICAL(compute_tau, c_bool)
366 ELSE
367 my_compute_tau = .false.
368 END IF
369
370 IF (PRESENT(use_virial)) THEN
371 my_use_virial = use_virial
372 ELSE
373 my_use_virial = .false.
374 END IF
375
376 IF (calculate_forces) THEN
377 cpassert(PRESENT(pab))
378 pab_cptr = c_loc(pab(1, 1))
379 forces(:, :) = 0.0_dp
380 forces_cptr = c_loc(forces(1, 1))
381 ELSE
382 pab_cptr = c_null_ptr
383 forces_cptr = c_null_ptr
384 END IF
385
386 IF (calculate_forces .AND. my_use_virial) THEN
387 virials(:, :, :) = 0.0_dp
388 virials_cptr = c_loc(virials(1, 1, 1))
389 ELSE
390 virials_cptr = c_null_ptr
391 END IF
392
393 IF (calculate_forces .AND. PRESENT(hdab)) THEN
394 hdab_cptr = c_loc(hdab(1, 1, 1))
395 ELSE
396 hdab_cptr = c_null_ptr
397 END IF
398
399 IF (calculate_forces .AND. PRESENT(hadb)) THEN
400 hadb_cptr = c_loc(hadb(1, 1, 1))
401 ELSE
402 hadb_cptr = c_null_ptr
403 END IF
404
405 IF (calculate_forces .AND. my_use_virial .AND. PRESENT(a_hdab)) THEN
406 a_hdab_cptr = c_loc(a_hdab(1, 1, 1, 1))
407 ELSE
408 a_hdab_cptr = c_null_ptr
409 END IF
410
411 orthorhombic = LOGICAL(rsgrid%desc%orthorhombic, c_bool)
412
413 CALL get_rsgrid_properties(rsgrid, npts_global=npts_global, &
414 npts_local=npts_local, &
415 shift_local=shift_local, &
416 border_width=border_width)
417
418 grid(1:, 1:, 1:) => rsgrid%r(:, :, :) ! pointer assignment
419
420 cpassert(is_contiguous(rsgrid%desc%dh))
421 cpassert(is_contiguous(rsgrid%desc%dh_inv))
422 cpassert(is_contiguous(ra))
423 cpassert(is_contiguous(rab))
424 cpassert(is_contiguous(npts_global))
425 cpassert(is_contiguous(npts_local))
426 cpassert(is_contiguous(shift_local))
427 cpassert(is_contiguous(border_width))
428 cpassert(is_contiguous(grid))
429 cpassert(is_contiguous(hab))
430 cpassert(is_contiguous(forces))
431 cpassert(is_contiguous(virials))
432 IF (PRESENT(pab)) THEN
433 cpassert(is_contiguous(pab))
434 END IF
435 IF (PRESENT(hdab)) THEN
436 cpassert(is_contiguous(hdab))
437 END IF
438 IF (PRESENT(a_hdab)) THEN
439 cpassert(is_contiguous(a_hdab))
440 END IF
441
442 CALL grid_cpu_integrate_pgf_product_c(orthorhombic=orthorhombic, &
443 compute_tau=my_compute_tau, &
444 border_mask=border_mask, &
445 la_max=la_max, &
446 la_min=la_min, &
447 lb_max=lb_max, &
448 lb_min=lb_min, &
449 zeta=zeta, &
450 zetb=zetb, &
451 dh=c_loc(rsgrid%desc%dh(1, 1)), &
452 dh_inv=c_loc(rsgrid%desc%dh_inv(1, 1)), &
453 ra=c_loc(ra(1)), &
454 rab=c_loc(rab(1)), &
455 npts_global=c_loc(npts_global(1)), &
456 npts_local=c_loc(npts_local(1)), &
457 shift_local=c_loc(shift_local(1)), &
458 border_width=c_loc(border_width(1)), &
459 radius=radius, &
460 o1=o1, &
461 o2=o2, &
462 n1=SIZE(hab, 1), &
463 n2=SIZE(hab, 2), &
464 grid=c_loc(grid(1, 1, 1)), &
465 hab=c_loc(hab(1, 1)), &
466 pab=pab_cptr, &
467 forces=forces_cptr, &
468 virials=virials_cptr, &
469 hdab=hdab_cptr, &
470 hadb=hadb_cptr, &
471 a_hdab=a_hdab_cptr)
472
473 IF (PRESENT(force_a) .AND. c_associated(forces_cptr)) THEN
474 force_a = force_a + forces(:, 1)
475 END IF
476 IF (PRESENT(force_b) .AND. c_associated(forces_cptr)) THEN
477 force_b = force_b + forces(:, 2)
478 END IF
479 IF (PRESENT(my_virial_a) .AND. c_associated(virials_cptr)) THEN
480 my_virial_a = my_virial_a + virials(:, :, 1)
481 END IF
482 IF (PRESENT(my_virial_b) .AND. c_associated(virials_cptr)) THEN
483 my_virial_b = my_virial_b + virials(:, :, 2)
484 END IF
485
486 END SUBROUTINE integrate_pgf_product
487
488! **************************************************************************************************
489!> \brief Helper routines for getting rsgrid properties and asserting underlying assumptions.
490!> \param rsgrid ...
491!> \param npts_global ...
492!> \param npts_local ...
493!> \param shift_local ...
494!> \param border_width ...
495!> \author Ole Schuett
496! **************************************************************************************************
497 SUBROUTINE get_rsgrid_properties(rsgrid, npts_global, npts_local, shift_local, border_width)
498 TYPE(realspace_grid_type), INTENT(IN) :: rsgrid
499 INTEGER, DIMENSION(:) :: npts_global, npts_local, shift_local, &
500 border_width
501
502 INTEGER :: i
503
504 ! See rs_grid_create() in ./src/pw/realspace_grid_types.F.
505 cpassert(lbound(rsgrid%r, 1) == rsgrid%lb_local(1))
506 cpassert(ubound(rsgrid%r, 1) == rsgrid%ub_local(1))
507 cpassert(lbound(rsgrid%r, 2) == rsgrid%lb_local(2))
508 cpassert(ubound(rsgrid%r, 2) == rsgrid%ub_local(2))
509 cpassert(lbound(rsgrid%r, 3) == rsgrid%lb_local(3))
510 cpassert(ubound(rsgrid%r, 3) == rsgrid%ub_local(3))
511
512 ! While the rsgrid code assumes that the grid starts at rsgrid%lb,
513 ! the collocate code assumes that the grid starts at (1,1,1) in Fortran, or (0,0,0) in C.
514 ! So, a point rp(:) gets the following grid coordinates MODULO(rp(:)/dr(:),npts_global(:))
515
516 ! Number of global grid points in each direction.
517 npts_global = rsgrid%desc%ub - rsgrid%desc%lb + 1
518
519 ! Number of local grid points in each direction.
520 npts_local = rsgrid%ub_local - rsgrid%lb_local + 1
521
522 ! Number of points the local grid is shifted wrt global grid.
523 shift_local = rsgrid%lb_local - rsgrid%desc%lb
524
525 ! Convert rsgrid%desc%border and rsgrid%desc%perd into the more convenient border_width array.
526 DO i = 1, 3
527 IF (rsgrid%desc%perd(i) == 1) THEN
528 ! Periodic meaning the grid in this direction is entriely present on every processor.
529 cpassert(npts_local(i) == npts_global(i))
530 cpassert(shift_local(i) == 0)
531 ! No need for halo regions.
532 border_width(i) = 0
533 ELSE
534 ! Not periodic meaning the grid in this direction is distributed among processors.
535 cpassert(npts_local(i) <= npts_global(i))
536 ! Check bounds of grid section that is owned by this processor.
537 cpassert(rsgrid%lb_real(i) == rsgrid%lb_local(i) + rsgrid%desc%border)
538 cpassert(rsgrid%ub_real(i) == rsgrid%ub_local(i) - rsgrid%desc%border)
539 ! We have halo regions.
540 border_width(i) = rsgrid%desc%border
541 END IF
542 END DO
543 END SUBROUTINE get_rsgrid_properties
544
545! **************************************************************************************************
546!> \brief Allocates a basis set which can be passed to grid_create_task_list.
547!> \param nset ...
548!> \param nsgf ...
549!> \param maxco ...
550!> \param maxpgf ...
551!> \param lmin ...
552!> \param lmax ...
553!> \param npgf ...
554!> \param nsgf_set ...
555!> \param first_sgf ...
556!> \param sphi ...
557!> \param zet ...
558!> \param basis_set ...
559!> \author Ole Schuett
560! **************************************************************************************************
561 SUBROUTINE grid_create_basis_set(nset, nsgf, maxco, maxpgf, &
562 lmin, lmax, npgf, nsgf_set, first_sgf, sphi, zet, &
563 basis_set)
564 INTEGER, INTENT(IN) :: nset, nsgf, maxco, maxpgf
565 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: lmin, lmax, npgf, nsgf_set
566 INTEGER, DIMENSION(:, :), INTENT(IN) :: first_sgf
567 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: sphi, zet
568 TYPE(grid_basis_set_type), INTENT(INOUT) :: basis_set
569
570 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_create_basis_set'
571
572 INTEGER :: handle
573 INTEGER, DIMENSION(nset), TARGET :: my_first_sgf
574 TYPE(c_ptr) :: first_sgf_c, lmax_c, lmin_c, npgf_c, &
575 nsgf_set_c, sphi_c, zet_c
576 INTERFACE
577 SUBROUTINE grid_create_basis_set_c(nset, nsgf, maxco, maxpgf, &
578 lmin, lmax, npgf, nsgf_set, first_sgf, sphi, zet, &
579 basis_set) &
580 BIND(C, name="grid_create_basis_set")
581 IMPORT :: c_ptr, c_int
582 INTEGER(KIND=C_INT), VALUE :: nset
583 INTEGER(KIND=C_INT), VALUE :: nsgf
584 INTEGER(KIND=C_INT), VALUE :: maxco
585 INTEGER(KIND=C_INT), VALUE :: maxpgf
586 TYPE(c_ptr), VALUE :: lmin
587 TYPE(c_ptr), VALUE :: lmax
588 TYPE(c_ptr), VALUE :: npgf
589 TYPE(c_ptr), VALUE :: nsgf_set
590 TYPE(c_ptr), VALUE :: first_sgf
591 TYPE(c_ptr), VALUE :: sphi
592 TYPE(c_ptr), VALUE :: zet
593 TYPE(c_ptr) :: basis_set
594 END SUBROUTINE grid_create_basis_set_c
595 END INTERFACE
596
597 CALL timeset(routinen, handle)
598
599 cpassert(SIZE(lmin) == nset)
600 cpassert(SIZE(lmin) == nset)
601 cpassert(SIZE(lmax) == nset)
602 cpassert(SIZE(npgf) == nset)
603 cpassert(SIZE(nsgf_set) == nset)
604 cpassert(SIZE(first_sgf, 2) == nset)
605 cpassert(SIZE(sphi, 1) == maxco .AND. SIZE(sphi, 2) == nsgf)
606 cpassert(SIZE(zet, 1) == maxpgf .AND. SIZE(zet, 2) == nset)
607 cpassert(.NOT. c_associated(basis_set%c_ptr))
608
609 cpassert(is_contiguous(lmin))
610 cpassert(is_contiguous(lmax))
611 cpassert(is_contiguous(npgf))
612 cpassert(is_contiguous(nsgf_set))
613 cpassert(is_contiguous(my_first_sgf))
614 cpassert(is_contiguous(sphi))
615 cpassert(is_contiguous(zet))
616
617 lmin_c = c_null_ptr
618 lmax_c = c_null_ptr
619 npgf_c = c_null_ptr
620 nsgf_set_c = c_null_ptr
621 first_sgf_c = c_null_ptr
622 sphi_c = c_null_ptr
623 zet_c = c_null_ptr
624
625 ! Basis sets arrays can be empty, need to check before accessing the first element.
626 IF (nset > 0) THEN
627 lmin_c = c_loc(lmin(1))
628 lmax_c = c_loc(lmax(1))
629 npgf_c = c_loc(npgf(1))
630 nsgf_set_c = c_loc(nsgf_set(1))
631 END IF
632 IF (SIZE(first_sgf) > 0) THEN
633 my_first_sgf(:) = first_sgf(1, :) ! make a contiguous copy
634 first_sgf_c = c_loc(my_first_sgf(1))
635 END IF
636 IF (SIZE(sphi) > 0) THEN
637 sphi_c = c_loc(sphi(1, 1))
638 END IF
639 IF (SIZE(zet) > 0) THEN
640 zet_c = c_loc(zet(1, 1))
641 END IF
642
643 CALL grid_create_basis_set_c(nset=nset, &
644 nsgf=nsgf, &
645 maxco=maxco, &
646 maxpgf=maxpgf, &
647 lmin=lmin_c, &
648 lmax=lmax_c, &
649 npgf=npgf_c, &
650 nsgf_set=nsgf_set_c, &
651 first_sgf=first_sgf_c, &
652 sphi=sphi_c, &
653 zet=zet_c, &
654 basis_set=basis_set%c_ptr)
655 cpassert(c_associated(basis_set%c_ptr))
656
657 CALL timestop(handle)
658 END SUBROUTINE grid_create_basis_set
659
660! **************************************************************************************************
661!> \brief Deallocates given basis set.
662!> \param basis_set ...
663!> \author Ole Schuett
664! **************************************************************************************************
665 SUBROUTINE grid_free_basis_set(basis_set)
666 TYPE(grid_basis_set_type), INTENT(INOUT) :: basis_set
667
668 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_free_basis_set'
669
670 INTEGER :: handle
671 INTERFACE
672 SUBROUTINE grid_free_basis_set_c(basis_set) &
673 BIND(C, name="grid_free_basis_set")
674 IMPORT :: c_ptr
675 TYPE(c_ptr), VALUE :: basis_set
676 END SUBROUTINE grid_free_basis_set_c
677 END INTERFACE
678
679 CALL timeset(routinen, handle)
680
681 cpassert(c_associated(basis_set%c_ptr))
682
683 CALL grid_free_basis_set_c(basis_set%c_ptr)
684
685 basis_set%c_ptr = c_null_ptr
686
687 CALL timestop(handle)
688 END SUBROUTINE grid_free_basis_set
689
690! **************************************************************************************************
691!> \brief Allocates a task list which can be passed to grid_collocate_task_list.
692!> \param ntasks ...
693!> \param natoms ...
694!> \param nkinds ...
695!> \param nblocks ...
696!> \param block_offsets ...
697!> \param atom_positions ...
698!> \param atom_kinds ...
699!> \param basis_sets ...
700!> \param level_list ...
701!> \param iatom_list ...
702!> \param jatom_list ...
703!> \param iset_list ...
704!> \param jset_list ...
705!> \param ipgf_list ...
706!> \param jpgf_list ...
707!> \param border_mask_list ...
708!> \param block_num_list ...
709!> \param radius_list ...
710!> \param rab_list ...
711!> \param rs_grids ...
712!> \param task_list ...
713!> \author Ole Schuett
714! **************************************************************************************************
715 SUBROUTINE grid_create_task_list(ntasks, natoms, nkinds, nblocks, &
716 block_offsets, atom_positions, atom_kinds, basis_sets, &
717 level_list, iatom_list, jatom_list, &
718 iset_list, jset_list, ipgf_list, jpgf_list, &
719 border_mask_list, block_num_list, &
720 radius_list, rab_list, rs_grids, task_list)
721
722 INTEGER, INTENT(IN) :: ntasks, natoms, nkinds, nblocks
723 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: block_offsets
724 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: atom_positions
725 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: atom_kinds
726 TYPE(grid_basis_set_type), DIMENSION(:), &
727 INTENT(IN), TARGET :: basis_sets
728 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: level_list, iatom_list, jatom_list, &
729 iset_list, jset_list, ipgf_list, &
730 jpgf_list, border_mask_list, &
731 block_num_list
732 REAL(kind=dp), DIMENSION(:), INTENT(IN), TARGET :: radius_list
733 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: rab_list
734 TYPE(realspace_grid_type), DIMENSION(:), &
735 INTENT(IN) :: rs_grids
736 TYPE(grid_task_list_type), INTENT(INOUT) :: task_list
737
738 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_create_task_list'
739
740 INTEGER :: handle, ikind, ilevel, nlevels
741 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: border_width, npts_global, npts_local, &
742 shift_local
743 LOGICAL(KIND=C_BOOL) :: orthorhombic
744 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
745 TARGET :: dh, dh_inv
746 TYPE(c_ptr) :: block_num_list_c, block_offsets_c, border_mask_list_c, iatom_list_c, &
747 ipgf_list_c, iset_list_c, jatom_list_c, jpgf_list_c, jset_list_c, level_list_c, &
748 rab_list_c, radius_list_c
749 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: basis_sets_c
750 INTERFACE
751 SUBROUTINE grid_create_task_list_c(orthorhombic, &
752 ntasks, nlevels, natoms, nkinds, nblocks, &
753 block_offsets, atom_positions, atom_kinds, basis_sets, &
754 level_list, iatom_list, jatom_list, &
755 iset_list, jset_list, ipgf_list, jpgf_list, &
756 border_mask_list, block_num_list, &
757 radius_list, rab_list, &
758 npts_global, npts_local, shift_local, &
759 border_width, dh, dh_inv, task_list) &
760 BIND(C, name="grid_create_task_list")
761 IMPORT :: c_ptr, c_int, c_bool
762 LOGICAL(KIND=C_BOOL), VALUE :: orthorhombic
763 INTEGER(KIND=C_INT), VALUE :: ntasks
764 INTEGER(KIND=C_INT), VALUE :: nlevels
765 INTEGER(KIND=C_INT), VALUE :: natoms
766 INTEGER(KIND=C_INT), VALUE :: nkinds
767 INTEGER(KIND=C_INT), VALUE :: nblocks
768 TYPE(c_ptr), VALUE :: block_offsets
769 TYPE(c_ptr), VALUE :: atom_positions
770 TYPE(c_ptr), VALUE :: atom_kinds
771 TYPE(c_ptr), VALUE :: basis_sets
772 TYPE(c_ptr), VALUE :: level_list
773 TYPE(c_ptr), VALUE :: iatom_list
774 TYPE(c_ptr), VALUE :: jatom_list
775 TYPE(c_ptr), VALUE :: iset_list
776 TYPE(c_ptr), VALUE :: jset_list
777 TYPE(c_ptr), VALUE :: ipgf_list
778 TYPE(c_ptr), VALUE :: jpgf_list
779 TYPE(c_ptr), VALUE :: border_mask_list
780 TYPE(c_ptr), VALUE :: block_num_list
781 TYPE(c_ptr), VALUE :: radius_list
782 TYPE(c_ptr), VALUE :: rab_list
783 TYPE(c_ptr), VALUE :: npts_global
784 TYPE(c_ptr), VALUE :: npts_local
785 TYPE(c_ptr), VALUE :: shift_local
786 TYPE(c_ptr), VALUE :: border_width
787 TYPE(c_ptr), VALUE :: dh
788 TYPE(c_ptr), VALUE :: dh_inv
789 TYPE(c_ptr) :: task_list
790 END SUBROUTINE grid_create_task_list_c
791 END INTERFACE
792
793 CALL timeset(routinen, handle)
794
795 cpassert(SIZE(block_offsets) == nblocks)
796 cpassert(SIZE(atom_positions, 1) == 3 .AND. SIZE(atom_positions, 2) == natoms)
797 cpassert(SIZE(atom_kinds) == natoms)
798 cpassert(SIZE(basis_sets) == nkinds)
799 cpassert(SIZE(level_list) == ntasks)
800 cpassert(SIZE(iatom_list) == ntasks)
801 cpassert(SIZE(jatom_list) == ntasks)
802 cpassert(SIZE(iset_list) == ntasks)
803 cpassert(SIZE(jset_list) == ntasks)
804 cpassert(SIZE(ipgf_list) == ntasks)
805 cpassert(SIZE(jpgf_list) == ntasks)
806 cpassert(SIZE(border_mask_list) == ntasks)
807 cpassert(SIZE(block_num_list) == ntasks)
808 cpassert(SIZE(radius_list) == ntasks)
809 cpassert(SIZE(rab_list, 1) == 3 .AND. SIZE(rab_list, 2) == ntasks)
810
811 ALLOCATE (basis_sets_c(nkinds))
812 DO ikind = 1, nkinds
813 basis_sets_c(ikind) = basis_sets(ikind)%c_ptr
814 END DO
815
816 nlevels = SIZE(rs_grids)
817 cpassert(nlevels > 0)
818 orthorhombic = LOGICAL(rs_grids(1)%desc%orthorhombic, c_bool)
819
820 ALLOCATE (npts_global(3, nlevels), npts_local(3, nlevels))
821 ALLOCATE (shift_local(3, nlevels), border_width(3, nlevels))
822 ALLOCATE (dh(3, 3, nlevels), dh_inv(3, 3, nlevels))
823 DO ilevel = 1, nlevels
824 associate(rsgrid => rs_grids(ilevel))
825 CALL get_rsgrid_properties(rsgrid=rsgrid, &
826 npts_global=npts_global(:, ilevel), &
827 npts_local=npts_local(:, ilevel), &
828 shift_local=shift_local(:, ilevel), &
829 border_width=border_width(:, ilevel))
830 cpassert(rsgrid%desc%orthorhombic .EQV. orthorhombic) ! should be the same for all levels
831 dh(:, :, ilevel) = rsgrid%desc%dh(:, :)
832 dh_inv(:, :, ilevel) = rsgrid%desc%dh_inv(:, :)
833 END associate
834 END DO
835
836 cpassert(is_contiguous(block_offsets))
837 cpassert(is_contiguous(atom_positions))
838 cpassert(is_contiguous(atom_kinds))
839 cpassert(is_contiguous(basis_sets))
840 cpassert(is_contiguous(level_list))
841 cpassert(is_contiguous(iatom_list))
842 cpassert(is_contiguous(jatom_list))
843 cpassert(is_contiguous(iset_list))
844 cpassert(is_contiguous(jset_list))
845 cpassert(is_contiguous(ipgf_list))
846 cpassert(is_contiguous(jpgf_list))
847 cpassert(is_contiguous(border_mask_list))
848 cpassert(is_contiguous(block_num_list))
849 cpassert(is_contiguous(radius_list))
850 cpassert(is_contiguous(rab_list))
851 cpassert(is_contiguous(npts_global))
852 cpassert(is_contiguous(npts_local))
853 cpassert(is_contiguous(shift_local))
854 cpassert(is_contiguous(border_width))
855 cpassert(is_contiguous(dh))
856 cpassert(is_contiguous(dh_inv))
857
858 IF (ntasks > 0) THEN
859 block_offsets_c = c_loc(block_offsets(1))
860 level_list_c = c_loc(level_list(1))
861 iatom_list_c = c_loc(iatom_list(1))
862 jatom_list_c = c_loc(jatom_list(1))
863 iset_list_c = c_loc(iset_list(1))
864 jset_list_c = c_loc(jset_list(1))
865 ipgf_list_c = c_loc(ipgf_list(1))
866 jpgf_list_c = c_loc(jpgf_list(1))
867 border_mask_list_c = c_loc(border_mask_list(1))
868 block_num_list_c = c_loc(block_num_list(1))
869 radius_list_c = c_loc(radius_list(1))
870 rab_list_c = c_loc(rab_list(1, 1))
871 ELSE
872 ! Without tasks the lists are empty and there is no first element to call C_LOC on.
873 block_offsets_c = c_null_ptr
874 level_list_c = c_null_ptr
875 iatom_list_c = c_null_ptr
876 jatom_list_c = c_null_ptr
877 iset_list_c = c_null_ptr
878 jset_list_c = c_null_ptr
879 ipgf_list_c = c_null_ptr
880 jpgf_list_c = c_null_ptr
881 border_mask_list_c = c_null_ptr
882 block_num_list_c = c_null_ptr
883 radius_list_c = c_null_ptr
884 rab_list_c = c_null_ptr
885 END IF
886
887 !If task_list%c_ptr is already allocated, then its memory will be reused or freed.
888 CALL grid_create_task_list_c(orthorhombic=orthorhombic, &
889 ntasks=ntasks, &
890 nlevels=nlevels, &
891 natoms=natoms, &
892 nkinds=nkinds, &
893 nblocks=nblocks, &
894 block_offsets=block_offsets_c, &
895 atom_positions=c_loc(atom_positions(1, 1)), &
896 atom_kinds=c_loc(atom_kinds(1)), &
897 basis_sets=c_loc(basis_sets_c(1)), &
898 level_list=level_list_c, &
899 iatom_list=iatom_list_c, &
900 jatom_list=jatom_list_c, &
901 iset_list=iset_list_c, &
902 jset_list=jset_list_c, &
903 ipgf_list=ipgf_list_c, &
904 jpgf_list=jpgf_list_c, &
905 border_mask_list=border_mask_list_c, &
906 block_num_list=block_num_list_c, &
907 radius_list=radius_list_c, &
908 rab_list=rab_list_c, &
909 npts_global=c_loc(npts_global(1, 1)), &
910 npts_local=c_loc(npts_local(1, 1)), &
911 shift_local=c_loc(shift_local(1, 1)), &
912 border_width=c_loc(border_width(1, 1)), &
913 dh=c_loc(dh(1, 1, 1)), &
914 dh_inv=c_loc(dh_inv(1, 1, 1)), &
915 task_list=task_list%c_ptr)
916
917 cpassert(c_associated(task_list%c_ptr))
918
919 CALL timestop(handle)
920 END SUBROUTINE grid_create_task_list
921
922! **************************************************************************************************
923!> \brief Deallocates given task list, basis_sets have to be freed separately.
924!> \param task_list ...
925!> \author Ole Schuett
926! **************************************************************************************************
927 SUBROUTINE grid_free_task_list(task_list)
928 TYPE(grid_task_list_type), INTENT(INOUT) :: task_list
929
930 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_free_task_list'
931
932 INTEGER :: handle
933 INTERFACE
934 SUBROUTINE grid_free_task_list_c(task_list) &
935 BIND(C, name="grid_free_task_list")
936 IMPORT :: c_ptr
937 TYPE(c_ptr), VALUE :: task_list
938 END SUBROUTINE grid_free_task_list_c
939 END INTERFACE
940
941 CALL timeset(routinen, handle)
942
943 IF (c_associated(task_list%c_ptr)) THEN
944 CALL grid_free_task_list_c(task_list%c_ptr)
945 END IF
946
947 task_list%c_ptr = c_null_ptr
948
949 CALL timestop(handle)
950 END SUBROUTINE grid_free_task_list
951
952! **************************************************************************************************
953!> \brief Collocate all tasks of in given list onto given grids.
954!> \param task_list ...
955!> \param ga_gb_function ...
956!> \param pab_blocks ...
957!> \param rs_grids ...
958!> \author Ole Schuett
959! **************************************************************************************************
960 SUBROUTINE grid_collocate_task_list(task_list, ga_gb_function, pab_blocks, rs_grids)
961 TYPE(grid_task_list_type), INTENT(IN) :: task_list
962 INTEGER, INTENT(IN) :: ga_gb_function
963 TYPE(offload_buffer_type), INTENT(IN) :: pab_blocks
964 TYPE(realspace_grid_type), DIMENSION(:), &
965 INTENT(IN) :: rs_grids
966
967 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_collocate_task_list'
968
969 INTEGER :: handle, ilevel, nlevels
970 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: npts_local
971 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: grids_c
972 INTERFACE
973 SUBROUTINE grid_collocate_task_list_c(task_list, func, nlevels, &
974 npts_local, pab_blocks, grids) &
975 BIND(C, name="grid_collocate_task_list")
976 IMPORT :: c_ptr, c_int, c_bool
977 TYPE(c_ptr), VALUE :: task_list
978 INTEGER(KIND=C_INT), VALUE :: func
979 INTEGER(KIND=C_INT), VALUE :: nlevels
980 TYPE(c_ptr), VALUE :: npts_local
981 TYPE(c_ptr), VALUE :: pab_blocks
982 TYPE(c_ptr), VALUE :: grids
983 END SUBROUTINE grid_collocate_task_list_c
984 END INTERFACE
985
986 CALL timeset(routinen, handle)
987
988 nlevels = SIZE(rs_grids)
989 cpassert(nlevels > 0)
990
991 ALLOCATE (grids_c(nlevels))
992 ALLOCATE (npts_local(3, nlevels))
993 DO ilevel = 1, nlevels
994 associate(rsgrid => rs_grids(ilevel))
995 npts_local(:, ilevel) = rsgrid%ub_local - rsgrid%lb_local + 1
996 grids_c(ilevel) = rsgrid%buffer%c_ptr
997 END associate
998 END DO
999
1000 cpassert(is_contiguous(npts_local))
1001 cpassert(is_contiguous(grids_c))
1002
1003 cpassert(c_associated(task_list%c_ptr))
1004 cpassert(c_associated(pab_blocks%c_ptr))
1005
1006 CALL grid_collocate_task_list_c(task_list=task_list%c_ptr, &
1007 func=ga_gb_function, &
1008 nlevels=nlevels, &
1009 npts_local=c_loc(npts_local(1, 1)), &
1010 pab_blocks=pab_blocks%c_ptr, &
1011 grids=c_loc(grids_c(1)))
1012
1013 CALL timestop(handle)
1014 END SUBROUTINE grid_collocate_task_list
1015
1016! **************************************************************************************************
1017!> \brief Integrate all tasks of in given list from given grids.
1018!> \param task_list ...
1019!> \param compute_tau ...
1020!> \param calculate_forces ...
1021!> \param calculate_virial ...
1022!> \param pab_blocks ...
1023!> \param rs_grids ...
1024!> \param hab_blocks ...
1025!> \param forces ...
1026!> \param virial ...
1027!> \author Ole Schuett
1028! **************************************************************************************************
1029 SUBROUTINE grid_integrate_task_list(task_list, compute_tau, calculate_forces, calculate_virial, &
1030 pab_blocks, rs_grids, hab_blocks, forces, virial)
1031 TYPE(grid_task_list_type), INTENT(IN) :: task_list
1032 LOGICAL, INTENT(IN) :: compute_tau, calculate_forces, &
1033 calculate_virial
1034 TYPE(offload_buffer_type), INTENT(IN) :: pab_blocks
1035 TYPE(realspace_grid_type), DIMENSION(:), &
1036 INTENT(IN) :: rs_grids
1037 TYPE(offload_buffer_type), INTENT(INOUT) :: hab_blocks
1038 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT), &
1039 TARGET :: forces
1040 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
1041 TARGET :: virial
1042
1043 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_integrate_task_list'
1044
1045 INTEGER :: handle, ilevel, nlevels
1046 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: npts_local
1047 TYPE(c_ptr) :: forces_c, virial_c
1048 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: grids_c
1049 INTERFACE
1050 SUBROUTINE grid_integrate_task_list_c(task_list, compute_tau, natoms, &
1051 nlevels, npts_local, &
1052 pab_blocks, grids, hab_blocks, forces, virial) &
1053 BIND(C, name="grid_integrate_task_list")
1054 IMPORT :: c_ptr, c_int, c_bool
1055 TYPE(c_ptr), VALUE :: task_list
1056 LOGICAL(KIND=C_BOOL), VALUE :: compute_tau
1057 INTEGER(KIND=C_INT), VALUE :: natoms
1058 INTEGER(KIND=C_INT), VALUE :: nlevels
1059 TYPE(c_ptr), VALUE :: npts_local
1060 TYPE(c_ptr), VALUE :: pab_blocks
1061 TYPE(c_ptr), VALUE :: grids
1062 TYPE(c_ptr), VALUE :: hab_blocks
1063 TYPE(c_ptr), VALUE :: forces
1064 TYPE(c_ptr), VALUE :: virial
1065 END SUBROUTINE grid_integrate_task_list_c
1066 END INTERFACE
1067
1068 CALL timeset(routinen, handle)
1069
1070 nlevels = SIZE(rs_grids)
1071 cpassert(nlevels > 0)
1072
1073 ALLOCATE (grids_c(nlevels))
1074 ALLOCATE (npts_local(3, nlevels))
1075 DO ilevel = 1, nlevels
1076 associate(rsgrid => rs_grids(ilevel))
1077 npts_local(:, ilevel) = rsgrid%ub_local - rsgrid%lb_local + 1
1078 grids_c(ilevel) = rsgrid%buffer%c_ptr
1079 END associate
1080 END DO
1081
1082 IF (calculate_forces) THEN
1083 forces_c = c_loc(forces(1, 1))
1084 ELSE
1085 forces_c = c_null_ptr
1086 END IF
1087
1088 IF (calculate_virial) THEN
1089 virial_c = c_loc(virial(1, 1))
1090 ELSE
1091 virial_c = c_null_ptr
1092 END IF
1093
1094 cpassert(is_contiguous(npts_local))
1095 cpassert(is_contiguous(grids_c))
1096 cpassert(is_contiguous(forces))
1097 cpassert(is_contiguous(virial))
1098
1099 cpassert(SIZE(forces, 1) == 3)
1100 cpassert(c_associated(task_list%c_ptr))
1101 cpassert(c_associated(hab_blocks%c_ptr))
1102 cpassert(c_associated(pab_blocks%c_ptr) .OR. .NOT. calculate_forces)
1103 cpassert(c_associated(pab_blocks%c_ptr) .OR. .NOT. calculate_virial)
1104
1105 CALL grid_integrate_task_list_c(task_list=task_list%c_ptr, &
1106 compute_tau=LOGICAL(compute_tau, C_BOOL), &
1107 natoms=size(forces, 2), &
1108 nlevels=nlevels, &
1109 npts_local=c_loc(npts_local(1, 1)), &
1110 pab_blocks=pab_blocks%c_ptr, &
1111 grids=c_loc(grids_c(1)), &
1112 hab_blocks=hab_blocks%c_ptr, &
1113 forces=forces_c, &
1114 virial=virial_c)
1115
1116 CALL timestop(handle)
1117 END SUBROUTINE grid_integrate_task_list
1118
1119! **************************************************************************************************
1120!> \brief Initialize grid library
1121!> \author Ole Schuett
1122! **************************************************************************************************
1123 SUBROUTINE grid_library_init()
1124 INTERFACE
1125 SUBROUTINE grid_library_init_c() BIND(C, name="grid_library_init")
1126 END SUBROUTINE grid_library_init_c
1127 END INTERFACE
1128
1129 CALL grid_library_init_c()
1130
1131 END SUBROUTINE grid_library_init
1132
1133! **************************************************************************************************
1134!> \brief Finalize grid library
1135!> \author Ole Schuett
1136! **************************************************************************************************
1137 SUBROUTINE grid_library_finalize()
1138 INTERFACE
1139 SUBROUTINE grid_library_finalize_c() BIND(C, name="grid_library_finalize")
1140 END SUBROUTINE grid_library_finalize_c
1141 END INTERFACE
1142
1143 CALL grid_library_finalize_c()
1144
1145 END SUBROUTINE grid_library_finalize
1146
1147! **************************************************************************************************
1148!> \brief Configures the grid library
1149!> \param backend : backend to be used for collocate/integrate, possible values are REF, CPU, GPU
1150!> \param validate : if set to true, compare the results of all backend to the reference backend
1151!> \param apply_cutoff : apply a spherical cutoff before collocating or integrating. Only relevant for CPU backend
1152!> \author Ole Schuett
1153! **************************************************************************************************
1154 SUBROUTINE grid_library_set_config(backend, validate, apply_cutoff)
1155 INTEGER, INTENT(IN) :: backend
1156 LOGICAL, INTENT(IN) :: validate, apply_cutoff
1157
1158 INTERFACE
1159 SUBROUTINE grid_library_set_config_c(backend, validate, apply_cutoff) &
1160 BIND(C, name="grid_library_set_config")
1161 IMPORT :: c_int, c_bool
1162 INTEGER(KIND=C_INT), VALUE :: backend
1163 LOGICAL(KIND=C_BOOL), VALUE :: validate
1164 LOGICAL(KIND=C_BOOL), VALUE :: apply_cutoff
1165 END SUBROUTINE grid_library_set_config_c
1166 END INTERFACE
1167
1168 CALL grid_library_set_config_c(backend=backend, &
1169 validate=LOGICAL(validate, C_BOOL), &
1170 apply_cutoff=logical(apply_cutoff, c_bool))
1171
1172 END SUBROUTINE grid_library_set_config
1173
1174! **************************************************************************************************
1175!> \brief Print grid library statistics
1176!> \param mpi_comm ...
1177!> \param output_unit ...
1178!> \author Ole Schuett
1179! **************************************************************************************************
1180 SUBROUTINE grid_library_print_stats(mpi_comm, output_unit)
1181 TYPE(mp_comm_type) :: mpi_comm
1182 INTEGER, INTENT(IN) :: output_unit
1183
1184 INTERFACE
1185 SUBROUTINE grid_library_print_stats_c(mpi_comm, print_func, output_unit) &
1186 BIND(C, name="grid_library_print_stats")
1187 IMPORT :: c_funptr, c_int
1188 INTEGER(KIND=C_INT), VALUE :: mpi_comm
1189 TYPE(c_funptr), VALUE :: print_func
1190 INTEGER(KIND=C_INT), VALUE :: output_unit
1191 END SUBROUTINE grid_library_print_stats_c
1192 END INTERFACE
1193
1194 ! Since Fortran units and mpi groups can't be used from C, we pass function pointers instead.
1195 CALL grid_library_print_stats_c(mpi_comm=mpi_comm%get_handle(), &
1196 print_func=c_funloc(print_func), &
1197 output_unit=output_unit)
1198
1199 END SUBROUTINE grid_library_print_stats
1200
1201! **************************************************************************************************
1202!> \brief Callback to write to a Fortran output unit (called by C-side).
1203!> \param msg to be printed.
1204!> \param msglen number of characters excluding the terminating character.
1205!> \param output_unit used for output.
1206!> \author Ole Schuett and Hans Pabst
1207! **************************************************************************************************
1208 SUBROUTINE print_func(msg, msglen, output_unit) BIND(C, name="grid_api_print_func")
1209 CHARACTER(KIND=C_CHAR), INTENT(IN) :: msg(*)
1210 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: msglen, output_unit
1211
1212 IF (output_unit <= 0) RETURN ! Omit to print the message.
1213 WRITE (output_unit, fmt="(100A)", advance="NO") msg(1:msglen)
1214 END SUBROUTINE print_func
1215END MODULE grid_api
apply_cutoff
void apply_cutoff(void *ptr)
Definition grid_dgemm_context.c:477
grid_api
Fortran API for the grid package, which is written in C.
Definition grid_api.F:12
grid_api::grid_func_adbmdab_z
integer, parameter, public grid_func_adbmdab_z
Definition grid_api.F:31
grid_api::grid_func_core_x
integer, parameter, public grid_func_core_x
Definition grid_api.F:60
grid_api::grid_func_adbmdab_y
integer, parameter, public grid_func_adbmdab_y
Definition grid_api.F:30
grid_api::grid_func_ardbmdarb_yx
integer, parameter, public grid_func_ardbmdarb_yx
Definition grid_api.F:35
grid_api::grid_func_dab_z
integer, parameter, public grid_func_dab_z
Definition grid_api.F:55
grid_api::grid_collocate_task_list
subroutine, public grid_collocate_task_list(task_list, ga_gb_function, pab_blocks, rs_grids)
Collocate all tasks of in given list onto given grids.
Definition grid_api.F:961
grid_api::grid_func_dzdx
integer, parameter, public grid_func_dzdx
Definition grid_api.F:49
grid_api::grid_func_ardbmdarb_zz
integer, parameter, public grid_func_ardbmdarb_zz
Definition grid_api.F:40
grid_api::grid_backend_auto
integer, parameter, public grid_backend_auto
Definition grid_api.F:64
grid_api::grid_backend_gpu
integer, parameter, public grid_backend_gpu
Definition grid_api.F:68
grid_api::grid_free_task_list
subroutine, public grid_free_task_list(task_list)
Deallocates given task list, basis_sets have to be freed separately.
Definition grid_api.F:928
grid_api::grid_func_dzdz
integer, parameter, public grid_func_dzdz
Definition grid_api.F:52
grid_api::grid_free_basis_set
subroutine, public grid_free_basis_set(basis_set)
Deallocates given basis set.
Definition grid_api.F:666
grid_api::grid_func_dydz
integer, parameter, public grid_func_dydz
Definition grid_api.F:48
grid_api::grid_func_adb_y
integer, parameter, public grid_func_adb_y
Definition grid_api.F:57
grid_api::grid_library_init
subroutine, public grid_library_init()
Initialize grid library.
Definition grid_api.F:1124
grid_api::grid_func_dxdy
integer, parameter, public grid_func_dxdy
Definition grid_api.F:47
grid_api::grid_func_dabpadb_y
integer, parameter, public grid_func_dabpadb_y
Definition grid_api.F:42
grid_api::grid_func_ardbmdarb_xy
integer, parameter, public grid_func_ardbmdarb_xy
Definition grid_api.F:33
grid_api::grid_func_dab_y
integer, parameter, public grid_func_dab_y
Definition grid_api.F:54
grid_api::grid_create_task_list
subroutine, public grid_create_task_list(ntasks, natoms, nkinds, nblocks, block_offsets, atom_positions, atom_kinds, basis_sets, level_list, iatom_list, jatom_list, iset_list, jset_list, ipgf_list, jpgf_list, border_mask_list, block_num_list, radius_list, rab_list, rs_grids, task_list)
Allocates a task list which can be passed to grid_collocate_task_list.
Definition grid_api.F:721
grid_api::grid_func_adb_z
integer, parameter, public grid_func_adb_z
Definition grid_api.F:58
grid_api::grid_func_ardbmdarb_zx
integer, parameter, public grid_func_ardbmdarb_zx
Definition grid_api.F:38
grid_api::grid_func_adb_x
integer, parameter, public grid_func_adb_x
Definition grid_api.F:56
grid_api::grid_func_dxdx
integer, parameter, public grid_func_dxdx
Definition grid_api.F:50
grid_api::grid_func_ardbmdarb_xx
integer, parameter, public grid_func_ardbmdarb_xx
Definition grid_api.F:32
grid_api::grid_func_dadb
integer, parameter, public grid_func_dadb
Definition grid_api.F:28
grid_api::grid_backend_dgemm
integer, parameter, public grid_backend_dgemm
Definition grid_api.F:67
grid_api::grid_func_dydy
integer, parameter, public grid_func_dydy
Definition grid_api.F:51
grid_api::grid_func_dabpadb_z
integer, parameter, public grid_func_dabpadb_z
Definition grid_api.F:43
grid_api::grid_backend_cpu
integer, parameter, public grid_backend_cpu
Definition grid_api.F:66
grid_api::grid_create_basis_set
subroutine, public grid_create_basis_set(nset, nsgf, maxco, maxpgf, lmin, lmax, npgf, nsgf_set, first_sgf, sphi, zet, basis_set)
Allocates a basis set which can be passed to grid_create_task_list.
Definition grid_api.F:564
grid_api::grid_func_dabpadb_x
integer, parameter, public grid_func_dabpadb_x
Definition grid_api.F:41
grid_api::grid_func_dx
integer, parameter, public grid_func_dx
Definition grid_api.F:44
grid_api::grid_func_dz
integer, parameter, public grid_func_dz
Definition grid_api.F:46
grid_api::grid_func_ardbmdarb_yz
integer, parameter, public grid_func_ardbmdarb_yz
Definition grid_api.F:37
grid_api::grid_func_ab
integer, parameter, public grid_func_ab
Definition grid_api.F:27
grid_api::grid_library_set_config
subroutine, public grid_library_set_config(backend, validate, apply_cutoff)
Configures the grid library.
Definition grid_api.F:1155
grid_api::integrate_pgf_product
subroutine, public integrate_pgf_product(la_max, zeta, la_min, lb_max, zetb, lb_min, ra, rab, rsgrid, hab, pab, o1, o2, radius, calculate_forces, force_a, force_b, compute_tau, use_virial, my_virial_a, my_virial_b, hdab, hadb, a_hdab, use_subpatch, subpatch_pattern)
low level function to compute matrix elements of primitive gaussian functions
Definition grid_api.F:274
grid_api::grid_func_ardbmdarb_yy
integer, parameter, public grid_func_ardbmdarb_yy
Definition grid_api.F:36
grid_api::grid_integrate_task_list
subroutine, public grid_integrate_task_list(task_list, compute_tau, calculate_forces, calculate_virial, pab_blocks, rs_grids, hab_blocks, forces, virial)
Integrate all tasks of in given list from given grids.
Definition grid_api.F:1031
grid_api::grid_func_core_y
integer, parameter, public grid_func_core_y
Definition grid_api.F:61
grid_api::grid_library_print_stats
subroutine, public grid_library_print_stats(mpi_comm, output_unit)
Print grid library statistics.
Definition grid_api.F:1181
grid_api::grid_backend_ref
integer, parameter, public grid_backend_ref
Definition grid_api.F:65
grid_api::grid_func_adbmdab_x
integer, parameter, public grid_func_adbmdab_x
Definition grid_api.F:29
grid_api::grid_library_finalize
subroutine, public grid_library_finalize()
Finalize grid library.
Definition grid_api.F:1138
grid_api::grid_func_dab_x
integer, parameter, public grid_func_dab_x
Definition grid_api.F:53
grid_api::collocate_pgf_product
subroutine, public collocate_pgf_product(la_max, zeta, la_min, lb_max, zetb, lb_min, ra, rab, scale, pab, o1, o2, rsgrid, ga_gb_function, radius, use_subpatch, subpatch_pattern)
low level collocation of primitive gaussian functions
Definition grid_api.F:116
grid_api::grid_func_ardbmdarb_zy
integer, parameter, public grid_func_ardbmdarb_zy
Definition grid_api.F:39
grid_api::grid_func_core_z
integer, parameter, public grid_func_core_z
Definition grid_api.F:62
grid_api::grid_func_dy
integer, parameter, public grid_func_dy
Definition grid_api.F:45
grid_api::grid_func_ardbmdarb_xz
integer, parameter, public grid_func_ardbmdarb_xz
Definition grid_api.F:34
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
offload_api
Fortran API for the offload package, which is written in C.
Definition offload_api.F:12
realspace_grid_types
Definition realspace_grid_types.F:18
grid_api::grid_basis_set_type
Definition grid_api.F:77
grid_api::grid_task_list_type
Definition grid_api.F:82
message_passing::mp_comm_type
Definition message_passing.F:179
offload_api::offload_buffer_type
Definition offload_api.F:35
realspace_grid_types::realspace_grid_type
Definition realspace_grid_types.F:136