(git:d3d49ac)
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)) THEN
478 force_a = force_a + forces(:, 1)
479 END IF
480 IF (PRESENT(force_b) .AND. c_associated(forces_cptr)) THEN
481 force_b = force_b + forces(:, 2)
482 END IF
483 IF (PRESENT(my_virial_a) .AND. c_associated(virials_cptr)) THEN
484 my_virial_a = my_virial_a + virials(:, :, 1)
485 END IF
486 IF (PRESENT(my_virial_b) .AND. c_associated(virials_cptr)) THEN
487 my_virial_b = my_virial_b + virials(:, :, 2)
488 END IF
489
490 END SUBROUTINE integrate_pgf_product
491
492! **************************************************************************************************
493!> \brief Helper routines for getting rsgrid properties and asserting underlying assumptions.
494!> \param rsgrid ...
495!> \param npts_global ...
496!> \param npts_local ...
497!> \param shift_local ...
498!> \param border_width ...
499!> \author Ole Schuett
500! **************************************************************************************************
501 SUBROUTINE get_rsgrid_properties(rsgrid, npts_global, npts_local, shift_local, border_width)
502 TYPE(realspace_grid_type), INTENT(IN) :: rsgrid
503 INTEGER, DIMENSION(:) :: npts_global, npts_local, shift_local, &
504 border_width
505
506 INTEGER :: i
507
508 ! See rs_grid_create() in ./src/pw/realspace_grid_types.F.
509 cpassert(lbound(rsgrid%r, 1) == rsgrid%lb_local(1))
510 cpassert(ubound(rsgrid%r, 1) == rsgrid%ub_local(1))
511 cpassert(lbound(rsgrid%r, 2) == rsgrid%lb_local(2))
512 cpassert(ubound(rsgrid%r, 2) == rsgrid%ub_local(2))
513 cpassert(lbound(rsgrid%r, 3) == rsgrid%lb_local(3))
514 cpassert(ubound(rsgrid%r, 3) == rsgrid%ub_local(3))
515
516 ! While the rsgrid code assumes that the grid starts at rsgrid%lb,
517 ! the collocate code assumes that the grid starts at (1,1,1) in Fortran, or (0,0,0) in C.
518 ! So, a point rp(:) gets the following grid coordinates MODULO(rp(:)/dr(:),npts_global(:))
519
520 ! Number of global grid points in each direction.
521 npts_global = rsgrid%desc%ub - rsgrid%desc%lb + 1
522
523 ! Number of local grid points in each direction.
524 npts_local = rsgrid%ub_local - rsgrid%lb_local + 1
525
526 ! Number of points the local grid is shifted wrt global grid.
527 shift_local = rsgrid%lb_local - rsgrid%desc%lb
528
529 ! Convert rsgrid%desc%border and rsgrid%desc%perd into the more convenient border_width array.
530 DO i = 1, 3
531 IF (rsgrid%desc%perd(i) == 1) THEN
532 ! Periodic meaning the grid in this direction is entriely present on every processor.
533 cpassert(npts_local(i) == npts_global(i))
534 cpassert(shift_local(i) == 0)
535 ! No need for halo regions.
536 border_width(i) = 0
537 ELSE
538 ! Not periodic meaning the grid in this direction is distributed among processors.
539 cpassert(npts_local(i) <= npts_global(i))
540 ! Check bounds of grid section that is owned by this processor.
541 cpassert(rsgrid%lb_real(i) == rsgrid%lb_local(i) + rsgrid%desc%border)
542 cpassert(rsgrid%ub_real(i) == rsgrid%ub_local(i) - rsgrid%desc%border)
543 ! We have halo regions.
544 border_width(i) = rsgrid%desc%border
545 END IF
546 END DO
547 END SUBROUTINE get_rsgrid_properties
548
549! **************************************************************************************************
550!> \brief Allocates a basis set which can be passed to grid_create_task_list.
551!> \param nset ...
552!> \param nsgf ...
553!> \param maxco ...
554!> \param maxpgf ...
555!> \param lmin ...
556!> \param lmax ...
557!> \param npgf ...
558!> \param nsgf_set ...
559!> \param first_sgf ...
560!> \param sphi ...
561!> \param zet ...
562!> \param basis_set ...
563!> \author Ole Schuett
564! **************************************************************************************************
565 SUBROUTINE grid_create_basis_set(nset, nsgf, maxco, maxpgf, &
566 lmin, lmax, npgf, nsgf_set, first_sgf, sphi, zet, &
567 basis_set)
568 INTEGER, INTENT(IN) :: nset, nsgf, maxco, maxpgf
569 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: lmin, lmax, npgf, nsgf_set
570 INTEGER, DIMENSION(:, :), INTENT(IN) :: first_sgf
571 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: sphi, zet
572 TYPE(grid_basis_set_type), INTENT(INOUT) :: basis_set
573
574 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_create_basis_set'
575
576 INTEGER :: handle
577 INTEGER, DIMENSION(nset), TARGET :: my_first_sgf
578 TYPE(c_ptr) :: first_sgf_c, lmax_c, lmin_c, npgf_c, &
579 nsgf_set_c, sphi_c, zet_c
580 INTERFACE
581 SUBROUTINE grid_create_basis_set_c(nset, nsgf, maxco, maxpgf, &
582 lmin, lmax, npgf, nsgf_set, first_sgf, sphi, zet, &
583 basis_set) &
584 BIND(C, name="grid_create_basis_set")
585 IMPORT :: c_ptr, c_int
586 INTEGER(KIND=C_INT), VALUE :: nset
587 INTEGER(KIND=C_INT), VALUE :: nsgf
588 INTEGER(KIND=C_INT), VALUE :: maxco
589 INTEGER(KIND=C_INT), VALUE :: maxpgf
590 TYPE(c_ptr), VALUE :: lmin
591 TYPE(c_ptr), VALUE :: lmax
592 TYPE(c_ptr), VALUE :: npgf
593 TYPE(c_ptr), VALUE :: nsgf_set
594 TYPE(c_ptr), VALUE :: first_sgf
595 TYPE(c_ptr), VALUE :: sphi
596 TYPE(c_ptr), VALUE :: zet
597 TYPE(c_ptr) :: basis_set
598 END SUBROUTINE grid_create_basis_set_c
599 END INTERFACE
600
601 CALL timeset(routinen, handle)
602
603 cpassert(SIZE(lmin) == nset)
604 cpassert(SIZE(lmin) == nset)
605 cpassert(SIZE(lmax) == nset)
606 cpassert(SIZE(npgf) == nset)
607 cpassert(SIZE(nsgf_set) == nset)
608 cpassert(SIZE(first_sgf, 2) == nset)
609 cpassert(SIZE(sphi, 1) == maxco .AND. SIZE(sphi, 2) == nsgf)
610 cpassert(SIZE(zet, 1) == maxpgf .AND. SIZE(zet, 2) == nset)
611 cpassert(.NOT. c_associated(basis_set%c_ptr))
612
613#if __GNUC__ >= 9
614 cpassert(is_contiguous(lmin))
615 cpassert(is_contiguous(lmax))
616 cpassert(is_contiguous(npgf))
617 cpassert(is_contiguous(nsgf_set))
618 cpassert(is_contiguous(my_first_sgf))
619 cpassert(is_contiguous(sphi))
620 cpassert(is_contiguous(zet))
621#endif
622
623 lmin_c = c_null_ptr
624 lmax_c = c_null_ptr
625 npgf_c = c_null_ptr
626 nsgf_set_c = c_null_ptr
627 first_sgf_c = c_null_ptr
628 sphi_c = c_null_ptr
629 zet_c = c_null_ptr
630
631 ! Basis sets arrays can be empty, need to check before accessing the first element.
632 IF (nset > 0) THEN
633 lmin_c = c_loc(lmin(1))
634 lmax_c = c_loc(lmax(1))
635 npgf_c = c_loc(npgf(1))
636 nsgf_set_c = c_loc(nsgf_set(1))
637 END IF
638 IF (SIZE(first_sgf) > 0) THEN
639 my_first_sgf(:) = first_sgf(1, :) ! make a contiguous copy
640 first_sgf_c = c_loc(my_first_sgf(1))
641 END IF
642 IF (SIZE(sphi) > 0) THEN
643 sphi_c = c_loc(sphi(1, 1))
644 END IF
645 IF (SIZE(zet) > 0) THEN
646 zet_c = c_loc(zet(1, 1))
647 END IF
648
649 CALL grid_create_basis_set_c(nset=nset, &
650 nsgf=nsgf, &
651 maxco=maxco, &
652 maxpgf=maxpgf, &
653 lmin=lmin_c, &
654 lmax=lmax_c, &
655 npgf=npgf_c, &
656 nsgf_set=nsgf_set_c, &
657 first_sgf=first_sgf_c, &
658 sphi=sphi_c, &
659 zet=zet_c, &
660 basis_set=basis_set%c_ptr)
661 cpassert(c_associated(basis_set%c_ptr))
662
663 CALL timestop(handle)
664 END SUBROUTINE grid_create_basis_set
665
666! **************************************************************************************************
667!> \brief Deallocates given basis set.
668!> \param basis_set ...
669!> \author Ole Schuett
670! **************************************************************************************************
671 SUBROUTINE grid_free_basis_set(basis_set)
672 TYPE(grid_basis_set_type), INTENT(INOUT) :: basis_set
673
674 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_free_basis_set'
675
676 INTEGER :: handle
677 INTERFACE
678 SUBROUTINE grid_free_basis_set_c(basis_set) &
679 BIND(C, name="grid_free_basis_set")
680 IMPORT :: c_ptr
681 TYPE(c_ptr), VALUE :: basis_set
682 END SUBROUTINE grid_free_basis_set_c
683 END INTERFACE
684
685 CALL timeset(routinen, handle)
686
687 cpassert(c_associated(basis_set%c_ptr))
688
689 CALL grid_free_basis_set_c(basis_set%c_ptr)
690
691 basis_set%c_ptr = c_null_ptr
692
693 CALL timestop(handle)
694 END SUBROUTINE grid_free_basis_set
695
696! **************************************************************************************************
697!> \brief Allocates a task list which can be passed to grid_collocate_task_list.
698!> \param ntasks ...
699!> \param natoms ...
700!> \param nkinds ...
701!> \param nblocks ...
702!> \param block_offsets ...
703!> \param atom_positions ...
704!> \param atom_kinds ...
705!> \param basis_sets ...
706!> \param level_list ...
707!> \param iatom_list ...
708!> \param jatom_list ...
709!> \param iset_list ...
710!> \param jset_list ...
711!> \param ipgf_list ...
712!> \param jpgf_list ...
713!> \param border_mask_list ...
714!> \param block_num_list ...
715!> \param radius_list ...
716!> \param rab_list ...
717!> \param rs_grids ...
718!> \param task_list ...
719!> \author Ole Schuett
720! **************************************************************************************************
721 SUBROUTINE grid_create_task_list(ntasks, natoms, nkinds, nblocks, &
722 block_offsets, atom_positions, atom_kinds, basis_sets, &
723 level_list, iatom_list, jatom_list, &
724 iset_list, jset_list, ipgf_list, jpgf_list, &
725 border_mask_list, block_num_list, &
726 radius_list, rab_list, rs_grids, task_list)
727
728 INTEGER, INTENT(IN) :: ntasks, natoms, nkinds, nblocks
729 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: block_offsets
730 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: atom_positions
731 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: atom_kinds
732 TYPE(grid_basis_set_type), DIMENSION(:), &
733 INTENT(IN), TARGET :: basis_sets
734 INTEGER, DIMENSION(:), INTENT(IN), TARGET :: level_list, iatom_list, jatom_list, &
735 iset_list, jset_list, ipgf_list, &
736 jpgf_list, border_mask_list, &
737 block_num_list
738 REAL(kind=dp), DIMENSION(:), INTENT(IN), TARGET :: radius_list
739 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), TARGET :: rab_list
740 TYPE(realspace_grid_type), DIMENSION(:), &
741 INTENT(IN) :: rs_grids
742 TYPE(grid_task_list_type), INTENT(INOUT) :: task_list
743
744 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_create_task_list'
745
746 INTEGER :: handle, ikind, ilevel, nlevels
747 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: border_width, npts_global, npts_local, &
748 shift_local
749 LOGICAL(KIND=C_BOOL) :: orthorhombic
750 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :), &
751 TARGET :: dh, dh_inv
752 TYPE(c_ptr) :: block_num_list_c, block_offsets_c, border_mask_list_c, iatom_list_c, &
753 ipgf_list_c, iset_list_c, jatom_list_c, jpgf_list_c, jset_list_c, level_list_c, &
754 rab_list_c, radius_list_c
755 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: basis_sets_c
756 INTERFACE
757 SUBROUTINE grid_create_task_list_c(orthorhombic, &
758 ntasks, nlevels, natoms, nkinds, nblocks, &
759 block_offsets, atom_positions, atom_kinds, basis_sets, &
760 level_list, iatom_list, jatom_list, &
761 iset_list, jset_list, ipgf_list, jpgf_list, &
762 border_mask_list, block_num_list, &
763 radius_list, rab_list, &
764 npts_global, npts_local, shift_local, &
765 border_width, dh, dh_inv, task_list) &
766 BIND(C, name="grid_create_task_list")
767 IMPORT :: c_ptr, c_int, c_bool
768 LOGICAL(KIND=C_BOOL), VALUE :: orthorhombic
769 INTEGER(KIND=C_INT), VALUE :: ntasks
770 INTEGER(KIND=C_INT), VALUE :: nlevels
771 INTEGER(KIND=C_INT), VALUE :: natoms
772 INTEGER(KIND=C_INT), VALUE :: nkinds
773 INTEGER(KIND=C_INT), VALUE :: nblocks
774 TYPE(c_ptr), VALUE :: block_offsets
775 TYPE(c_ptr), VALUE :: atom_positions
776 TYPE(c_ptr), VALUE :: atom_kinds
777 TYPE(c_ptr), VALUE :: basis_sets
778 TYPE(c_ptr), VALUE :: level_list
779 TYPE(c_ptr), VALUE :: iatom_list
780 TYPE(c_ptr), VALUE :: jatom_list
781 TYPE(c_ptr), VALUE :: iset_list
782 TYPE(c_ptr), VALUE :: jset_list
783 TYPE(c_ptr), VALUE :: ipgf_list
784 TYPE(c_ptr), VALUE :: jpgf_list
785 TYPE(c_ptr), VALUE :: border_mask_list
786 TYPE(c_ptr), VALUE :: block_num_list
787 TYPE(c_ptr), VALUE :: radius_list
788 TYPE(c_ptr), VALUE :: rab_list
789 TYPE(c_ptr), VALUE :: npts_global
790 TYPE(c_ptr), VALUE :: npts_local
791 TYPE(c_ptr), VALUE :: shift_local
792 TYPE(c_ptr), VALUE :: border_width
793 TYPE(c_ptr), VALUE :: dh
794 TYPE(c_ptr), VALUE :: dh_inv
795 TYPE(c_ptr) :: task_list
796 END SUBROUTINE grid_create_task_list_c
797 END INTERFACE
798
799 CALL timeset(routinen, handle)
800
801 cpassert(SIZE(block_offsets) == nblocks)
802 cpassert(SIZE(atom_positions, 1) == 3 .AND. SIZE(atom_positions, 2) == natoms)
803 cpassert(SIZE(atom_kinds) == natoms)
804 cpassert(SIZE(basis_sets) == nkinds)
805 cpassert(SIZE(level_list) == ntasks)
806 cpassert(SIZE(iatom_list) == ntasks)
807 cpassert(SIZE(jatom_list) == ntasks)
808 cpassert(SIZE(iset_list) == ntasks)
809 cpassert(SIZE(jset_list) == ntasks)
810 cpassert(SIZE(ipgf_list) == ntasks)
811 cpassert(SIZE(jpgf_list) == ntasks)
812 cpassert(SIZE(border_mask_list) == ntasks)
813 cpassert(SIZE(block_num_list) == ntasks)
814 cpassert(SIZE(radius_list) == ntasks)
815 cpassert(SIZE(rab_list, 1) == 3 .AND. SIZE(rab_list, 2) == ntasks)
816
817 ALLOCATE (basis_sets_c(nkinds))
818 DO ikind = 1, nkinds
819 basis_sets_c(ikind) = basis_sets(ikind)%c_ptr
820 END DO
821
822 nlevels = SIZE(rs_grids)
823 cpassert(nlevels > 0)
824 orthorhombic = LOGICAL(rs_grids(1)%desc%orthorhombic, c_bool)
825
826 ALLOCATE (npts_global(3, nlevels), npts_local(3, nlevels))
827 ALLOCATE (shift_local(3, nlevels), border_width(3, nlevels))
828 ALLOCATE (dh(3, 3, nlevels), dh_inv(3, 3, nlevels))
829 DO ilevel = 1, nlevels
830 associate(rsgrid => rs_grids(ilevel))
831 CALL get_rsgrid_properties(rsgrid=rsgrid, &
832 npts_global=npts_global(:, ilevel), &
833 npts_local=npts_local(:, ilevel), &
834 shift_local=shift_local(:, ilevel), &
835 border_width=border_width(:, ilevel))
836 cpassert(rsgrid%desc%orthorhombic .EQV. orthorhombic) ! should be the same for all levels
837 dh(:, :, ilevel) = rsgrid%desc%dh(:, :)
838 dh_inv(:, :, ilevel) = rsgrid%desc%dh_inv(:, :)
839 END associate
840 END DO
841
842#if __GNUC__ >= 9
843 cpassert(is_contiguous(block_offsets))
844 cpassert(is_contiguous(atom_positions))
845 cpassert(is_contiguous(atom_kinds))
846 cpassert(is_contiguous(basis_sets))
847 cpassert(is_contiguous(level_list))
848 cpassert(is_contiguous(iatom_list))
849 cpassert(is_contiguous(jatom_list))
850 cpassert(is_contiguous(iset_list))
851 cpassert(is_contiguous(jset_list))
852 cpassert(is_contiguous(ipgf_list))
853 cpassert(is_contiguous(jpgf_list))
854 cpassert(is_contiguous(border_mask_list))
855 cpassert(is_contiguous(block_num_list))
856 cpassert(is_contiguous(radius_list))
857 cpassert(is_contiguous(rab_list))
858 cpassert(is_contiguous(npts_global))
859 cpassert(is_contiguous(npts_local))
860 cpassert(is_contiguous(shift_local))
861 cpassert(is_contiguous(border_width))
862 cpassert(is_contiguous(dh))
863 cpassert(is_contiguous(dh_inv))
864#endif
865
866 IF (ntasks > 0) THEN
867 block_offsets_c = c_loc(block_offsets(1))
868 level_list_c = c_loc(level_list(1))
869 iatom_list_c = c_loc(iatom_list(1))
870 jatom_list_c = c_loc(jatom_list(1))
871 iset_list_c = c_loc(iset_list(1))
872 jset_list_c = c_loc(jset_list(1))
873 ipgf_list_c = c_loc(ipgf_list(1))
874 jpgf_list_c = c_loc(jpgf_list(1))
875 border_mask_list_c = c_loc(border_mask_list(1))
876 block_num_list_c = c_loc(block_num_list(1))
877 radius_list_c = c_loc(radius_list(1))
878 rab_list_c = c_loc(rab_list(1, 1))
879 ELSE
880 ! Without tasks the lists are empty and there is no first element to call C_LOC on.
881 block_offsets_c = c_null_ptr
882 level_list_c = c_null_ptr
883 iatom_list_c = c_null_ptr
884 jatom_list_c = c_null_ptr
885 iset_list_c = c_null_ptr
886 jset_list_c = c_null_ptr
887 ipgf_list_c = c_null_ptr
888 jpgf_list_c = c_null_ptr
889 border_mask_list_c = c_null_ptr
890 block_num_list_c = c_null_ptr
891 radius_list_c = c_null_ptr
892 rab_list_c = c_null_ptr
893 END IF
894
895 !If task_list%c_ptr is already allocated, then its memory will be reused or freed.
896 CALL grid_create_task_list_c(orthorhombic=orthorhombic, &
897 ntasks=ntasks, &
898 nlevels=nlevels, &
899 natoms=natoms, &
900 nkinds=nkinds, &
901 nblocks=nblocks, &
902 block_offsets=block_offsets_c, &
903 atom_positions=c_loc(atom_positions(1, 1)), &
904 atom_kinds=c_loc(atom_kinds(1)), &
905 basis_sets=c_loc(basis_sets_c(1)), &
906 level_list=level_list_c, &
907 iatom_list=iatom_list_c, &
908 jatom_list=jatom_list_c, &
909 iset_list=iset_list_c, &
910 jset_list=jset_list_c, &
911 ipgf_list=ipgf_list_c, &
912 jpgf_list=jpgf_list_c, &
913 border_mask_list=border_mask_list_c, &
914 block_num_list=block_num_list_c, &
915 radius_list=radius_list_c, &
916 rab_list=rab_list_c, &
917 npts_global=c_loc(npts_global(1, 1)), &
918 npts_local=c_loc(npts_local(1, 1)), &
919 shift_local=c_loc(shift_local(1, 1)), &
920 border_width=c_loc(border_width(1, 1)), &
921 dh=c_loc(dh(1, 1, 1)), &
922 dh_inv=c_loc(dh_inv(1, 1, 1)), &
923 task_list=task_list%c_ptr)
924
925 cpassert(c_associated(task_list%c_ptr))
926
927 CALL timestop(handle)
928 END SUBROUTINE grid_create_task_list
929
930! **************************************************************************************************
931!> \brief Deallocates given task list, basis_sets have to be freed separately.
932!> \param task_list ...
933!> \author Ole Schuett
934! **************************************************************************************************
935 SUBROUTINE grid_free_task_list(task_list)
936 TYPE(grid_task_list_type), INTENT(INOUT) :: task_list
937
938 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_free_task_list'
939
940 INTEGER :: handle
941 INTERFACE
942 SUBROUTINE grid_free_task_list_c(task_list) &
943 BIND(C, name="grid_free_task_list")
944 IMPORT :: c_ptr
945 TYPE(c_ptr), VALUE :: task_list
946 END SUBROUTINE grid_free_task_list_c
947 END INTERFACE
948
949 CALL timeset(routinen, handle)
950
951 IF (c_associated(task_list%c_ptr)) THEN
952 CALL grid_free_task_list_c(task_list%c_ptr)
953 END IF
954
955 task_list%c_ptr = c_null_ptr
956
957 CALL timestop(handle)
958 END SUBROUTINE grid_free_task_list
959
960! **************************************************************************************************
961!> \brief Collocate all tasks of in given list onto given grids.
962!> \param task_list ...
963!> \param ga_gb_function ...
964!> \param pab_blocks ...
965!> \param rs_grids ...
966!> \author Ole Schuett
967! **************************************************************************************************
968 SUBROUTINE grid_collocate_task_list(task_list, ga_gb_function, pab_blocks, rs_grids)
969 TYPE(grid_task_list_type), INTENT(IN) :: task_list
970 INTEGER, INTENT(IN) :: ga_gb_function
971 TYPE(offload_buffer_type), INTENT(IN) :: pab_blocks
972 TYPE(realspace_grid_type), DIMENSION(:), &
973 INTENT(IN) :: rs_grids
974
975 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_collocate_task_list'
976
977 INTEGER :: handle, ilevel, nlevels
978 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: npts_local
979 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: grids_c
980 INTERFACE
981 SUBROUTINE grid_collocate_task_list_c(task_list, func, nlevels, &
982 npts_local, pab_blocks, grids) &
983 BIND(C, name="grid_collocate_task_list")
984 IMPORT :: c_ptr, c_int, c_bool
985 TYPE(c_ptr), VALUE :: task_list
986 INTEGER(KIND=C_INT), VALUE :: func
987 INTEGER(KIND=C_INT), VALUE :: nlevels
988 TYPE(c_ptr), VALUE :: npts_local
989 TYPE(c_ptr), VALUE :: pab_blocks
990 TYPE(c_ptr), VALUE :: grids
991 END SUBROUTINE grid_collocate_task_list_c
992 END INTERFACE
993
994 CALL timeset(routinen, handle)
995
996 nlevels = SIZE(rs_grids)
997 cpassert(nlevels > 0)
998
999 ALLOCATE (grids_c(nlevels))
1000 ALLOCATE (npts_local(3, nlevels))
1001 DO ilevel = 1, nlevels
1002 associate(rsgrid => rs_grids(ilevel))
1003 npts_local(:, ilevel) = rsgrid%ub_local - rsgrid%lb_local + 1
1004 grids_c(ilevel) = rsgrid%buffer%c_ptr
1005 END associate
1006 END DO
1007
1008#if __GNUC__ >= 9
1009 cpassert(is_contiguous(npts_local))
1010 cpassert(is_contiguous(grids_c))
1011#endif
1012
1013 cpassert(c_associated(task_list%c_ptr))
1014 cpassert(c_associated(pab_blocks%c_ptr))
1015
1016 CALL grid_collocate_task_list_c(task_list=task_list%c_ptr, &
1017 func=ga_gb_function, &
1018 nlevels=nlevels, &
1019 npts_local=c_loc(npts_local(1, 1)), &
1020 pab_blocks=pab_blocks%c_ptr, &
1021 grids=c_loc(grids_c(1)))
1022
1023 CALL timestop(handle)
1024 END SUBROUTINE grid_collocate_task_list
1025
1026! **************************************************************************************************
1027!> \brief Integrate all tasks of in given list from given grids.
1028!> \param task_list ...
1029!> \param compute_tau ...
1030!> \param calculate_forces ...
1031!> \param calculate_virial ...
1032!> \param pab_blocks ...
1033!> \param rs_grids ...
1034!> \param hab_blocks ...
1035!> \param forces ...
1036!> \param virial ...
1037!> \author Ole Schuett
1038! **************************************************************************************************
1039 SUBROUTINE grid_integrate_task_list(task_list, compute_tau, calculate_forces, calculate_virial, &
1040 pab_blocks, rs_grids, hab_blocks, forces, virial)
1041 TYPE(grid_task_list_type), INTENT(IN) :: task_list
1042 LOGICAL, INTENT(IN) :: compute_tau, calculate_forces, &
1043 calculate_virial
1044 TYPE(offload_buffer_type), INTENT(IN) :: pab_blocks
1045 TYPE(realspace_grid_type), DIMENSION(:), &
1046 INTENT(IN) :: rs_grids
1047 TYPE(offload_buffer_type), INTENT(INOUT) :: hab_blocks
1048 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT), &
1049 TARGET :: forces
1050 REAL(kind=dp), DIMENSION(3, 3), INTENT(INOUT), &
1051 TARGET :: virial
1052
1053 CHARACTER(LEN=*), PARAMETER :: routinen = 'grid_integrate_task_list'
1054
1055 INTEGER :: handle, ilevel, nlevels
1056 INTEGER, ALLOCATABLE, DIMENSION(:, :), TARGET :: npts_local
1057 TYPE(c_ptr) :: forces_c, virial_c
1058 TYPE(c_ptr), ALLOCATABLE, DIMENSION(:), TARGET :: grids_c
1059 INTERFACE
1060 SUBROUTINE grid_integrate_task_list_c(task_list, compute_tau, natoms, &
1061 nlevels, npts_local, &
1062 pab_blocks, grids, hab_blocks, forces, virial) &
1063 BIND(C, name="grid_integrate_task_list")
1064 IMPORT :: c_ptr, c_int, c_bool
1065 TYPE(c_ptr), VALUE :: task_list
1066 LOGICAL(KIND=C_BOOL), VALUE :: compute_tau
1067 INTEGER(KIND=C_INT), VALUE :: natoms
1068 INTEGER(KIND=C_INT), VALUE :: nlevels
1069 TYPE(c_ptr), VALUE :: npts_local
1070 TYPE(c_ptr), VALUE :: pab_blocks
1071 TYPE(c_ptr), VALUE :: grids
1072 TYPE(c_ptr), VALUE :: hab_blocks
1073 TYPE(c_ptr), VALUE :: forces
1074 TYPE(c_ptr), VALUE :: virial
1075 END SUBROUTINE grid_integrate_task_list_c
1076 END INTERFACE
1077
1078 CALL timeset(routinen, handle)
1079
1080 nlevels = SIZE(rs_grids)
1081 cpassert(nlevels > 0)
1082
1083 ALLOCATE (grids_c(nlevels))
1084 ALLOCATE (npts_local(3, nlevels))
1085 DO ilevel = 1, nlevels
1086 associate(rsgrid => rs_grids(ilevel))
1087 npts_local(:, ilevel) = rsgrid%ub_local - rsgrid%lb_local + 1
1088 grids_c(ilevel) = rsgrid%buffer%c_ptr
1089 END associate
1090 END DO
1091
1092 IF (calculate_forces) THEN
1093 forces_c = c_loc(forces(1, 1))
1094 ELSE
1095 forces_c = c_null_ptr
1096 END IF
1097
1098 IF (calculate_virial) THEN
1099 virial_c = c_loc(virial(1, 1))
1100 ELSE
1101 virial_c = c_null_ptr
1102 END IF
1103
1104#if __GNUC__ >= 9
1105 cpassert(is_contiguous(npts_local))
1106 cpassert(is_contiguous(grids_c))
1107 cpassert(is_contiguous(forces))
1108 cpassert(is_contiguous(virial))
1109#endif
1110
1111 cpassert(SIZE(forces, 1) == 3)
1112 cpassert(c_associated(task_list%c_ptr))
1113 cpassert(c_associated(hab_blocks%c_ptr))
1114 cpassert(c_associated(pab_blocks%c_ptr) .OR. .NOT. calculate_forces)
1115 cpassert(c_associated(pab_blocks%c_ptr) .OR. .NOT. calculate_virial)
1116
1117 CALL grid_integrate_task_list_c(task_list=task_list%c_ptr, &
1118 compute_tau=LOGICAL(compute_tau, C_BOOL), &
1119 natoms=size(forces, 2), &
1120 nlevels=nlevels, &
1121 npts_local=c_loc(npts_local(1, 1)), &
1122 pab_blocks=pab_blocks%c_ptr, &
1123 grids=c_loc(grids_c(1)), &
1124 hab_blocks=hab_blocks%c_ptr, &
1125 forces=forces_c, &
1126 virial=virial_c)
1127
1128 CALL timestop(handle)
1129 END SUBROUTINE grid_integrate_task_list
1130
1131! **************************************************************************************************
1132!> \brief Initialize grid library
1133!> \author Ole Schuett
1134! **************************************************************************************************
1135 SUBROUTINE grid_library_init()
1136 INTERFACE
1137 SUBROUTINE grid_library_init_c() BIND(C, name="grid_library_init")
1138 END SUBROUTINE grid_library_init_c
1139 END INTERFACE
1140
1141 CALL grid_library_init_c()
1142
1143 END SUBROUTINE grid_library_init
1144
1145! **************************************************************************************************
1146!> \brief Finalize grid library
1147!> \author Ole Schuett
1148! **************************************************************************************************
1149 SUBROUTINE grid_library_finalize()
1150 INTERFACE
1151 SUBROUTINE grid_library_finalize_c() BIND(C, name="grid_library_finalize")
1152 END SUBROUTINE grid_library_finalize_c
1153 END INTERFACE
1154
1155 CALL grid_library_finalize_c()
1156
1157 END SUBROUTINE grid_library_finalize
1158
1159! **************************************************************************************************
1160!> \brief Configures the grid library
1161!> \param backend : backend to be used for collocate/integrate, possible values are REF, CPU, GPU
1162!> \param validate : if set to true, compare the results of all backend to the reference backend
1163!> \param apply_cutoff : apply a spherical cutoff before collocating or integrating. Only relevant for CPU backend
1164!> \author Ole Schuett
1165! **************************************************************************************************
1166 SUBROUTINE grid_library_set_config(backend, validate, apply_cutoff)
1167 INTEGER, INTENT(IN) :: backend
1168 LOGICAL, INTENT(IN) :: validate, apply_cutoff
1169
1170 INTERFACE
1171 SUBROUTINE grid_library_set_config_c(backend, validate, apply_cutoff) &
1172 BIND(C, name="grid_library_set_config")
1173 IMPORT :: c_int, c_bool
1174 INTEGER(KIND=C_INT), VALUE :: backend
1175 LOGICAL(KIND=C_BOOL), VALUE :: validate
1176 LOGICAL(KIND=C_BOOL), VALUE :: apply_cutoff
1177 END SUBROUTINE grid_library_set_config_c
1178 END INTERFACE
1179
1180 CALL grid_library_set_config_c(backend=backend, &
1181 validate=LOGICAL(validate, C_BOOL), &
1182 apply_cutoff=logical(apply_cutoff, c_bool))
1183
1184 END SUBROUTINE grid_library_set_config
1185
1186! **************************************************************************************************
1187!> \brief Print grid library statistics
1188!> \param mpi_comm ...
1189!> \param output_unit ...
1190!> \author Ole Schuett
1191! **************************************************************************************************
1192 SUBROUTINE grid_library_print_stats(mpi_comm, output_unit)
1193 TYPE(mp_comm_type) :: mpi_comm
1194 INTEGER, INTENT(IN) :: output_unit
1195
1196 INTERFACE
1197 SUBROUTINE grid_library_print_stats_c(mpi_comm, print_func, output_unit) &
1198 BIND(C, name="grid_library_print_stats")
1199 IMPORT :: c_funptr, c_int
1200 INTEGER(KIND=C_INT), VALUE :: mpi_comm
1201 TYPE(c_funptr), VALUE :: print_func
1202 INTEGER(KIND=C_INT), VALUE :: output_unit
1203 END SUBROUTINE grid_library_print_stats_c
1204 END INTERFACE
1205
1206 ! Since Fortran units and mpi groups can't be used from C, we pass function pointers instead.
1207 CALL grid_library_print_stats_c(mpi_comm=mpi_comm%get_handle(), &
1208 print_func=c_funloc(print_func), &
1209 output_unit=output_unit)
1210
1211 END SUBROUTINE grid_library_print_stats
1212
1213! **************************************************************************************************
1214!> \brief Callback to write to a Fortran output unit (called by C-side).
1215!> \param msg to be printed.
1216!> \param msglen number of characters excluding the terminating character.
1217!> \param output_unit used for output.
1218!> \author Ole Schuett and Hans Pabst
1219! **************************************************************************************************
1220 SUBROUTINE print_func(msg, msglen, output_unit) BIND(C, name="grid_api_print_func")
1221 CHARACTER(KIND=C_CHAR), INTENT(IN) :: msg(*)
1222 INTEGER(KIND=C_INT), INTENT(IN), VALUE :: msglen, output_unit
1223
1224 IF (output_unit <= 0) RETURN ! Omit to print the message.
1225 WRITE (output_unit, fmt="(100A)", advance="NO") msg(1:msglen)
1226 END SUBROUTINE print_func
1227END 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:969
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:936
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:727
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:1041
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:161
offload_api::offload_buffer_type
Definition offload_api.F:35
realspace_grid_types::realspace_grid_type
Definition realspace_grid_types.F:136