73 IF (
ASSOCIATED(fist_neighbor))
THEN
75 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs))
THEN
76 DO i = 1,
SIZE(fist_neighbor%neighbor_kind_pairs)
77 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%list))
THEN
78 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%list)
80 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%id_kind))
THEN
81 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind)
83 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ij_kind))
THEN
84 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ij_kind)
86 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start))
THEN
87 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)
89 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end))
THEN
90 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
92 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ei_scale))
THEN
93 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale)
95 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%vdw_scale))
THEN
96 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)
98 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%is_onfo))
THEN
99 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo)
102 DEALLOCATE (fist_neighbor%neighbor_kind_pairs)
104 DEALLOCATE (fist_neighbor)
118 INTEGER,
INTENT(IN) :: ncell(3)
120 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fist_neighbor_init'
122 INTEGER :: handle, i, list_size, nlistmin
126 CALL timeset(routinen, handle)
127 IF (.NOT.
ASSOCIATED(fist_neighbor))
THEN
128 ALLOCATE (fist_neighbor)
129 NULLIFY (fist_neighbor%neighbor_kind_pairs)
132 nlistmin = (2*maxval(ncell) + 1)**3
133 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs))
THEN
134 IF (
SIZE(fist_neighbor%neighbor_kind_pairs) < nlistmin)
THEN
135 ALLOCATE (new_pairs(nlistmin))
136 DO i = 1,
SIZE(fist_neighbor%neighbor_kind_pairs)
137 new_pairs(i)%list => fist_neighbor%neighbor_kind_pairs(i)%list
138 list_size =
SIZE(new_pairs(i)%list)
139 ALLOCATE (new_pairs(i)%id_kind(list_size))
140 ALLOCATE (new_pairs(i)%ei_scale(0))
141 ALLOCATE (new_pairs(i)%vdw_scale(0))
142 ALLOCATE (new_pairs(i)%is_onfo(0))
143 NULLIFY (new_pairs(i)%ij_kind, &
144 new_pairs(i)%grp_kind_start, &
145 new_pairs(i)%grp_kind_end)
146 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ij_kind))
THEN
147 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ij_kind)
149 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%id_kind))
THEN
150 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind)
152 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start))
THEN
153 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start)
155 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end))
THEN
156 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
158 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%ei_scale))
THEN
159 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale)
161 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%vdw_scale))
THEN
162 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale)
164 IF (
ASSOCIATED(fist_neighbor%neighbor_kind_pairs(i)%is_onfo))
THEN
165 DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo)
168 DO i =
SIZE(fist_neighbor%neighbor_kind_pairs) + 1, nlistmin
169 ALLOCATE (new_pairs(i)%list(2, 0))
170 ALLOCATE (new_pairs(i)%id_kind(0))
171 NULLIFY (new_pairs(i)%ij_kind, &
172 new_pairs(i)%grp_kind_start, &
173 new_pairs(i)%grp_kind_end)
174 NULLIFY (new_pairs(i)%ei_scale, new_pairs(i)%vdw_scale, new_pairs(i)%is_onfo)
176 DEALLOCATE (fist_neighbor%neighbor_kind_pairs)
177 fist_neighbor%neighbor_kind_pairs => new_pairs
179 DO i = 1,
SIZE(fist_neighbor%neighbor_kind_pairs)
180 list_size =
SIZE(fist_neighbor%neighbor_kind_pairs(i)%list)
181 CALL reallocate(fist_neighbor%neighbor_kind_pairs(i)%id_kind, 1, list_size)
185 ALLOCATE (fist_neighbor%neighbor_kind_pairs(nlistmin))
187 ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%list(2, 0))
188 ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%id_kind(0))
189 ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%ei_scale(0))
190 ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%vdw_scale(0))
191 ALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo(0))
192 NULLIFY (fist_neighbor%neighbor_kind_pairs(i)%ij_kind, &
193 fist_neighbor%neighbor_kind_pairs(i)%grp_kind_start, &
194 fist_neighbor%neighbor_kind_pairs(i)%grp_kind_end)
198 fist_neighbor%nlists = nlistmin
200 fist_neighbor%neighbor_kind_pairs(i)%npairs = 0
201 fist_neighbor%neighbor_kind_pairs(i)%list = huge(0)
202 fist_neighbor%neighbor_kind_pairs(i)%id_kind = huge(0)
203 fist_neighbor%neighbor_kind_pairs(i)%cell_vector = huge(0)
204 fist_neighbor%neighbor_kind_pairs(i)%nscale = 0
206 CALL timestop(handle)
227 rab, check_spline, id_kind, skip, cell, &
228 ei_scale14, vdw_scale14, exclusions)
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
236 REAL(kind=
dp),
INTENT(IN) :: ei_scale14, vdw_scale14
239 REAL(kind=
dp),
PARAMETER :: eps_default = epsilon(0.0_dp)*1.0e4_dp
241 INTEGER :: new_npairs, npairs, nscale, old_npairs
242 INTEGER,
DIMENSION(:),
POINTER :: new_id_kind
243 INTEGER,
DIMENSION(:, :),
POINTER :: new_list
244 LOGICAL :: ex_ei, ex_vdw, is_onfo
245 REAL(kind=
dp),
DIMENSION(3) :: rabc
247 IF (.NOT.
PRESENT(exclusions))
THEN
252 ex_ei = any(exclusions(atom_a)%list_exclude_ei == atom_b)
253 ex_vdw = any(exclusions(atom_a)%list_exclude_vdw == atom_b)
254 is_onfo = any(exclusions(atom_a)%list_onfo == atom_b)
255 IF (ex_ei .OR. ex_vdw .OR. is_onfo)
THEN
263 rabc =
pbc(rab, cell)
264 IF ((any(abs(rab - rabc) > eps_default)))
THEN
276 IF (skip .AND. (.NOT. ex_ei))
THEN
278 check_spline = .false.
285 check_spline = (.NOT. ex_vdw)
295 IF (ex_ei .OR. ex_vdw .OR. is_onfo)
THEN
297 nscale = neighbor_kind_pair%nscale
298 IF (nscale ==
SIZE(neighbor_kind_pair%ei_scale))
THEN
299 CALL reallocate(neighbor_kind_pair%ei_scale, 1, int(5 + 1.2*nscale))
300 CALL reallocate(neighbor_kind_pair%vdw_scale, 1, int(5 + 1.2*nscale))
301 CALL reallocate(neighbor_kind_pair%is_onfo, 1, int(5 + 1.2*nscale))
305 neighbor_kind_pair%ei_scale(nscale) = 0.0_dp
306 ELSE IF (is_onfo)
THEN
307 neighbor_kind_pair%ei_scale(nscale) = ei_scale14
309 neighbor_kind_pair%ei_scale(nscale) = 1.0_dp
312 neighbor_kind_pair%vdw_scale(nscale) = 0.0_dp
313 ELSE IF (is_onfo)
THEN
314 neighbor_kind_pair%vdw_scale(nscale) = vdw_scale14
316 neighbor_kind_pair%vdw_scale(nscale) = 1.0_dp
318 neighbor_kind_pair%is_onfo(nscale) = is_onfo
319 neighbor_kind_pair%nscale = nscale
325 old_npairs =
SIZE(neighbor_kind_pair%list, 2)
326 IF (old_npairs == neighbor_kind_pair%npairs)
THEN
328 new_npairs = int(5 + 1.2*old_npairs)
330 ALLOCATE (new_list(2, new_npairs))
331 new_list(1:2, 1:old_npairs) = neighbor_kind_pair%list(1:2, 1:old_npairs)
332 DEALLOCATE (neighbor_kind_pair%list)
333 neighbor_kind_pair%list => new_list
335 ALLOCATE (new_id_kind(new_npairs))
336 new_id_kind(1:old_npairs) = neighbor_kind_pair%id_kind(1:old_npairs)
337 DEALLOCATE (neighbor_kind_pair%id_kind)
338 neighbor_kind_pair%id_kind => new_id_kind
342 npairs = neighbor_kind_pair%npairs + 1
343 IF ((ex_ei .OR. ex_vdw .OR. is_onfo) .AND. (npairs > nscale))
THEN
345 neighbor_kind_pair%list(1, npairs) = neighbor_kind_pair%list(1, nscale)
346 neighbor_kind_pair%list(2, npairs) = neighbor_kind_pair%list(2, nscale)
347 neighbor_kind_pair%id_kind(npairs) = neighbor_kind_pair%id_kind(nscale)
348 neighbor_kind_pair%list(1, nscale) = atom_a
349 neighbor_kind_pair%list(2, nscale) = atom_b
350 neighbor_kind_pair%id_kind(nscale) = id_kind
353 neighbor_kind_pair%list(1, npairs) = atom_a
354 neighbor_kind_pair%list(2, npairs) = atom_b
355 neighbor_kind_pair%id_kind(npairs) = id_kind
357 neighbor_kind_pair%npairs = npairs