23 dbt_distribution_destroy,&
24 dbt_distribution_new,&
25 dbt_distribution_type,&
26 dbt_mp_environ_pgrid,&
39#include "./base/base_uses.f90"
45 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_tensors_types'
60 LOGICAL :: owns_comm = .false.
67 LOGICAL :: owns_dist = .false.
73 INTEGER :: iter_level = 0
75 INTEGER,
DIMENSION(2) :: bounds_i = 0, bounds_j = 0, bounds_k = 0
92 INTEGER,
DIMENSION(:),
INTENT(IN) :: dist1, dist2, dist3
93 INTEGER,
INTENT(IN) :: nkind
96 LOGICAL,
INTENT(IN),
OPTIONAL :: own_comm
98 CHARACTER(len=*),
PARAMETER :: routinen =
'distribution_3d_create'
101 INTEGER,
DIMENSION(2) :: mp_coor_1, mp_coor_2
104 CALL timeset(routinen, handle)
106 IF (
PRESENT(own_comm))
THEN
107 IF (own_comm) dist_3d%comm_3d = mp_comm_3d
108 dist_3d%owns_comm = own_comm
110 dist_3d%owns_comm = .false.
113 CALL comm_2d_1%from_sub(mp_comm_3d, [.true., .true., .false.])
114 CALL comm_2d_2%from_sub(mp_comm_3d, [.false., .true., .true.])
116 mp_coor_1 = comm_2d_1%mepos_cart
117 mp_coor_2 = comm_2d_2%mepos_cart
119 cpassert(mp_coor_1(2) == mp_coor_2(1))
124 dist_3d%comm_2d_1 = comm_2d_1
125 dist_3d%comm_2d_2 = comm_2d_2
127 CALL timestop(handle)
137 CHARACTER(len=*),
PARAMETER :: routinen =
'distribution_3d_destroy'
141 CALL timeset(routinen, handle)
144 CALL dist%comm_2d_1%free()
145 CALL dist%comm_2d_2%free()
146 IF (dist%owns_comm)
CALL dist%comm_3d%free()
148 NULLIFY (dist%dist_2d_1, dist%dist_2d_2)
150 CALL timestop(handle)
166 INTEGER,
DIMENSION(:),
INTENT(IN) :: dist1, dist2
167 INTEGER,
INTENT(IN) :: nkind
172 CHARACTER(len=*),
PARAMETER :: routinen =
'distribution_2d_create'
174 INTEGER :: handle, iatom, ikind, n, natom
175 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: nparticle_local_col, nparticle_local_row
176 INTEGER,
DIMENSION(2) :: mp_coor, mp_dims
177 INTEGER,
DIMENSION(:, :),
POINTER :: dist1_prv, dist2_prv
178 TYPE(
cp_1d_i_p_type),
DIMENSION(:),
POINTER :: local_particle_col, local_particle_row
182 NULLIFY (blacs_env, local_particle_col, local_particle_row, para_env)
184 CALL timeset(routinen, handle)
186 cpassert(
PRESENT(mp_comm_2d) .OR.
PRESENT(blacs_env_ext))
188 IF (
PRESENT(mp_comm_2d))
THEN
189 mp_dims = mp_comm_2d%num_pe_cart
190 mp_coor = mp_comm_2d%mepos_cart
192 para_env = mp_comm_2d
196 cpassert(blacs_env%mepos(1) == mp_coor(1))
197 cpassert(blacs_env%mepos(2) == mp_coor(2))
201 IF (
PRESENT(blacs_env_ext))
THEN
202 blacs_env => blacs_env_ext
203 mp_coor(1) = blacs_env%mepos(1)
204 mp_coor(2) = blacs_env%mepos(2)
207 natom =
SIZE(particle_set)
208 ALLOCATE (dist1_prv(natom, 2), dist2_prv(natom, 2))
209 dist1_prv(:, 1) = dist1
210 dist2_prv(:, 1) = dist2
212 ALLOCATE (local_particle_col(nkind), local_particle_row(nkind))
213 ALLOCATE (nparticle_local_row(nkind), nparticle_local_col(nkind))
214 nparticle_local_row = 0; nparticle_local_col = 0
217 ikind = particle_set(iatom)%atomic_kind%kind_number
219 IF (dist1_prv(iatom, 1) == mp_coor(1)) nparticle_local_row(ikind) = nparticle_local_row(ikind) + 1
220 IF (dist2_prv(iatom, 1) == mp_coor(2)) nparticle_local_col(ikind) = nparticle_local_col(ikind) + 1
224 n = nparticle_local_row(ikind)
225 ALLOCATE (local_particle_row(ikind)%array(n))
227 n = nparticle_local_col(ikind)
228 ALLOCATE (local_particle_col(ikind)%array(n))
231 nparticle_local_row = 0; nparticle_local_col = 0
233 ikind = particle_set(iatom)%atomic_kind%kind_number
235 IF (dist1_prv(iatom, 1) == mp_coor(1))
THEN
236 nparticle_local_row(ikind) = nparticle_local_row(ikind) + 1
237 local_particle_row(ikind)%array(nparticle_local_row(ikind)) = iatom
239 IF (dist2_prv(iatom, 1) == mp_coor(2))
THEN
240 nparticle_local_col(ikind) = nparticle_local_col(ikind) + 1
241 local_particle_col(ikind)%array(nparticle_local_col(ikind)) = iatom
245 CALL distribution_2d_create_prv(dist_2d, row_distribution_ptr=dist1_prv, &
246 col_distribution_ptr=dist2_prv, local_rows_ptr=local_particle_row, &
247 local_cols_ptr=local_particle_col, blacs_env=blacs_env)
249 IF (.NOT.
PRESENT(blacs_env_ext))
THEN
253 CALL timestop(handle)
266 INTEGER,
INTENT(IN) :: nel
267 INTEGER,
INTENT(INOUT) :: nbin
268 INTEGER,
DIMENSION(nel),
INTENT(IN) :: weights
269 INTEGER,
ALLOCATABLE,
DIMENSION(:),
INTENT(OUT), &
270 OPTIONAL :: limits_start, limits_end
271 INTEGER,
DIMENSION(nel),
INTENT(OUT),
OPTIONAL :: dist
273 INTEGER :: el_end, el_start, end_weight, ibin, &
274 nel_div, nel_rem, nel_split, nel_w, &
276 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: lim_e, lim_s
278 ALLOCATE (lim_s(nbin), lim_e(nbin))
283 nel_rem = mod(nel_w, nbin)
290 IF (ibin <= nel_rem)
THEN
291 nel_split = nel_split + 1
293 el_start = el_end + 1
295 w_partialsum = w_partialsum + weights(el_end)
296 end_weight = end_weight + nel_split
297 DO WHILE (w_partialsum < end_weight)
300 w_partialsum = w_partialsum + weights(el_end)
301 IF (el_end == nel)
EXIT
304 IF (
PRESENT(dist)) dist(el_start:el_end) = ibin - 1
305 lim_s(ibin) = el_start
308 IF (el_end == nel)
EXIT
311 IF (
PRESENT(limits_start) .AND.
PRESENT(limits_end))
THEN
312 ALLOCATE (limits_start(ibin)); limits_start(:ibin) = lim_s(:ibin)
313 ALLOCATE (limits_end(ibin)); limits_end(:ibin) = lim_e(:ibin)
334 SUBROUTINE create_3c_tensor(t3c, dist_1, dist_2, dist_3, pgrid, sizes_1, sizes_2, sizes_3, map1, map2, name)
335 TYPE(dbt_type),
INTENT(OUT) :: t3c
336 INTEGER,
ALLOCATABLE,
DIMENSION(:),
INTENT(OUT) :: dist_1, dist_2, dist_3
337 TYPE(dbt_pgrid_type),
INTENT(IN) :: pgrid
338 INTEGER,
DIMENSION(:),
INTENT(IN) :: sizes_1, sizes_2, sizes_3, map1, map2
339 CHARACTER(len=*),
INTENT(IN) :: name
341 CHARACTER(len=*),
PARAMETER :: routinen =
'create_3c_tensor'
343 INTEGER :: handle, size_1, size_2, size_3
344 INTEGER,
DIMENSION(3) :: pcoord, pdims
345 TYPE(dbt_distribution_type) :: dist
347 CALL timeset(routinen, handle)
349 CALL dbt_mp_environ_pgrid(pgrid, pdims, pcoord)
351 size_1 =
SIZE(sizes_1)
352 size_2 =
SIZE(sizes_2)
353 size_3 =
SIZE(sizes_3)
355 ALLOCATE (dist_1(size_1))
356 ALLOCATE (dist_2(size_2))
357 ALLOCATE (dist_3(size_3))
359 CALL dbt_default_distvec(size_1, pdims(1), sizes_1, dist_1)
360 CALL dbt_default_distvec(size_2, pdims(2), sizes_2, dist_2)
361 CALL dbt_default_distvec(size_3, pdims(3), sizes_3, dist_3)
363 CALL dbt_distribution_new(dist, pgrid, dist_1, dist_2, dist_3)
364 CALL dbt_create(t3c, name, dist, map1, map2, sizes_1, sizes_2, sizes_3)
365 CALL dbt_distribution_destroy(dist)
367 CALL timestop(handle)
382 TYPE(dbt_type),
INTENT(OUT) :: t2c
383 INTEGER,
ALLOCATABLE,
DIMENSION(:),
INTENT(OUT) :: dist_1, dist_2
384 TYPE(dbt_pgrid_type),
INTENT(IN) :: pgrid
385 INTEGER,
DIMENSION(:),
INTENT(IN) :: sizes_1, sizes_2
386 INTEGER,
DIMENSION(:),
INTENT(IN),
OPTIONAL :: order
387 CHARACTER(len=*),
INTENT(IN) :: name
389 CHARACTER(len=*),
PARAMETER :: routinen =
'create_2c_tensor'
391 INTEGER :: handle, size_1, size_2
392 INTEGER,
DIMENSION(2) :: order_in, pcoord, pdims
393 TYPE(dbt_distribution_type) :: dist
395 CALL timeset(routinen, handle)
397 IF (
PRESENT(order))
THEN
403 CALL dbt_mp_environ_pgrid(pgrid, pdims, pcoord)
405 size_1 =
SIZE(sizes_1)
406 size_2 =
SIZE(sizes_2)
408 ALLOCATE (dist_1(size_1))
409 ALLOCATE (dist_2(size_2))
411 CALL dbt_default_distvec(size_1, pdims(1), sizes_1, dist_1)
412 CALL dbt_default_distvec(size_2, pdims(2), sizes_2, dist_2)
414 CALL dbt_distribution_new(dist, pgrid, dist_1, dist_2)
415 CALL dbt_create(t2c, name, dist, [order_in(1)], [order_in(2)], sizes_1, sizes_2)
416 CALL dbt_distribution_destroy(dist)
418 CALL timestop(handle)
428 INTEGER,
DIMENSION(:),
INTENT(IN) :: blk_sizes
429 INTEGER,
ALLOCATABLE,
DIMENSION(:),
INTENT(OUT) :: blk_sizes_split
430 INTEGER,
INTENT(IN) :: max_size
432 INTEGER :: blk_remainder, i, isplit, isplit_sum, &
436 DO i = 1,
SIZE(blk_sizes)
437 nsplit = (blk_sizes(i) + max_size - 1)/max_size
438 isplit_sum = isplit_sum + nsplit
441 ALLOCATE (blk_sizes_split(isplit_sum))
444 DO i = 1,
SIZE(blk_sizes)
445 nsplit = (blk_sizes(i) + max_size - 1)/max_size
446 blk_remainder = blk_sizes(i)
447 DO isplit = 1, nsplit
448 isplit_sum = isplit_sum + 1
449 blk_sizes_split(isplit_sum) = min(max_size, blk_remainder)
450 blk_remainder = blk_remainder - max_size
467 INTEGER,
INTENT(IN) :: min_blk_size
468 INTEGER,
ALLOCATABLE,
DIMENSION(:),
INTENT(OUT) :: pgf_blk_sizes
470 INTEGER :: blk_count, blk_count_prev, blk_size, &
471 iatom, ikind, iset, natom, nblk, nset
472 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: kind_of, pgf_blk_sizes_tmp
473 INTEGER,
DIMENSION(:),
POINTER :: nsgf_set
479 ikind = kind_of(iatom)
484 ALLOCATE (pgf_blk_sizes_tmp(nblk)); pgf_blk_sizes_tmp = 0
489 blk_count_prev = blk_count
490 ikind = kind_of(iatom)
493 blk_size = blk_size + nsgf_set(iset)
494 IF (blk_size >= min_blk_size)
THEN
495 blk_count = blk_count + 1
496 pgf_blk_sizes_tmp(blk_count) = pgf_blk_sizes_tmp(blk_count) + blk_size
500 IF (blk_size > 0)
THEN
501 IF (blk_count == blk_count_prev) blk_count = blk_count + 1
502 pgf_blk_sizes_tmp(blk_count) = pgf_blk_sizes_tmp(blk_count) + blk_size
507 ALLOCATE (pgf_blk_sizes(blk_count))
508 pgf_blk_sizes(:) = pgf_blk_sizes_tmp(:blk_count)
521 starts_array_block, ends_array_block)
522 INTEGER,
DIMENSION(:),
INTENT(IN) :: sizes
523 INTEGER,
INTENT(INOUT) :: nbatches
524 INTEGER,
ALLOCATABLE,
DIMENSION(:),
INTENT(OUT) :: starts_array, ends_array, &
525 starts_array_block, ends_array_block
527 INTEGER :: bsum, imem, nblocks
529 nblocks =
SIZE(sizes)
531 CALL contiguous_tensor_dist(nblocks, nbatches, sizes, limits_start=starts_array_block, limits_end=ends_array_block)
533 ALLOCATE (starts_array(nbatches))
534 ALLOCATE (ends_array(nbatches))
537 DO imem = 1, nbatches
538 starts_array(imem) = bsum + 1
539 bsum = bsum + sum(sizes(starts_array_block(imem):ends_array_block(imem)))
540 ends_array(imem) = bsum
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum)
...
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
methods related to the blacs parallel environment
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
subroutine, public cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
allocates and initializes a type that represent a blacs context
This is the start of a dbt_api, all publically needed functions are exported here....
stores a mapping of 2D info (e.g. matrix) on a 2D processor distribution (i.e. blacs grid) where cpus...
subroutine, public distribution_2d_create(distribution_2d, blacs_env, local_rows_ptr, n_local_rows, local_cols_ptr, row_distribution_ptr, col_distribution_ptr, n_local_cols, n_row_distribution, n_col_distribution)
initializes the distribution_2d
subroutine, public distribution_2d_release(distribution_2d)
...
Interface to the message passing library MPI.
subroutine, public mp_para_env_release(para_env)
releases the para object (to be called when you don't want anymore the shared copy of this object)
Define the data structure for the particle information.
Define the neighbor list data types and the corresponding functionality.
Utility methods to build 3-center integral tensors of various types.
integer, parameter, public symmetrik_ik
subroutine, public distribution_3d_create(dist_3d, dist1, dist2, dist3, nkind, particle_set, mp_comm_3d, own_comm)
Create a 3d distribution.
integer, parameter, public default_block_size
integer, parameter, public symmetric_jk
integer, parameter, public symmetric_ijk
subroutine, public contiguous_tensor_dist(nel, nbin, weights, limits_start, limits_end, dist)
contiguous distribution of weighted elements
subroutine, public create_2c_tensor(t2c, dist_1, dist_2, pgrid, sizes_1, sizes_2, order, name)
...
subroutine, public split_block_sizes(blk_sizes, blk_sizes_split, max_size)
...
subroutine, public pgf_block_sizes(atomic_kind_set, basis, min_blk_size, pgf_blk_sizes)
...
integer, parameter, public symmetric_ij
integer, parameter, public symmetric_none
subroutine, public distribution_3d_destroy(dist)
Destroy a 3d distribution.
subroutine, public create_tensor_batches(sizes, nbatches, starts_array, ends_array, starts_array_block, ends_array_block)
...
subroutine, public create_3c_tensor(t3c, dist_1, dist_2, dist_3, pgrid, sizes_1, sizes_2, sizes_3, map1, map2, name)
...
Provides all information about an atomic kind.
represent a pointer to a 1d array
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
distributes pairs on a 2d grid of processors
stores all the informations relevant to an mpi environment