Line data Source code
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: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Define the neighbor list data types and the corresponding functionality
10 : ! **************************************************************************************************
11 : MODULE fist_neighbor_list_types
12 :
13 : USE cell_types, ONLY: cell_type,&
14 : pbc
15 : USE exclusion_types, ONLY: exclusion_type
16 : USE kinds, ONLY: dp
17 : USE memory_utilities, ONLY: reallocate
18 : #include "./base/base_uses.f90"
19 :
20 : IMPLICIT NONE
21 :
22 : PRIVATE
23 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fist_neighbor_list_types'
24 :
25 : ! **************************************************************************************************
26 : TYPE neighbor_kind_pairs_type
27 : INTEGER, POINTER, DIMENSION(:, :) :: list => NULL(), ij_kind => NULL()
28 : INTEGER, POINTER, DIMENSION(:) :: id_kind => NULL()
29 : INTEGER, POINTER, DIMENSION(:) :: grp_kind_start => NULL(), grp_kind_end => NULL()
30 : INTEGER :: cell_vector(3) = -1, npairs = -1
31 : INTEGER :: ngrp_kind = -1
32 : REAL(KIND=dp) :: rmax = 0.0_dp
33 : ! The *_scale arrays are scaling factors for the corresponding nonbonding
34 : ! interaction energies and forces for the pairs in 'list'. To keep the size
35 : ! of these arrays small, pairs whose interaction must be scaled are moved
36 : ! to beginning of the array 'list'. nscale is the number of elements in
37 : ! *_scale that are effectively used. This way one does not have to
38 : ! reallocate the *_scale arrays for every new scaled pair interaction.
39 : ! The field is_info is only used to switch between the regular nonbonded
40 : ! and the nonbonded14 splines for the van der waals interactions.
41 : REAL(KIND=dp), POINTER, DIMENSION(:) :: ei_scale => NULL()
42 : REAL(KIND=dp), POINTER, DIMENSION(:) :: vdw_scale => NULL()
43 : LOGICAL, POINTER, DIMENSION(:) :: is_onfo => NULL()
44 : INTEGER :: nscale = -1
45 : END TYPE neighbor_kind_pairs_type
46 :
47 : ! **************************************************************************************************
48 : TYPE fist_neighbor_type
49 : TYPE(neighbor_kind_pairs_type), DIMENSION(:), POINTER :: neighbor_kind_pairs => NULL()
50 : INTEGER :: nlists = -1
51 : END TYPE fist_neighbor_type
52 :
53 : PUBLIC :: neighbor_kind_pairs_type, &
54 : fist_neighbor_type, &
55 : fist_neighbor_init, &
56 : fist_neighbor_deallocate, &
57 : fist_neighbor_add
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief ...
63 : !> \param fist_neighbor ...
64 : !> \par History
65 : !> 08.2006 created [tlaino]
66 : !> \author Teodoro Laino
67 : ! **************************************************************************************************
68 12246 : SUBROUTINE fist_neighbor_deallocate(fist_neighbor)
69 : TYPE(fist_neighbor_type), POINTER :: fist_neighbor
70 :
71 : INTEGER :: i
72 :
73 12246 : IF (ASSOCIATED(fist_neighbor)) THEN
74 : ! deallocate neighbor_kind_pairs
75 12246 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs)) THEN
76 573402 : DO i = 1, SIZE(fist_neighbor%neighbor_kind_pairs)
77 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%list)) THEN
78 561156 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%list)
79 : END IF
80 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%id_kind)) THEN
81 968 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind)
82 : END IF
83 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ij_kind)) THEN
84 137335 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ij_kind)
85 : END IF
86 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)) THEN
87 137335 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)
88 : END IF
89 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)) THEN
90 137335 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
91 : END IF
92 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ei_scale)) THEN
93 560188 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale)
94 : END IF
95 561156 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)) THEN
96 560188 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)
97 : END IF
98 573402 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%is_onfo)) THEN
99 560188 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo)
100 : END IF
101 : END DO
102 12246 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs)
103 : END IF
104 12246 : DEALLOCATE (fist_neighbor)
105 : END IF
106 12246 : END SUBROUTINE fist_neighbor_deallocate
107 :
108 : ! **************************************************************************************************
109 : !> \brief ...
110 : !> \param fist_neighbor ...
111 : !> \param ncell ...
112 : !> \par History
113 : !> 08.2006 created [tlaino]
114 : !> \author Teodoro Laino
115 : ! **************************************************************************************************
116 20668 : SUBROUTINE fist_neighbor_init(fist_neighbor, ncell)
117 : TYPE(fist_neighbor_type), POINTER :: fist_neighbor
118 : INTEGER, INTENT(IN) :: ncell(3)
119 :
120 : CHARACTER(LEN=*), PARAMETER :: routineN = 'fist_neighbor_init'
121 :
122 : INTEGER :: handle, i, list_size, nlistmin
123 : TYPE(neighbor_kind_pairs_type), DIMENSION(:), &
124 20668 : POINTER :: new_pairs
125 :
126 20668 : CALL timeset(routineN, handle)
127 20668 : IF (.NOT. ASSOCIATED(fist_neighbor)) THEN
128 12246 : ALLOCATE (fist_neighbor)
129 : NULLIFY (fist_neighbor%neighbor_kind_pairs)
130 : END IF
131 :
132 82672 : nlistmin = (2*MAXVAL(ncell) + 1)**3
133 20668 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs)) THEN
134 8422 : IF (SIZE(fist_neighbor%neighbor_kind_pairs) < nlistmin) THEN
135 1732 : ALLOCATE (new_pairs(nlistmin))
136 744 : DO i = 1, SIZE(fist_neighbor%neighbor_kind_pairs)
137 740 : new_pairs(i)%list => fist_neighbor%neighbor_kind_pairs(i)%list
138 2220 : list_size = SIZE(new_pairs(i)%list)
139 1647 : ALLOCATE (new_pairs(i)%id_kind(list_size))
140 740 : ALLOCATE (new_pairs(i)%ei_scale(0))
141 740 : ALLOCATE (new_pairs(i)%vdw_scale(0))
142 740 : ALLOCATE (new_pairs(i)%is_onfo(0))
143 : NULLIFY (new_pairs(i)%ij_kind, &
144 740 : new_pairs(i)%grp_kind_start, &
145 740 : new_pairs(i)%grp_kind_end)
146 740 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ij_kind)) THEN
147 167 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ij_kind)
148 : END IF
149 740 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%id_kind)) THEN
150 0 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind)
151 : END IF
152 740 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)) THEN
153 167 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)
154 : END IF
155 740 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)) THEN
156 167 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
157 : END IF
158 740 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ei_scale)) THEN
159 740 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale)
160 : END IF
161 740 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)) THEN
162 740 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)
163 : END IF
164 744 : IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%is_onfo)) THEN
165 740 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo)
166 : END IF
167 : END DO
168 972 : DO i = SIZE(fist_neighbor%neighbor_kind_pairs) + 1, nlistmin
169 968 : ALLOCATE (new_pairs(i)%list(2, 0))
170 968 : ALLOCATE (new_pairs(i)%id_kind(0))
171 : NULLIFY (new_pairs(i)%ij_kind, &
172 968 : new_pairs(i)%grp_kind_start, &
173 968 : new_pairs(i)%grp_kind_end)
174 972 : NULLIFY (new_pairs(i)%ei_scale, new_pairs(i)%vdw_scale, new_pairs(i)%is_onfo)
175 : END DO
176 4 : DEALLOCATE (fist_neighbor%neighbor_kind_pairs)
177 4 : fist_neighbor%neighbor_kind_pairs => new_pairs
178 : ELSE
179 322440 : DO i = 1, SIZE(fist_neighbor%neighbor_kind_pairs)
180 942066 : list_size = SIZE(fist_neighbor%neighbor_kind_pairs(i)%list)
181 322440 : CALL reallocate(fist_neighbor%neighbor_kind_pairs(i)%id_kind, 1, list_size)
182 : END DO
183 : END IF
184 : ELSE
185 633664 : ALLOCATE (fist_neighbor%neighbor_kind_pairs(nlistmin))
186 572434 : DO i = 1, nlistmin
187 560188 : ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%list(2, 0))
188 560188 : ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind(0))
189 560188 : ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale(0))
190 560188 : ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale(0))
191 560188 : ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo(0))
192 : NULLIFY (fist_neighbor%neighbor_kind_pairs(i)%ij_kind, &
193 560188 : fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start, &
194 572434 : fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
195 : END DO
196 : END IF
197 :
198 20668 : fist_neighbor%nlists = nlistmin
199 889234 : DO i = 1, nlistmin
200 868566 : fist_neighbor%neighbor_kind_pairs(i)%npairs = 0
201 207378960 : fist_neighbor%neighbor_kind_pairs(i)%list = HUGE(0)
202 138542162 : fist_neighbor%neighbor_kind_pairs(i)%id_kind = HUGE(0)
203 3474264 : fist_neighbor%neighbor_kind_pairs(i)%cell_vector = HUGE(0)
204 889234 : fist_neighbor%neighbor_kind_pairs(i)%nscale = 0
205 : END DO
206 20668 : CALL timestop(handle)
207 20668 : END SUBROUTINE fist_neighbor_init
208 :
209 : ! **************************************************************************************************
210 : !> \brief ...
211 : !> \param neighbor_kind_pair ...
212 : !> \param atom_a ...
213 : !> \param atom_b ...
214 : !> \param rab ...
215 : !> \param check_spline ...
216 : !> \param id_kind ...
217 : !> \param skip ...
218 : !> \param cell ...
219 : !> \param ei_scale14 ...
220 : !> \param vdw_scale14 ...
221 : !> \param exclusions ...
222 : !> \par History
223 : !> 08.2006 created [tlaino]
224 : !> \author Teodoro Laino
225 : ! **************************************************************************************************
226 150913526 : SUBROUTINE fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, &
227 : rab, check_spline, id_kind, skip, cell, &
228 150913526 : ei_scale14, vdw_scale14, exclusions)
229 : TYPE(neighbor_kind_pairs_type), POINTER :: neighbor_kind_pair
230 : INTEGER, INTENT(IN) :: atom_a, atom_b
231 : REAL(KIND=dp), DIMENSION(3) :: rab
232 : LOGICAL, INTENT(OUT) :: check_spline
233 : INTEGER, INTENT(IN) :: id_kind
234 : LOGICAL, INTENT(IN) :: skip
235 : TYPE(cell_type), POINTER :: cell
236 : REAL(KIND=dp), INTENT(IN) :: ei_scale14, vdw_scale14
237 : TYPE(exclusion_type), DIMENSION(:), OPTIONAL :: exclusions
238 :
239 : REAL(KIND=dp), PARAMETER :: eps_default = EPSILON(0.0_dp)*1.0E4_dp
240 :
241 : INTEGER :: new_npairs, npairs, nscale, old_npairs
242 150913526 : INTEGER, DIMENSION(:), POINTER :: new_id_kind
243 150913526 : INTEGER, DIMENSION(:, :), POINTER :: new_list
244 : LOGICAL :: ex_ei, ex_vdw, is_onfo
245 : REAL(KIND=dp), DIMENSION(3) :: rabc
246 :
247 150913526 : IF (.NOT. PRESENT(exclusions)) THEN
248 : ex_ei = .FALSE.
249 : ex_vdw = .FALSE.
250 : is_onfo = .FALSE.
251 : ELSE
252 598221744 : ex_ei = ANY(exclusions(atom_a)%list_exclude_ei == atom_b)
253 598221731 : ex_vdw = ANY(exclusions(atom_a)%list_exclude_vdw == atom_b)
254 278675180 : is_onfo = ANY(exclusions(atom_a)%list_onfo == atom_b)
255 143656425 : IF (ex_ei .OR. ex_vdw .OR. is_onfo) THEN
256 : ! Check if this pair could correspond to a local interaction (bond, bend,
257 : ! or torsion) to which the exclusion lists and 14 potentials apply.
258 : !
259 : ! rab is the relative vector that may include some cell vectors. rabc is
260 : ! the 'shortest' possible relative vector, i.e. cell vectors are
261 : ! subtracted. When they are not the same, rab corresponds to a non-local
262 : ! interaction and the exclusion lists do not apply.
263 4380285 : rabc = pbc(rab, cell)
264 6996128 : IF ((ANY(ABS(rab - rabc) > eps_default))) THEN
265 3590488 : ex_ei = .FALSE.
266 3590488 : ex_vdw = .FALSE.
267 3590488 : is_onfo = .FALSE.
268 : END IF
269 : END IF
270 : END IF
271 :
272 : ! The skip option is .TRUE. for QM-QM pairs in an QM/MM run. In case these
273 : ! interactions have an ex_ei option, we store it in the neighbor list to
274 : ! do a proper bonded correction for the ewald summation. If there is no
275 : ! exclusion, the pair can be neglected.
276 150913526 : IF (skip .AND. (.NOT. ex_ei)) THEN
277 : ! If the pair is not present, checking is obviously not need.
278 27161 : check_spline = .FALSE.
279 27161 : RETURN
280 : END IF
281 :
282 : ! The check_spline is set to .TRUE. when the van derwaals is not excluded.
283 : ! Electrostatic interactions do not matter here as they are not evaluated
284 : ! with splines.
285 150886365 : check_spline = (.NOT. ex_vdw)
286 :
287 : ! If both types of interactions are excluded, the corresponding potentials
288 : ! will never be evaluated. At first sight such a pair would not need to be
289 : ! added to the neighborlists at all. However, they are still needed for
290 : ! proper corrections on interactions between the screening charges of bonded
291 : ! atoms when the ewald summation is used for the electrostatic interactions.
292 :
293 : ! If an interaction is excluded or scaled, store scale. If the interaction
294 : ! is an onfo, also store that property.
295 150886365 : IF (ex_ei .OR. ex_vdw .OR. is_onfo) THEN
296 : ! Allocate more memory for the scalings if necessary.
297 788796 : nscale = neighbor_kind_pair%nscale
298 788796 : IF (nscale == SIZE(neighbor_kind_pair%ei_scale)) THEN
299 11160 : CALL reallocate(neighbor_kind_pair%ei_scale, 1, INT(5 + 1.2*nscale))
300 11160 : CALL reallocate(neighbor_kind_pair%vdw_scale, 1, INT(5 + 1.2*nscale))
301 11160 : CALL reallocate(neighbor_kind_pair%is_onfo, 1, INT(5 + 1.2*nscale))
302 : END IF
303 788796 : nscale = nscale + 1
304 788796 : IF (ex_ei) THEN
305 631270 : neighbor_kind_pair%ei_scale(nscale) = 0.0_dp
306 157526 : ELSE IF (is_onfo) THEN
307 156914 : neighbor_kind_pair%ei_scale(nscale) = ei_scale14
308 : ELSE
309 612 : neighbor_kind_pair%ei_scale(nscale) = 1.0_dp
310 : END IF
311 788796 : IF (ex_vdw) THEN
312 631268 : neighbor_kind_pair%vdw_scale(nscale) = 0.0_dp
313 157528 : ELSE IF (is_onfo) THEN
314 156914 : neighbor_kind_pair%vdw_scale(nscale) = vdw_scale14
315 : ELSE
316 614 : neighbor_kind_pair%vdw_scale(nscale) = 1.0_dp
317 : END IF
318 788796 : neighbor_kind_pair%is_onfo(nscale) = is_onfo
319 788796 : neighbor_kind_pair%nscale = nscale
320 : ELSE
321 : nscale = HUGE(0)
322 : END IF
323 :
324 : ! Allocate more memory for the pair list if necessary.
325 150886365 : old_npairs = SIZE(neighbor_kind_pair%list, 2)
326 150886365 : IF (old_npairs == neighbor_kind_pair%npairs) THEN
327 : ! just a choice that will also grow for zero size arrays:
328 537581 : new_npairs = INT(5 + 1.2*old_npairs)
329 : ! Pair Atoms Info
330 1612743 : ALLOCATE (new_list(2, new_npairs))
331 2911967171 : new_list(1:2, 1:old_npairs) = neighbor_kind_pair%list(1:2, 1:old_npairs)
332 537581 : DEALLOCATE (neighbor_kind_pair%list)
333 537581 : neighbor_kind_pair%list => new_list
334 : ! Kind Info
335 1612743 : ALLOCATE (new_id_kind(new_npairs))
336 971014111 : new_id_kind(1:old_npairs) = neighbor_kind_pair%id_kind(1:old_npairs)
337 537581 : DEALLOCATE (neighbor_kind_pair%id_kind)
338 537581 : neighbor_kind_pair%id_kind => new_id_kind
339 : END IF
340 :
341 : ! Store the pair ...
342 150886365 : npairs = neighbor_kind_pair%npairs + 1
343 150886365 : IF ((ex_ei .OR. ex_vdw .OR. is_onfo) .AND. (npairs > nscale)) THEN
344 : ! ... after the previous pair that had scaling factors.
345 761893 : neighbor_kind_pair%list(1, npairs) = neighbor_kind_pair%list(1, nscale)
346 761893 : neighbor_kind_pair%list(2, npairs) = neighbor_kind_pair%list(2, nscale)
347 761893 : neighbor_kind_pair%id_kind(npairs) = neighbor_kind_pair%id_kind(nscale)
348 761893 : neighbor_kind_pair%list(1, nscale) = atom_a
349 761893 : neighbor_kind_pair%list(2, nscale) = atom_b
350 761893 : neighbor_kind_pair%id_kind(nscale) = id_kind
351 : ELSE
352 : ! ... at the end of the list.
353 150124472 : neighbor_kind_pair%list(1, npairs) = atom_a
354 150124472 : neighbor_kind_pair%list(2, npairs) = atom_b
355 150124472 : neighbor_kind_pair%id_kind(npairs) = id_kind
356 : END IF
357 150886365 : neighbor_kind_pair%npairs = npairs
358 150913526 : END SUBROUTINE fist_neighbor_add
359 :
360 0 : END MODULE fist_neighbor_list_types
|
