(git:e8f5963)
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#if __GNUC__ >= 9
196 cpassert(is_contiguous(rsgrid%desc%dh))
197 cpassert(is_contiguous(rsgrid%desc%dh_inv))
198 cpassert(is_contiguous(ra))
199 cpassert(is_contiguous(rab))
200 cpassert(is_contiguous(npts_global))
201 cpassert(is_contiguous(npts_local))
202 cpassert(is_contiguous(shift_local))
203 cpassert(is_contiguous(border_width))
204 cpassert(is_contiguous(pab))
205 cpassert(is_contiguous(grid))
206#endif
207
208 ! For collocating a single pgf product we use the optimized cpu backend.
209
210 CALL grid_cpu_collocate_pgf_product_c(orthorhombic=orthorhombic, &
211 border_mask=border_mask, &
212 func=ga_gb_function, &
213 la_max=la_max, &
214 la_min=la_min, &
215 lb_max=lb_max, &
216 lb_min=lb_min, &
217 zeta=zeta, &
218 zetb=zetb, &
219 rscale=scale, &
220 dh=c_loc(rsgrid%desc%dh(1, 1)), &
221 dh_inv=c_loc(rsgrid%desc%dh_inv(1, 1)), &
222 ra=c_loc(ra(1)), &
223 rab=c_loc(rab(1)), &
224 npts_global=c_loc(npts_global(1)), &
225 npts_local=c_loc(npts_local(1)), &
226 shift_local=c_loc(shift_local(1)), &
227 border_width=c_loc(border_width(1)), &
228 radius=radius, &
229 o1=o1, &
230 o2=o2, &
231 n1=SIZE(pab, 1), &
232 n2=SIZE(pab, 2), &
233 pab=c_loc(pab(1, 1)), &
234 grid=c_loc(grid(1, 1, 1)))
235
236 END SUBROUTINE collocate_pgf_product
237
238! **************************************************************************************************
239!> \brief low level function to compute matrix elements of primitive gaussian functions
240!> \param la_max ...
241!> \param zeta ...
242!> \param la_min ...
243!> \param lb_max ...
244!> \param zetb ...
245!> \param lb_min ...
246!> \param ra ...
247!> \param rab ...
248!> \param rsgrid ...
249!> \param hab ...
250!> \param pab ...
251!> \param o1 ...
252!> \param o2 ...
253!> \param radius ...
254!> \param calculate_forces ...
255!> \param force_a ...
256!> \param force_b ...
257!> \param compute_tau ...
258!> \param use_virial ...
259!> \param my_virial_a ...
260!> \param my_virial_b ...
261!> \param hdab Derivative with respect to the primitive on the left.
262!> \param hadb Derivative with respect to the primitive on the right.
263!> \param a_hdab ...
264!> \param use_subpatch ...
265!> \param subpatch_pattern ...
266! **************************************************************************************************
267 SUBROUTINE integrate_pgf_product(la_max, zeta, la_min, &
268 lb_max, zetb, lb_min, &
269 ra, rab, rsgrid, &
270 hab, pab, o1, o2, &
271 radius, &
272 calculate_forces, force_a, force_b, &
273 compute_tau, &
274 use_virial, my_virial_a, &
275 my_virial_b, hdab, hadb, a_hdab, use_subpatch, subpatch_pattern)
276
277 INTEGER, INTENT(IN) :: la_max
278 REAL(kind=dp), INTENT(IN) :: zeta
279 INTEGER, INTENT(IN) :: la_min, lb_max
280 REAL(kind=dp), INTENT(IN) :: zetb
281 INTEGER, INTENT(IN) :: lb_min
282 REAL(kind=dp), DIMENSION(3), INTENT(IN), TARGET :: ra, rab
283 TYPE(realspace_grid_type), INTENT(IN) :: rsgrid
284 REAL(kind=dp), DIMENSION(:, :), POINTER :: hab
285 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: pab
286 INTEGER, INTENT(IN) :: o1, o2
287 REAL(kind=dp), INTENT(IN) :: radius
288 LOGICAL, INTENT(IN) :: calculate_forces
289 REAL(kind=dp), DIMENSION(3), INTENT(INOUT), &
290 OPTIONAL :: force_a, force_b
291 LOGICAL, INTENT(IN), OPTIONAL :: compute_tau, use_virial
292 REAL(kind=dp), DIMENSION(3, 3), OPTIONAL :: my_virial_a, my_virial_b
293 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
294 POINTER :: hdab, hadb
295 REAL(kind=dp), DIMENSION(:, :, :, :), OPTIONAL, &
296 POINTER :: a_hdab
297 LOGICAL, OPTIONAL :: use_subpatch
298 INTEGER, INTENT(IN), OPTIONAL :: subpatch_pattern
299
300 INTEGER :: border_mask
301 INTEGER, DIMENSION(3), TARGET :: border_width, npts_global, npts_local, &
302 shift_local
303 LOGICAL :: my_use_virial
304 LOGICAL(KIND=C_BOOL) :: my_compute_tau, orthorhombic
305 REAL(kind=dp), DIMENSION(3, 2), TARGET :: forces
306 REAL(kind=dp), DIMENSION(3, 3, 2), TARGET :: virials
307 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: grid
308 TYPE(c_ptr) :: a_hdab_cptr, forces_cptr, hadb_cptr, &
309 hdab_cptr, pab_cptr, virials_cptr
310 INTERFACE
311 SUBROUTINE grid_cpu_integrate_pgf_product_c(orthorhombic, compute_tau, &
312 border_mask, &
313 la_max, la_min, lb_max, lb_min, &
314 zeta, zetb, dh, dh_inv, ra, rab, &
315 npts_global, npts_local, shift_local, border_width, &
316 radius, o1, o2, n1, n2, grid, hab, pab, &
317 forces, virials, hdab, hadb, a_hdab) &
318 BIND(C, name="grid_cpu_integrate_pgf_product")
319 IMPORT :: c_ptr, c_int, c_double, c_bool
320 LOGICAL(KIND=C_BOOL), VALUE :: orthorhombic
321 LOGICAL(KIND=C_BOOL), VALUE :: compute_tau
322 INTEGER(KIND=C_INT), VALUE :: border_mask
323 INTEGER(KIND=C_INT), VALUE :: la_max
324 INTEGER(KIND=C_INT), VALUE :: la_min
325 INTEGER(KIND=C_INT), VALUE :: lb_max
326 INTEGER(KIND=C_INT), VALUE :: lb_min
327 REAL(kind=c_double), VALUE :: zeta
328 REAL(kind=c_double), VALUE :: zetb
329 TYPE(c_ptr), VALUE :: dh
330 TYPE(c_ptr), VALUE :: dh_inv
331 TYPE(c_ptr), VALUE :: ra
332 TYPE(c_ptr), VALUE :: rab
333 TYPE(c_ptr), VALUE :: npts_global
334 TYPE(c_ptr), VALUE :: npts_local
335 TYPE(c_ptr), VALUE :: shift_local
336 TYPE(c_ptr), VALUE :: border_width
337 REAL(kind=c_double), VALUE :: radius
338 INTEGER(KIND=C_INT), VALUE :: o1
339 INTEGER(KIND=C_INT), VALUE :: o2
340 INTEGER(KIND=C_INT), VALUE :: n1
341 INTEGER(KIND=C_INT), VALUE :: n2
342 TYPE(c_ptr), VALUE :: grid
343 TYPE(c_ptr), VALUE :: hab
344 TYPE(c_ptr), VALUE :: pab
345 TYPE(c_ptr), VALUE :: forces
346 TYPE(c_ptr), VALUE :: virials
347 TYPE(c_ptr), VALUE :: hdab
348 TYPE(c_ptr), VALUE :: hadb
349 TYPE(c_ptr), VALUE :: a_hdab
350 END SUBROUTINE grid_cpu_integrate_pgf_product_c
351 END INTERFACE
352
353 IF (radius == 0.0_dp) THEN
354 RETURN
355 END IF
356
357 border_mask = 0
358 IF (PRESENT(use_subpatch)) THEN
359 IF (use_subpatch) THEN
360 cpassert(PRESENT(subpatch_pattern))
361 border_mask = iand(63, not(subpatch_pattern)) ! invert last 6 bits
362 END IF
363 END IF
364
365 ! When true then 0.5 * (nabla x_a).(v(r) nabla x_b) is computed.
366 IF (PRESENT(compute_tau)) THEN
367 my_compute_tau = LOGICAL(compute_tau, c_bool)
368 ELSE
369 my_compute_tau = .false.
370 END IF
371
372 IF (PRESENT(use_virial)) THEN
373 my_use_virial = use_virial
374 ELSE
375 my_use_virial = .false.
376 END IF
377
378 IF (calculate_forces) THEN
379 cpassert(PRESENT(pab))
380 pab_cptr = c_loc(pab(1, 1))
381 forces(:, :) = 0.0_dp
382 forces_cptr = c_loc(forces(1, 1))
383 ELSE
384 pab_cptr = c_null_ptr
385 forces_cptr = c_null_ptr
386 END IF
387
388 IF (calculate_forces .AND. my_use_virial) THEN
389 virials(:, :, :) = 0.0_dp
390 virials_cptr = c_loc(virials(1, 1, 1))
391 ELSE
392 virials_cptr = c_null_ptr
393 END IF
394
395 IF (calculate_forces .AND. PRESENT(hdab)) THEN
396 hdab_cptr = c_loc(hdab(1, 1, 1))
397 ELSE
398 hdab_cptr = c_null_ptr
399 END IF
400
401 IF (calculate_forces .AND. PRESENT(hadb)) THEN
402 hadb_cptr = c_loc(hadb(1, 1, 1))
403 ELSE
404 hadb_cptr = c_null_ptr
405 END IF
406
407 IF (calculate_forces .AND. my_use_virial .AND. PRESENT(a_hdab)) THEN
408 a_hdab_cptr = c_loc(a_hdab(1, 1, 1, 1))
409 ELSE
410 a_hdab_cptr = c_null_ptr
411 END IF
412
413 orthorhombic = LOGICAL(rsgrid%desc%orthorhombic, c_bool)
414
415 CALL get_rsgrid_properties(rsgrid, npts_global=npts_global, &
416 npts_local=npts_local, &
417 shift_local=shift_local, &
418 border_width=border_width)
419
420 grid(1:, 1:, 1:) => rsgrid%r(:, :, :) ! pointer assignment
421
422#if __GNUC__ >= 9
423 cpassert(is_contiguous(rsgrid%desc%dh))
424 cpassert(is_contiguous(rsgrid%desc%dh_inv))
425 cpassert(is_contiguous(ra))
426 cpassert(is_contiguous(rab))
427 cpassert(is_contiguous(npts_global))
428 cpassert(is_contiguous(npts_local))
429 cpassert(is_contiguous(shift_local))
430 cpassert(is_contiguous(border_width))
431 cpassert(is_contiguous(grid))
432 cpassert(is_contiguous(hab))
433 cpassert(is_contiguous(forces))
434 cpassert(is_contiguous(virials))
435 IF (PRESENT(pab)) THEN
436 cpassert(is_contiguous(pab))
437 END IF
438 IF (PRESENT(hdab)) THEN
439 cpassert(is_contiguous(hdab))
440 END IF
441 IF (PRESENT(a_hdab)) THEN
442 cpassert(is_contiguous(a_hdab))
443 END IF
444#endif
445
446 CALL grid_cpu_integrate_pgf_product_c(orthorhombic=orthorhombic, &
447 compute_tau=my_compute_tau, &
448 border_mask=border_mask, &
449 la_max=la_max, &
450 la_min=la_min, &
451 lb_max=lb_max, &
452 lb_min=lb_min, &
453 zeta=zeta, &
454 zetb=zetb, &
455 dh=c_loc(rsgrid%desc%dh(1, 1)), &
456 dh_inv=c_loc(rsgrid%desc%dh_inv(1, 1)), &
457 ra=c_loc(ra(1)), &
458 rab=c_loc(rab(1)), &
459 npts_global=c_loc(npts_global(1)), &
460 npts_local=c_loc(npts_local(1)), &
461 shift_local=c_loc(shift_local(1)), &
462 border_width=c_loc(border_width(1)), &
463 radius=radius, &
464 o1=o1, &
465 o2=o2, &
466 n1=SIZE(hab, 1), &
467 n2=SIZE(hab, 2), &
468 grid=c_loc(grid(1, 1, 1)), &
469 hab=c_loc(hab(1, 1)), &
470 pab=pab_cptr, &
471 forces=forces_cptr, &
472 virials=virials_cptr, &
473 hdab=hdab_cptr, &
474 hadb=hadb_cptr, &
475 a_hdab=a_hdab_cptr)
476
477 IF (PRESENT(force_a) .AND. c_associated(forces_cptr)) &
478 force_a = force_a + forces(:, 1)
479 IF (PRESENT(force_b) .AND. c_associated(forces_cptr)) &
480 force_b = force_b + forces(:, 2)
481 IF (PRESENT(my_virial_a) .AND. c_associated(virials_cptr)) &
482 my_virial_a = my_virial_a + virials(:, :, 1)
483 IF (PRESENT(my_virial_b) .AND. c_associated(virials_cptr)) &
484 my_virial_b = my_virial_b + virials(:, :, 2)
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#if __GNUC__ >= 9
610 cpassert(is_contiguous(lmin))
611 cpassert(is_contiguous(lmax))
612 cpassert(is_contiguous(npgf))
613 cpassert(is_contiguous(nsgf_set))
614 cpassert(is_contiguous(my_first_sgf))
615 cpassert(is_contiguous(sphi))
616 cpassert(is_contiguous(zet))
617#endif
618
619 lmin_c = c_null_ptr
620 lmax_c = c_null_ptr
621 npgf_c = c_null_ptr
622 nsgf_set_c = c_null_ptr
623 first_sgf_c = c_null_ptr
624 sphi_c = c_null_ptr
625 zet_c = c_null_ptr
626
627 ! Basis sets arrays can be empty, need to check before accessing the first element.
628 IF (nset > 0) THEN
629 lmin_c = c_loc(lmin(1))
630 lmax_c = c_loc(lmax(1))
631 npgf_c = c_loc(npgf(1))
632 nsgf_set_c = c_loc(nsgf_set(1))
633 END IF
634 IF (SIZE(first_sgf) > 0) THEN
635 my_first_sgf(:) = first_sgf(1, :) ! make a contiguous copy
636 first_sgf_c = c_loc(my_first_sgf(1))
637 END IF
638 IF (SIZE(sphi) > 0) THEN
639 sphi_c = c_loc(sphi(1, 1))
640 END IF
641 IF (SIZE(zet) > 0) THEN
642 zet_c = c_loc(zet(1, 1))
643 END IF
644
645 CALL grid_create_basis_set_c(nset=nset, &
646 nsgf=nsgf, &
647 maxco=maxco, &
648 maxpgf=maxpgf, &
649 lmin=lmin_c, &
650 lmax=lmax_c, &
651 npgf=npgf_c, &
652 nsgf_set=nsgf_set_c, &
653 first_sgf=first_sgf_c, &
654 sphi=sphi_c, &
655 zet=zet_c, &
656 basis_set=basis_set%c_ptr)
657 cpassert(c_associated(basis_set%c_ptr))
658
659 CALL timestop(handle)
660 END SUBROUTINE grid_create_basis_set
661
662! **************************************************************************************************
663!> \brief Deallocates given basis set.
664!> \param basis_set ...
665!> \author Ole Schuett
666! **************************************************************************************************
667 SUBROUTINE grid_free_basis_set(basis_set)
668 TYPE(grid_basis_set_type), INTENT(INOUT) :: basis_set
669
670 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_free_basis_set'
671
672 INTEGER :: handle
673 INTERFACE
674 SUBROUTINE grid_free_basis_set_c(basis_set) &
675 BIND(C, name="grid_free_basis_set")
676 IMPORT :: c_ptr
677 TYPE(c_ptr), VALUE :: basis_set
678 END SUBROUTINE grid_free_basis_set_c
679 END INTERFACE
680
681 CALL timeset(routinen, handle)
682
683 cpassert(c_associated(basis_set%c_ptr))
684
685 CALL grid_free_basis_set_c(basis_set%c_ptr)
686
687 basis_set%c_ptr = c_null_ptr
688
689 CALL timestop(handle)
690 END SUBROUTINE grid_free_basis_set
691
692! **************************************************************************************************
693!> \brief Allocates a task list which can be passed to grid_collocate_task_list.
694!> \param ntasks ...
695!> \param natoms ...
696!> \param nkinds ...
697!> \param nblocks ...
698!> \param block_offsets ...
699!> \param atom_positions ...
700!> \param atom_kinds ...
701!> \param basis_sets ...
702!> \param level_list ...
703!> \param iatom_list ...
704!> \param jatom_list ...
705!> \param iset_list ...
706!> \param jset_list ...
707!> \param ipgf_list ...
708!> \param jpgf_list ...
709!> \param border_mask_list ...
710!> \param block_num_list ...
711!> \param radius_list ...
712!> \param rab_list ...
713!> \param rs_grids ...
714!> \param task_list ...
715!> \author Ole Schuett
716! **************************************************************************************************
717 SUBROUTINE grid_create_task_list(ntasks, natoms, nkinds, nblocks, &
718 block_offsets, atom_positions, atom_kinds, basis_sets, &
719 level_list, iatom_list, jatom_list, &
720 iset_list, jset_list, ipgf_list, jpgf_list, &
721 border_mask_list, block_num_list, &
722 radius_list, rab_list, rs_grids, task_list)
723
724 INTEGER, INTENT(IN) :: ntasks, natoms, nkinds, nblocks
725 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: block_offsets
726 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: atom_positions
727 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: atom_kinds
728 TYPE(grid_basis_set_type), DIMENSION(:), &
729 INTENT(IN), TARGET :: basis_sets
730 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: level_list, iatom_list, jatom_list, &
731 iset_list, jset_list, ipgf_list, &
732 jpgf_list, border_mask_list, &
733 block_num_list
734 REAL(kind=dp), DIMENSION(:), INTENT(IN), TARGET :: radius_list
735 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: rab_list
736 TYPE(realspace_grid_type), DIMENSION(:), &
737 INTENT(IN) :: rs_grids
738 TYPE(grid_task_list_type), INTENT(INOUT) :: task_list
739
740 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_create_task_list'
741
742 INTEGER :: handle, ikind, ilevel, nlevels
743 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: border_width, npts_global, npts_local, &
744 shift_local
745 LOGICAL(KIND=C_BOOL) :: orthorhombic
746 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
747 TARGET :: dh, dh_inv
748 TYPE(c_ptr) :: block_num_list_c, block_offsets_c, border_mask_list_c, iatom_list_c, &
749 ipgf_list_c, iset_list_c, jatom_list_c, jpgf_list_c, jset_list_c, level_list_c, &
750 rab_list_c, radius_list_c
751 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: basis_sets_c
752 INTERFACE
753 SUBROUTINE grid_create_task_list_c(orthorhombic, &
754 ntasks, nlevels, natoms, nkinds, nblocks, &
755 block_offsets, atom_positions, atom_kinds, basis_sets, &
756 level_list, iatom_list, jatom_list, &
757 iset_list, jset_list, ipgf_list, jpgf_list, &
758 border_mask_list, block_num_list, &
759 radius_list, rab_list, &
760 npts_global, npts_local, shift_local, &
761 border_width, dh, dh_inv, task_list) &
762 BIND(C, name="grid_create_task_list")
763 IMPORT :: c_ptr, c_int, c_bool
764 LOGICAL(KIND=C_BOOL), VALUE :: orthorhombic
765 INTEGER(KIND=C_INT), VALUE :: ntasks
766 INTEGER(KIND=C_INT), VALUE :: nlevels
767 INTEGER(KIND=C_INT), VALUE :: natoms
768 INTEGER(KIND=C_INT), VALUE :: nkinds
769 INTEGER(KIND=C_INT), VALUE :: nblocks
770 TYPE(c_ptr), VALUE :: block_offsets
771 TYPE(c_ptr), VALUE :: atom_positions
772 TYPE(c_ptr), VALUE :: atom_kinds
773 TYPE(c_ptr), VALUE :: basis_sets
774 TYPE(c_ptr), VALUE :: level_list
775 TYPE(c_ptr), VALUE :: iatom_list
776 TYPE(c_ptr), VALUE :: jatom_list
777 TYPE(c_ptr), VALUE :: iset_list
778 TYPE(c_ptr), VALUE :: jset_list
779 TYPE(c_ptr), VALUE :: ipgf_list
780 TYPE(c_ptr), VALUE :: jpgf_list
781 TYPE(c_ptr), VALUE :: border_mask_list
782 TYPE(c_ptr), VALUE :: block_num_list
783 TYPE(c_ptr), VALUE :: radius_list
784 TYPE(c_ptr), VALUE :: rab_list
785 TYPE(c_ptr), VALUE :: npts_global
786 TYPE(c_ptr), VALUE :: npts_local
787 TYPE(c_ptr), VALUE :: shift_local
788 TYPE(c_ptr), VALUE :: border_width
789 TYPE(c_ptr), VALUE :: dh
790 TYPE(c_ptr), VALUE :: dh_inv
791 TYPE(c_ptr) :: task_list
792 END SUBROUTINE grid_create_task_list_c
793 END INTERFACE
794
795 CALL timeset(routinen, handle)
796
797 cpassert(SIZE(block_offsets) == nblocks)
798 cpassert(SIZE(atom_positions, 1) == 3 .AND. SIZE(atom_positions, 2) == natoms)
799 cpassert(SIZE(atom_kinds) == natoms)
800 cpassert(SIZE(basis_sets) == nkinds)
801 cpassert(SIZE(level_list) == ntasks)
802 cpassert(SIZE(iatom_list) == ntasks)
803 cpassert(SIZE(jatom_list) == ntasks)
804 cpassert(SIZE(iset_list) == ntasks)
805 cpassert(SIZE(jset_list) == ntasks)
806 cpassert(SIZE(ipgf_list) == ntasks)
807 cpassert(SIZE(jpgf_list) == ntasks)
808 cpassert(SIZE(border_mask_list) == ntasks)
809 cpassert(SIZE(block_num_list) == ntasks)
810 cpassert(SIZE(radius_list) == ntasks)
811 cpassert(SIZE(rab_list, 1) == 3 .AND. SIZE(rab_list, 2) == ntasks)
812
813 ALLOCATE (basis_sets_c(nkinds))
814 DO ikind = 1, nkinds
815 basis_sets_c(ikind) = basis_sets(ikind)%c_ptr
816 END DO
817
818 nlevels = SIZE(rs_grids)
819 cpassert(nlevels > 0)
820 orthorhombic = LOGICAL(rs_grids(1)%desc%orthorhombic, c_bool)
821
822 ALLOCATE (npts_global(3, nlevels), npts_local(3, nlevels))
823 ALLOCATE (shift_local(3, nlevels), border_width(3, nlevels))
824 ALLOCATE (dh(3, 3, nlevels), dh_inv(3, 3, nlevels))
825 DO ilevel = 1, nlevels
826 associate(rsgrid => rs_grids(ilevel))
827 CALL get_rsgrid_properties(rsgrid=rsgrid, &
828 npts_global=npts_global(:, ilevel), &
829 npts_local=npts_local(:, ilevel), &
830 shift_local=shift_local(:, ilevel), &
831 border_width=border_width(:, ilevel))
832 cpassert(rsgrid%desc%orthorhombic .EQV. orthorhombic) ! should be the same for all levels
833 dh(:, :, ilevel) = rsgrid%desc%dh(:, :)
834 dh_inv(:, :, ilevel) = rsgrid%desc%dh_inv(:, :)
835 END associate
836 END DO
837
838#if __GNUC__ >= 9
839 cpassert(is_contiguous(block_offsets))
840 cpassert(is_contiguous(atom_positions))
841 cpassert(is_contiguous(atom_kinds))
842 cpassert(is_contiguous(basis_sets))
843 cpassert(is_contiguous(level_list))
844 cpassert(is_contiguous(iatom_list))
845 cpassert(is_contiguous(jatom_list))
846 cpassert(is_contiguous(iset_list))
847 cpassert(is_contiguous(jset_list))
848 cpassert(is_contiguous(ipgf_list))
849 cpassert(is_contiguous(jpgf_list))
850 cpassert(is_contiguous(border_mask_list))
851 cpassert(is_contiguous(block_num_list))
852 cpassert(is_contiguous(radius_list))
853 cpassert(is_contiguous(rab_list))
854 cpassert(is_contiguous(npts_global))
855 cpassert(is_contiguous(npts_local))
856 cpassert(is_contiguous(shift_local))
857 cpassert(is_contiguous(border_width))
858 cpassert(is_contiguous(dh))
859 cpassert(is_contiguous(dh_inv))
860#endif
861
862 IF (ntasks > 0) THEN
863 block_offsets_c = c_loc(block_offsets(1))
864 level_list_c = c_loc(level_list(1))
865 iatom_list_c = c_loc(iatom_list(1))
866 jatom_list_c = c_loc(jatom_list(1))
867 iset_list_c = c_loc(iset_list(1))
868 jset_list_c = c_loc(jset_list(1))
869 ipgf_list_c = c_loc(ipgf_list(1))
870 jpgf_list_c = c_loc(jpgf_list(1))
871 border_mask_list_c = c_loc(border_mask_list(1))
872 block_num_list_c = c_loc(block_num_list(1))
873 radius_list_c = c_loc(radius_list(1))
874 rab_list_c = c_loc(rab_list(1, 1))
875 ELSE
876 ! Without tasks the lists are empty and there is no first element to call C_LOC on.
877 block_offsets_c = c_null_ptr
878 level_list_c = c_null_ptr
879 iatom_list_c = c_null_ptr
880 jatom_list_c = c_null_ptr
881 iset_list_c = c_null_ptr
882 jset_list_c = c_null_ptr
883 ipgf_list_c = c_null_ptr
884 jpgf_list_c = c_null_ptr
885 border_mask_list_c = c_null_ptr
886 block_num_list_c = c_null_ptr
887 radius_list_c = c_null_ptr
888 rab_list_c = c_null_ptr
889 END IF
890
891 !If task_list%c_ptr is already allocated, then its memory will be reused or freed.
892 CALL grid_create_task_list_c(orthorhombic=orthorhombic, &
893 ntasks=ntasks, &
894 nlevels=nlevels, &
895 natoms=natoms, &
896 nkinds=nkinds, &
897 nblocks=nblocks, &
898 block_offsets=block_offsets_c, &
899 atom_positions=c_loc(atom_positions(1, 1)), &
900 atom_kinds=c_loc(atom_kinds(1)), &
901 basis_sets=c_loc(basis_sets_c(1)), &
902 level_list=level_list_c, &
903 iatom_list=iatom_list_c, &
904 jatom_list=jatom_list_c, &
905 iset_list=iset_list_c, &
906 jset_list=jset_list_c, &
907 ipgf_list=ipgf_list_c, &
908 jpgf_list=jpgf_list_c, &
909 border_mask_list=border_mask_list_c, &
910 block_num_list=block_num_list_c, &
911 radius_list=radius_list_c, &
912 rab_list=rab_list_c, &
913 npts_global=c_loc(npts_global(1, 1)), &
914 npts_local=c_loc(npts_local(1, 1)), &
915 shift_local=c_loc(shift_local(1, 1)), &
916 border_width=c_loc(border_width(1, 1)), &
917 dh=c_loc(dh(1, 1, 1)), &
918 dh_inv=c_loc(dh_inv(1, 1, 1)), &
919 task_list=task_list%c_ptr)
920
921 cpassert(c_associated(task_list%c_ptr))
922
923 CALL timestop(handle)
924 END SUBROUTINE grid_create_task_list
925
926! **************************************************************************************************
927!> \brief Deallocates given task list, basis_sets have to be freed separately.
928!> \param task_list ...
929!> \author Ole Schuett
930! **************************************************************************************************
931 SUBROUTINE grid_free_task_list(task_list)
932 TYPE(grid_task_list_type), INTENT(INOUT) :: task_list
933
934 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_free_task_list'
935
936 INTEGER :: handle
937 INTERFACE
938 SUBROUTINE grid_free_task_list_c(task_list) &
939 BIND(C, name="grid_free_task_list")
940 IMPORT :: c_ptr
941 TYPE(c_ptr), VALUE :: task_list
942 END SUBROUTINE grid_free_task_list_c
943 END INTERFACE
944
945 CALL timeset(routinen, handle)
946
947 IF (c_associated(task_list%c_ptr)) THEN
948 CALL grid_free_task_list_c(task_list%c_ptr)
949 END IF
950
951 task_list%c_ptr = c_null_ptr
952
953 CALL timestop(handle)
954 END SUBROUTINE grid_free_task_list
955
956! **************************************************************************************************
957!> \brief Collocate all tasks of in given list onto given grids.
958!> \param task_list ...
959!> \param ga_gb_function ...
960!> \param pab_blocks ...
961!> \param rs_grids ...
962!> \author Ole Schuett
963! **************************************************************************************************
964 SUBROUTINE grid_collocate_task_list(task_list, ga_gb_function, pab_blocks, rs_grids)
965 TYPE(grid_task_list_type), INTENT(IN) :: task_list
966 INTEGER, INTENT(IN) :: ga_gb_function
967 TYPE(offload_buffer_type), INTENT(IN) :: pab_blocks
968 TYPE(realspace_grid_type), DIMENSION(:), &
969 INTENT(IN) :: rs_grids
970
971 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_collocate_task_list'
972
973 INTEGER :: handle, ilevel, nlevels
974 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: npts_local
975 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: grids_c
976 INTERFACE
977 SUBROUTINE grid_collocate_task_list_c(task_list, func, nlevels, &
978 npts_local, pab_blocks, grids) &
979 BIND(C, name="grid_collocate_task_list")
980 IMPORT :: c_ptr, c_int, c_bool
981 TYPE(c_ptr), VALUE :: task_list
982 INTEGER(KIND=C_INT), VALUE :: func
983 INTEGER(KIND=C_INT), VALUE :: nlevels
984 TYPE(c_ptr), VALUE :: npts_local
985 TYPE(c_ptr), VALUE :: pab_blocks
986 TYPE(c_ptr), VALUE :: grids
987 END SUBROUTINE grid_collocate_task_list_c
988 END INTERFACE
989
990 CALL timeset(routinen, handle)
991
992 nlevels = SIZE(rs_grids)
993 cpassert(nlevels > 0)
994
995 ALLOCATE (grids_c(nlevels))
996 ALLOCATE (npts_local(3, nlevels))
997 DO ilevel = 1, nlevels
998 associate(rsgrid => rs_grids(ilevel))
999 npts_local(:, ilevel) = rsgrid%ub_local - rsgrid%lb_local + 1
1000 grids_c(ilevel) = rsgrid%buffer%c_ptr
1001 END associate
1002 END DO
1003
1004#if __GNUC__ >= 9
1005 cpassert(is_contiguous(npts_local))
1006 cpassert(is_contiguous(grids_c))
1007#endif
1008
1009 cpassert(c_associated(task_list%c_ptr))
1010 cpassert(c_associated(pab_blocks%c_ptr))
1011
1012 CALL grid_collocate_task_list_c(task_list=task_list%c_ptr, &
1013 func=ga_gb_function, &
1014 nlevels=nlevels, &
1015 npts_local=c_loc(npts_local(1, 1)), &
1016 pab_blocks=pab_blocks%c_ptr, &
1017 grids=c_loc(grids_c(1)))
1018
1019 CALL timestop(handle)
1020 END SUBROUTINE grid_collocate_task_list
1021
1022! **************************************************************************************************
1023!> \brief Integrate all tasks of in given list from given grids.
1024!> \param task_list ...
1025!> \param compute_tau ...
1026!> \param calculate_forces ...
1027!> \param calculate_virial ...
1028!> \param pab_blocks ...
1029!> \param rs_grids ...
1030!> \param hab_blocks ...
1031!> \param forces ...
1032!> \param virial ...
1033!> \author Ole Schuett
1034! **************************************************************************************************
1035 SUBROUTINE grid_integrate_task_list(task_list, compute_tau, calculate_forces, calculate_virial, &
1036 pab_blocks, rs_grids, hab_blocks, forces, virial)
1037 TYPE(grid_task_list_type), INTENT(IN) :: task_list
1038 LOGICAL, INTENT(IN) :: compute_tau, calculate_forces, &
1039 calculate_virial
1040 TYPE(offload_buffer_type), INTENT(IN) :: pab_blocks
1041 TYPE(realspace_grid_type), DIMENSION(:), &
1042 INTENT(IN) :: rs_grids
1043 TYPE(offload_buffer_type), INTENT(INOUT) :: hab_blocks
1044 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT), &
1045 TARGET :: forces
1046 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
1047 TARGET :: virial
1048
1049 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_integrate_task_list'
1050
1051 INTEGER :: handle, ilevel, nlevels
1052 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: npts_local
1053 TYPE(c_ptr) :: forces_c, virial_c
1054 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: grids_c
1055 INTERFACE
1056 SUBROUTINE grid_integrate_task_list_c(task_list, compute_tau, natoms, &
1057 nlevels, npts_local, &
1058 pab_blocks, grids, hab_blocks, forces, virial) &
1059 BIND(C, name="grid_integrate_task_list")
1060 IMPORT :: c_ptr, c_int, c_bool
1061 TYPE(c_ptr), VALUE :: task_list
1062 LOGICAL(KIND=C_BOOL), VALUE :: compute_tau
1063 INTEGER(KIND=C_INT), VALUE :: natoms
1064 INTEGER(KIND=C_INT), VALUE :: nlevels
1065 TYPE(c_ptr), VALUE :: npts_local
1066 TYPE(c_ptr), VALUE :: pab_blocks
1067 TYPE(c_ptr), VALUE :: grids
1068 TYPE(c_ptr), VALUE :: hab_blocks
1069 TYPE(c_ptr), VALUE :: forces
1070 TYPE(c_ptr), VALUE :: virial
1071 END SUBROUTINE grid_integrate_task_list_c
1072 END INTERFACE
1073
1074 CALL timeset(routinen, handle)
1075
1076 nlevels = SIZE(rs_grids)
1077 cpassert(nlevels > 0)
1078
1079 ALLOCATE (grids_c(nlevels))
1080 ALLOCATE (npts_local(3, nlevels))
1081 DO ilevel = 1, nlevels
1082 associate(rsgrid => rs_grids(ilevel))
1083 npts_local(:, ilevel) = rsgrid%ub_local - rsgrid%lb_local + 1
1084 grids_c(ilevel) = rsgrid%buffer%c_ptr
1085 END associate
1086 END DO
1087
1088 IF (calculate_forces) THEN
1089 forces_c = c_loc(forces(1, 1))
1090 ELSE
1091 forces_c = c_null_ptr
1092 END IF
1093
1094 IF (calculate_virial) THEN
1095 virial_c = c_loc(virial(1, 1))
1096 ELSE
1097 virial_c = c_null_ptr
1098 END IF
1099
1100#if __GNUC__ >= 9
1101 cpassert(is_contiguous(npts_local))
1102 cpassert(is_contiguous(grids_c))
1103 cpassert(is_contiguous(forces))
1104 cpassert(is_contiguous(virial))
1105#endif
1106
1107 cpassert(SIZE(forces, 1) == 3)
1108 cpassert(c_associated(task_list%c_ptr))
1109 cpassert(c_associated(hab_blocks%c_ptr))
1110 cpassert(c_associated(pab_blocks%c_ptr) .OR. .NOT. calculate_forces)
1111 cpassert(c_associated(pab_blocks%c_ptr) .OR. .NOT. calculate_virial)
1112
1113 CALL grid_integrate_task_list_c(task_list=task_list%c_ptr, &
1114 compute_tau=LOGICAL(compute_tau, C_BOOL), &
1115 natoms=size(forces, 2), &
1116 nlevels=nlevels, &
1117 npts_local=c_loc(npts_local(1, 1)), &
1118 pab_blocks=pab_blocks%c_ptr, &
1119 grids=c_loc(grids_c(1)), &
1120 hab_blocks=hab_blocks%c_ptr, &
1121 forces=forces_c, &
1122 virial=virial_c)
1123
1124 CALL timestop(handle)
1125 END SUBROUTINE grid_integrate_task_list
1126
1127! **************************************************************************************************
1128!> \brief Initialize grid library
1129!> \author Ole Schuett
1130! **************************************************************************************************
1131 SUBROUTINE grid_library_init()
1132 INTERFACE
1133 SUBROUTINE grid_library_init_c() BIND(C, name="grid_library_init")
1134 END SUBROUTINE grid_library_init_c
1135 END INTERFACE
1136
1137 CALL grid_library_init_c()
1138
1139 END SUBROUTINE grid_library_init
1140
1141! **************************************************************************************************
1142!> \brief Finalize grid library
1143!> \author Ole Schuett
1144! **************************************************************************************************
1145 SUBROUTINE grid_library_finalize()
1146 INTERFACE
1147 SUBROUTINE grid_library_finalize_c() BIND(C, name="grid_library_finalize")
1148 END SUBROUTINE grid_library_finalize_c
1149 END INTERFACE
1150
1151 CALL grid_library_finalize_c()
1152
1153 END SUBROUTINE grid_library_finalize
1154
1155! **************************************************************************************************
1156!> \brief Configures the grid library
1157!> \param backend : backend to be used for collocate/integrate, possible values are REF, CPU, GPU
1158!> \param validate : if set to true, compare the results of all backend to the reference backend
1159!> \param apply_cutoff : apply a spherical cutoff before collocating or integrating. Only relevant for CPU backend
1160!> \author Ole Schuett
1161! **************************************************************************************************
1162 SUBROUTINE grid_library_set_config(backend, validate, apply_cutoff)
1163 INTEGER, INTENT(IN) :: backend
1164 LOGICAL, INTENT(IN) :: validate, apply_cutoff
1165
1166 INTERFACE
1167 SUBROUTINE grid_library_set_config_c(backend, validate, apply_cutoff) &
1168 BIND(C, name="grid_library_set_config")
1169 IMPORT :: c_int, c_bool
1170 INTEGER(KIND=C_INT), VALUE :: backend
1171 LOGICAL(KIND=C_BOOL), VALUE :: validate
1172 LOGICAL(KIND=C_BOOL), VALUE :: apply_cutoff
1173 END SUBROUTINE grid_library_set_config_c
1174 END INTERFACE
1175
1176 CALL grid_library_set_config_c(backend=backend, &
1177 validate=LOGICAL(validate, C_BOOL), &
1178 apply_cutoff=logical(apply_cutoff, c_bool))
1179
1180 END SUBROUTINE grid_library_set_config
1181
1182! **************************************************************************************************
1183!> \brief Print grid library statistics
1184!> \param mpi_comm ...
1185!> \param output_unit ...
1186!> \author Ole Schuett
1187! **************************************************************************************************
1188 SUBROUTINE grid_library_print_stats(mpi_comm, output_unit)
1189 TYPE(mp_comm_type) :: mpi_comm
1190 INTEGER, INTENT(IN) :: output_unit
1191
1192 INTERFACE
1193 SUBROUTINE grid_library_print_stats_c(mpi_comm, print_func, output_unit) &
1194 BIND(C, name="grid_library_print_stats")
1195 IMPORT :: c_funptr, c_int
1196 INTEGER(KIND=C_INT), VALUE :: mpi_comm
1197 TYPE(c_funptr), VALUE :: print_func
1198 INTEGER(KIND=C_INT), VALUE :: output_unit
1199 END SUBROUTINE grid_library_print_stats_c
1200 END INTERFACE
1201
1202 ! Since Fortran units and mpi groups can't be used from C, we pass function pointers instead.
1203 CALL grid_library_print_stats_c(mpi_comm=mpi_comm%get_handle(), &
1204 print_func=c_funloc(print_func), &
1205 output_unit=output_unit)
1206
1207 END SUBROUTINE grid_library_print_stats
1208
1209! **************************************************************************************************
1210!> \brief Callback to write to a Fortran output unit (called by C-side).
1211!> \param msg to be printed.
1212!> \param msglen number of characters excluding the terminating character.
1213!> \param output_unit used for output.
1214!> \author Ole Schuett and Hans Pabst
1215! **************************************************************************************************
1216 SUBROUTINE print_func(msg, msglen, output_unit) BIND(C, name="grid_api_print_func")
1217 CHARACTER(KIND=C_CHAR), INTENT(IN) :: msg(*)
1218 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: msglen, output_unit
1219
1220 IF (output_unit <= 0) RETURN ! Omit to print the message.
1221 WRITE (output_unit, fmt="(100A)", advance="NO") msg(1:msglen)
1222 END SUBROUTINE print_func
1223END MODULE grid_api
print_func
static void print_func(const char *msg, int msglen, int output_unit)
Wrapper for printf, passed to dbm_library_print_stats.
Definition dbm_miniapp.c:25
grid_create_basis_set
void grid_create_basis_set(const int nset, const int nsgf, const int maxco, const int maxpgf, const int lmin[nset], const int lmax[nset], const int npgf[nset], const int nsgf_set[nset], const int first_sgf[nset], const double sphi[nsgf][maxco], const double zet[nset][maxpgf], grid_basis_set **basis_set_out)
Allocates a basis set which can be passed to grid_create_task_list. See grid_task_list....
Definition grid_basis_set.c:19
grid_free_basis_set
void grid_free_basis_set(grid_basis_set *basis_set)
Deallocates given basis set.
Definition grid_basis_set.c:75
apply_cutoff
void apply_cutoff(void *ptr)
Definition grid_dgemm_context.c:477
grid_library_finalize
void grid_library_finalize(void)
Finalizes the grid library.
Definition grid_library.c:89
grid_library_init
void grid_library_init(void)
Initializes the grid library.
Definition grid_library.c:53
grid_library_set_config
void grid_library_set_config(const enum grid_backend backend, const bool validate, const bool apply_cutoff)
Configures the grid library.
Definition grid_library.c:118
grid_library_print_stats
void grid_library_print_stats(const int fortran_comm, void(*print_func)(const char *, int, int), const int output_unit)
Prints statistics gathered by the grid library.
Definition grid_library.c:161
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:965
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:932
grid_api::grid_func_dzdz
integer, parameter, public grid_func_dzdz
Definition grid_api.F:52
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_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:723
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_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::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:276
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:1037
grid_api::grid_func_core_y
integer, parameter, public grid_func_core_y
Definition grid_api.F:61
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_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:23
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:155
offload_api::offload_buffer_type
Definition offload_api.F:35
realspace_grid_types::realspace_grid_type
Definition realspace_grid_types.F:136