69 INTEGER,
DIMENSION(:, :),
POINTER :: glob_loc_list
70 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: glob_cell_v
71 INTEGER,
DIMENSION(:),
POINTER :: glob_loc_list_a, unique_list_a
74 CHARACTER(LEN=*),
PARAMETER :: routinen =
'setup_allegro_arrays'
76 INTEGER :: handle, i, iend, igrp, ikind, ilist, &
77 ipair, istart, jkind, nkinds, nlocal, &
79 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: temp_unique_list_a, work_list, work_list2
80 INTEGER,
DIMENSION(:, :),
POINTER ::
list
81 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: rwork_list
82 REAL(kind=
dp),
DIMENSION(3) :: cell_v, cvi
86 cpassert(.NOT.
ASSOCIATED(glob_loc_list))
87 cpassert(.NOT.
ASSOCIATED(glob_loc_list_a))
88 cpassert(.NOT.
ASSOCIATED(unique_list_a))
89 cpassert(.NOT.
ASSOCIATED(glob_cell_v))
90 CALL timeset(routinen, handle)
92 nkinds =
SIZE(potparm%pot, 1)
93 DO ilist = 1, nonbonded%nlists
94 neighbor_kind_pair => nonbonded%neighbor_kind_pairs(ilist)
95 npairs = neighbor_kind_pair%npairs
96 IF (npairs == 0) cycle
97 kind_group_loop1:
DO igrp = 1, neighbor_kind_pair%ngrp_kind
98 istart = neighbor_kind_pair%grp_kind_start(igrp)
99 iend = neighbor_kind_pair%grp_kind_end(igrp)
100 ikind = neighbor_kind_pair%ij_kind(1, igrp)
101 jkind = neighbor_kind_pair%ij_kind(2, igrp)
102 pot => potparm%pot(ikind, jkind)%pot
103 npairs = iend - istart + 1
105 DO i = 1,
SIZE(pot%type)
106 IF (pot%type(i) ==
allegro_type) npairs_tot = npairs_tot + npairs
108 END DO kind_group_loop1
110 ALLOCATE (work_list(npairs_tot))
111 ALLOCATE (work_list2(npairs_tot))
112 ALLOCATE (glob_loc_list(2, npairs_tot))
113 ALLOCATE (glob_cell_v(3, npairs_tot))
116 DO ilist = 1, nonbonded%nlists
117 neighbor_kind_pair => nonbonded%neighbor_kind_pairs(ilist)
118 npairs = neighbor_kind_pair%npairs
119 IF (npairs == 0) cycle
120 kind_group_loop2:
DO igrp = 1, neighbor_kind_pair%ngrp_kind
121 istart = neighbor_kind_pair%grp_kind_start(igrp)
122 iend = neighbor_kind_pair%grp_kind_end(igrp)
123 ikind = neighbor_kind_pair%ij_kind(1, igrp)
124 jkind = neighbor_kind_pair%ij_kind(2, igrp)
125 list => neighbor_kind_pair%list
126 cvi = neighbor_kind_pair%cell_vector
127 pot => potparm%pot(ikind, jkind)%pot
128 npairs = iend - istart + 1
130 cell_v = matmul(cell%hmat, cvi)
131 DO i = 1,
SIZE(pot%type)
135 glob_loc_list(:, npairs_tot + ipair) =
list(:, istart - 1 + ipair)
136 glob_cell_v(1:3, npairs_tot + ipair) = cell_v(1:3)
138 npairs_tot = npairs_tot + npairs
141 END DO kind_group_loop2
144 CALL sort(glob_loc_list(1, :), npairs_tot, work_list)
145 DO ipair = 1, npairs_tot
146 work_list2(ipair) = glob_loc_list(2, work_list(ipair))
148 glob_loc_list(2, :) = work_list2
149 DEALLOCATE (work_list2)
150 ALLOCATE (rwork_list(3, npairs_tot))
151 DO ipair = 1, npairs_tot
152 rwork_list(:, ipair) = glob_cell_v(:, work_list(ipair))
154 glob_cell_v = rwork_list
155 DEALLOCATE (rwork_list)
156 DEALLOCATE (work_list)
157 ALLOCATE (glob_loc_list_a(npairs_tot))
158 glob_loc_list_a = glob_loc_list(1, :)
159 ALLOCATE (temp_unique_list_a(npairs_tot))
161 temp_unique_list_a(1) = glob_loc_list_a(1)
162 DO ipair = 2, npairs_tot
163 IF (glob_loc_list_a(ipair - 1) /= glob_loc_list_a(ipair))
THEN
165 temp_unique_list_a(nlocal) = glob_loc_list_a(ipair)
168 ALLOCATE (unique_list_a(nlocal))
169 unique_list_a(:) = temp_unique_list_a(:nlocal)
170 DEALLOCATE (temp_unique_list_a)
171 CALL timestop(handle)
222 potparm, allegro, glob_loc_list_a, r_last_update_pbc, &
223 pot_allegro, fist_nonbond_env, unique_list_a)
231 INTEGER,
DIMENSION(:),
POINTER :: glob_loc_list_a
232 TYPE(
pos_type),
DIMENSION(:),
POINTER :: r_last_update_pbc
233 REAL(kind=
dp) :: pot_allegro
235 INTEGER,
DIMENSION(:),
POINTER :: unique_list_a
237 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allegro_energy_store_force_virial'
239 INTEGER :: atom_a, atom_b, handle, i, iat, iat_use, iend, ifirst, igrp, ikind, ilast, ilist, &
240 ipair, istart, iunique, jkind, junique, mpair, n_atoms, n_atoms_use, nedges, nloc_size, &
242 INTEGER(kind=int_8),
ALLOCATABLE ::
atom_types(:), temp_atom_types(:)
243 INTEGER(kind=int_8),
ALLOCATABLE,
DIMENSION(:, :) :: edge_index, t_edge_index, temp_edge_index
244 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: work_list
245 INTEGER,
DIMENSION(:, :),
POINTER ::
list, sort_list
246 LOGICAL,
ALLOCATABLE :: use_atom(:)
247 REAL(kind=
dp) :: drij, lattice(3, 3), rab2_max, rij(3)
248 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: edge_cell_shifts, new_edge_cell_shifts, &
250 REAL(kind=
dp),
DIMENSION(3) :: cell_v, cvi
251 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: atomic_energy, forces
252 REAL(kind=
sp) :: lattice_sp(3, 3)
253 REAL(kind=
sp),
ALLOCATABLE,
DIMENSION(:, :) :: new_edge_cell_shifts_sp, pos_sp
254 REAL(kind=
sp),
DIMENSION(:, :),
POINTER :: atomic_energy_sp, forces_sp
260 CALL timeset(routinen, handle)
262 NULLIFY (atomic_energy, forces, atomic_energy_sp, forces_sp)
263 n_atoms =
SIZE(particle_set)
264 ALLOCATE (use_atom(n_atoms))
267 DO ikind = 1,
SIZE(atomic_kind_set)
268 DO jkind = 1,
SIZE(atomic_kind_set)
269 pot => potparm%pot(ikind, jkind)%pot
270 DO i = 1,
SIZE(pot%type)
273 IF (particle_set(iat)%atomic_kind%kind_number == ikind .OR. &
274 particle_set(iat)%atomic_kind%kind_number == jkind) use_atom(iat) = .true.
279 n_atoms_use = count(use_atom)
283 IF (.NOT.
ASSOCIATED(allegro_data))
THEN
284 ALLOCATE (allegro_data)
286 NULLIFY (allegro_data%use_indices, allegro_data%force)
287 CALL torch_model_load(allegro_data%model, pot%set(1)%allegro%allegro_file_name)
290 IF (
ASSOCIATED(allegro_data%force))
THEN
291 IF (
SIZE(allegro_data%force, 2) /= n_atoms_use)
THEN
292 DEALLOCATE (allegro_data%force, allegro_data%use_indices)
295 IF (.NOT.
ASSOCIATED(allegro_data%force))
THEN
296 ALLOCATE (allegro_data%force(3, n_atoms_use))
297 ALLOCATE (allegro_data%use_indices(n_atoms_use))
301 DO iat = 1, n_atoms_use
302 IF (use_atom(iat))
THEN
303 iat_use = iat_use + 1
304 allegro_data%use_indices(iat_use) = iat
310 ALLOCATE (edge_index(2,
SIZE(glob_loc_list_a)))
311 ALLOCATE (edge_cell_shifts(3,
SIZE(glob_loc_list_a)))
312 ALLOCATE (temp_atom_types(
SIZE(glob_loc_list_a)))
314 DO ilist = 1, nonbonded%nlists
315 neighbor_kind_pair => nonbonded%neighbor_kind_pairs(ilist)
316 npairs = neighbor_kind_pair%npairs
317 IF (npairs == 0) cycle
318 kind_group_loop_allegro:
DO igrp = 1, neighbor_kind_pair%ngrp_kind
319 istart = neighbor_kind_pair%grp_kind_start(igrp)
320 iend = neighbor_kind_pair%grp_kind_end(igrp)
321 ikind = neighbor_kind_pair%ij_kind(1, igrp)
322 jkind = neighbor_kind_pair%ij_kind(2, igrp)
323 list => neighbor_kind_pair%list
324 cvi = neighbor_kind_pair%cell_vector
325 pot => potparm%pot(ikind, jkind)%pot
326 DO i = 1,
SIZE(pot%type)
328 rab2_max = pot%set(i)%allegro%rcutsq
329 cell_v = matmul(cell%hmat, cvi)
330 pot => potparm%pot(ikind, jkind)%pot
331 allegro => pot%set(i)%allegro
332 npairs = iend - istart + 1
333 IF (npairs /= 0)
THEN
334 ALLOCATE (sort_list(2, npairs), work_list(npairs))
335 sort_list =
list(:, istart:iend)
338 CALL sort(sort_list(1, :), npairs, work_list)
340 work_list(ipair) = sort_list(2, work_list(ipair))
342 sort_list(2, :) = work_list
345 DO ipair = 1, npairs - 1
346 IF (sort_list(1, ipair + 1) /= sort_list(1, ipair)) nunique = nunique + 1
349 junique = sort_list(1, ipair)
351 DO iunique = 1, nunique
353 IF (glob_loc_list_a(ifirst) > atom_a) cycle
354 DO mpair = ifirst,
SIZE(glob_loc_list_a)
355 IF (glob_loc_list_a(mpair) == atom_a)
EXIT
358 DO mpair = ifirst,
SIZE(glob_loc_list_a)
359 IF (glob_loc_list_a(mpair) /= atom_a)
EXIT
363 IF (ifirst /= 0) nloc_size = ilast - ifirst + 1
364 DO WHILE (ipair <= npairs)
365 IF (sort_list(1, ipair) /= junique)
EXIT
366 atom_b = sort_list(2, ipair)
367 rij(:) = r_last_update_pbc(atom_b)%r(:) - r_last_update_pbc(atom_a)%r(:) + cell_v
368 drij = dot_product(rij, rij)
370 IF (drij <= rab2_max)
THEN
372 edge_index(:, nedges) = [atom_a - 1, atom_b - 1]
373 edge_cell_shifts(:, nedges) = cvi
377 IF (ipair <= npairs) junique = sort_list(1, ipair)
379 DEALLOCATE (sort_list, work_list)
382 END DO kind_group_loop_allegro
385 allegro => pot%set(1)%allegro
387 ALLOCATE (temp_edge_index(2, nedges))
388 temp_edge_index(:, :) = edge_index(:, :nedges)
389 ALLOCATE (new_edge_cell_shifts(3, nedges))
390 new_edge_cell_shifts(:, :) = edge_cell_shifts(:, :nedges)
391 DEALLOCATE (edge_cell_shifts)
393 ALLOCATE (t_edge_index(nedges, 2))
395 t_edge_index(:, :) = transpose(temp_edge_index)
396 DEALLOCATE (temp_edge_index, edge_index)
398 lattice = cell%hmat/pot%set(1)%allegro%unit_cell_val
399 lattice_sp = real(lattice, kind=
sp)
402 ALLOCATE (pos(3, n_atoms_use),
atom_types(n_atoms_use))
404 DO iat = 1, n_atoms_use
405 IF (.NOT. use_atom(iat)) cycle
406 iat_use = iat_use + 1
407 atom_types(iat_use) = particle_set(iat)%atomic_kind%kind_number - 1
408 pos(:, iat) = r_last_update_pbc(iat)%r(:)/allegro%unit_coords_val
413 IF (allegro%do_allegro_sp)
THEN
414 ALLOCATE (new_edge_cell_shifts_sp(3, nedges), pos_sp(3, n_atoms_use))
415 new_edge_cell_shifts_sp(:, :) = real(new_edge_cell_shifts(:, :), kind=
sp)
416 pos_sp(:, :) = real(pos(:, :), kind=
sp)
417 DEALLOCATE (pos, new_edge_cell_shifts)
434 IF (allegro%do_allegro_sp)
THEN
437 allegro_data%force(:, :) = real(forces_sp(:, :), kind=
dp)*allegro%unit_forces_val
438 DO iat_use = 1,
SIZE(unique_list_a)
439 i = unique_list_a(iat_use)
440 pot_allegro = pot_allegro + real(atomic_energy_sp(1, i), kind=
dp)*allegro%unit_energy_val
442 DEALLOCATE (forces_sp, atomic_energy_sp, new_edge_cell_shifts_sp, pos_sp)
446 allegro_data%force(:, :) = forces(:, :)*allegro%unit_forces_val
447 DO iat_use = 1,
SIZE(unique_list_a)
448 i = unique_list_a(iat_use)
449 pot_allegro = pot_allegro + atomic_energy(1, i)*allegro%unit_energy_val
451 DEALLOCATE (forces, atomic_energy, pos, new_edge_cell_shifts)
459 CALL timestop(handle)
subroutine, public fist_nonbond_env_get(fist_nonbond_env, potparm14, potparm, nonbonded, rlist_cut, rlist_lowsq, aup, lup, ei_scale14, vdw_scale14, shift_cutoff, do_electrostatics, r_last_update, r_last_update_pbc, rshell_last_update_pbc, rcore_last_update_pbc, cell_last_update, num_update, last_update, counter, natom_types, long_range_correction, ij_kind_full_fac, eam_data, quip_data, nequip_data, allegro_data, deepmd_data, charges)
sets a fist_nonbond_env
subroutine, public fist_nonbond_env_set(fist_nonbond_env, potparm14, potparm, rlist_cut, rlist_lowsq, nonbonded, aup, lup, ei_scale14, vdw_scale14, shift_cutoff, do_electrostatics, r_last_update, r_last_update_pbc, rshell_last_update_pbc, rcore_last_update_pbc, cell_last_update, num_update, last_update, counter, natom_types, long_range_correction, eam_data, quip_data, nequip_data, allegro_data, deepmd_data, charges)
sets a fist_nonbond_env
subroutine, public allegro_energy_store_force_virial(nonbonded, particle_set, cell, atomic_kind_set, potparm, allegro, glob_loc_list_a, r_last_update_pbc, pot_allegro, fist_nonbond_env, unique_list_a)
...