Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 : !> \par History
11 : !> - cleaned (23.07.2003,MK)
12 : !> - full refactoring, list iterators (20.10.2010, JGH)
13 : !> - add get_neighbor_list_set_p, return info for a set of neighborlists
14 : !> (07.2014,JGH)
15 : !> \author Matthias Krack (21.06.2000)
16 : ! **************************************************************************************************
17 : MODULE qs_neighbor_list_types
18 :
19 : USE kinds, ONLY: dp
20 : USE util, ONLY: locate,&
21 : sort
22 : #include "./base/base_uses.f90"
23 :
24 : IMPLICIT NONE
25 :
26 : PRIVATE
27 :
28 : ! *** Global parameters (in this module) ***
29 :
30 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_neighbor_list_types'
31 :
32 : ! *** Definition of the data types for a linked list of neighbors ***
33 :
34 : ! **************************************************************************************************
35 : TYPE neighbor_node_type
36 : PRIVATE
37 : TYPE(neighbor_node_type), POINTER :: next_neighbor_node
38 : REAL(dp), DIMENSION(3) :: r
39 : INTEGER, DIMENSION(3) :: cell
40 : INTEGER :: neighbor
41 : END TYPE neighbor_node_type
42 :
43 : ! **************************************************************************************************
44 : TYPE neighbor_list_type
45 : PRIVATE
46 : TYPE(neighbor_list_type), POINTER :: next_neighbor_list
47 : TYPE(neighbor_node_type), POINTER :: first_neighbor_node, &
48 : last_neighbor_node
49 : INTEGER :: atom, nnode
50 : END TYPE neighbor_list_type
51 :
52 : ! **************************************************************************************************
53 : TYPE neighbor_list_set_type
54 : PRIVATE
55 : TYPE(neighbor_list_type), POINTER :: first_neighbor_list, &
56 : last_neighbor_list
57 : INTEGER :: nlist
58 : LOGICAL :: symmetric
59 : END TYPE neighbor_list_set_type
60 :
61 : ! **************************************************************************************************
62 : TYPE neighbor_list_p_type
63 : TYPE(neighbor_list_type), POINTER :: neighbor_list
64 : END TYPE neighbor_list_p_type
65 :
66 : ! **************************************************************************************************
67 : TYPE neighbor_list_set_p_type
68 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
69 : INTEGER :: nl_size
70 : INTEGER :: nl_start
71 : INTEGER :: nl_end
72 : TYPE(neighbor_list_task_type), DIMENSION(:), POINTER :: nlist_task
73 : END TYPE neighbor_list_set_p_type
74 :
75 : ! **************************************************************************************************
76 : TYPE list_search_type
77 : PRIVATE
78 : INTEGER :: nlist
79 : INTEGER, DIMENSION(:), POINTER :: atom_list
80 : INTEGER, DIMENSION(:), POINTER :: atom_index
81 : TYPE(neighbor_list_p_type), &
82 : DIMENSION(:), POINTER :: neighbor_list
83 : END TYPE list_search_type
84 :
85 : ! **************************************************************************************************
86 : TYPE neighbor_list_task_type
87 : INTEGER :: iatom, jatom, &
88 : ikind, jkind, nkind, &
89 : ilist, nlist, inode, nnode
90 : REAL(KIND=dp), DIMENSION(3) :: r
91 : INTEGER, DIMENSION(3) :: cell
92 : TYPE(neighbor_list_task_type), &
93 : POINTER :: next ! Pointer for forming a linked list of tasks
94 : END TYPE neighbor_list_task_type
95 :
96 : INTERFACE nl_sub_iterate
97 : MODULE PROCEDURE nl_sub_iterate
98 : MODULE PROCEDURE nl_sub_iterate_ref
99 : END INTERFACE
100 :
101 : ! **************************************************************************************************
102 : ! Neighbor List Iterator
103 : ! **************************************************************************************************
104 : TYPE neighbor_list_iterator_type
105 : PRIVATE
106 : INTEGER :: ikind, jkind, ilist, inode
107 : INTEGER :: nkind, nlist, nnode
108 : INTEGER :: iatom, jatom
109 : TYPE(neighbor_list_set_p_type), &
110 : DIMENSION(:), POINTER :: nl
111 : TYPE(neighbor_list_type), POINTER :: neighbor_list
112 : TYPE(neighbor_node_type), POINTER :: neighbor_node
113 : TYPE(list_search_type), &
114 : DIMENSION(:), POINTER :: list_search
115 : END TYPE neighbor_list_iterator_type
116 :
117 : TYPE neighbor_list_iterator_p_type
118 : PRIVATE
119 : TYPE(neighbor_list_iterator_type), POINTER :: neighbor_list_iterator
120 : INTEGER :: last
121 : END TYPE neighbor_list_iterator_p_type
122 : ! **************************************************************************************************
123 :
124 : ! *** Public data types ***
125 :
126 : PUBLIC :: neighbor_list_p_type, &
127 : neighbor_list_set_type, &
128 : neighbor_list_set_p_type, &
129 : neighbor_list_task_type
130 :
131 : ! *** Public subroutines ***
132 :
133 : PUBLIC :: add_neighbor_list, &
134 : add_neighbor_node, &
135 : allocate_neighbor_list_set, &
136 : deallocate_neighbor_list_set, &
137 : release_neighbor_list_sets, &
138 : get_iterator_task, &
139 : get_neighbor_list_set, &
140 : get_neighbor_list_set_p
141 :
142 : ! *** Iterator functions and types ***
143 :
144 : PUBLIC :: neighbor_list_iterator_p_type, &
145 : neighbor_list_iterator_create, &
146 : neighbor_list_iterator_release, &
147 : neighbor_list_iterate, &
148 : nl_set_sub_iterator, &
149 : nl_sub_iterate, &
150 : get_iterator_info
151 :
152 : CONTAINS
153 :
154 : ! **************************************************************************************************
155 : !> \brief Neighbor list iterator functions
156 : !> \param iterator_set ...
157 : !> \param nl ...
158 : !> \param search ...
159 : !> \param nthread ...
160 : !> \date 28.07.2010
161 : !> \author jhu
162 : !> \version 1.0
163 : ! **************************************************************************************************
164 1327786 : SUBROUTINE neighbor_list_iterator_create(iterator_set, nl, search, nthread)
165 : TYPE(neighbor_list_iterator_p_type), &
166 : DIMENSION(:), POINTER :: iterator_set
167 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
168 : POINTER :: nl
169 : LOGICAL, INTENT(IN), OPTIONAL :: search
170 : INTEGER, INTENT(IN), OPTIONAL :: nthread
171 :
172 : INTEGER :: iatom, il, ilist, mthread, nlist
173 1327786 : TYPE(list_search_type), DIMENSION(:), POINTER :: list_search
174 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
175 : TYPE(neighbor_list_type), POINTER :: neighbor_list
176 :
177 1327786 : mthread = 1
178 56447 : IF (PRESENT(nthread)) mthread = nthread
179 :
180 3983358 : ALLOCATE (iterator_set(0:mthread - 1))
181 :
182 2655572 : DO il = 0, mthread - 1
183 1327786 : ALLOCATE (iterator_set(il)%neighbor_list_iterator)
184 :
185 1327786 : iterator => iterator_set(il)%neighbor_list_iterator
186 :
187 1327786 : iterator%nl => nl
188 :
189 1327786 : iterator%ikind = 0
190 1327786 : iterator%jkind = 0
191 1327786 : iterator%nkind = NINT(SQRT(REAL(SIZE(nl), dp)))
192 :
193 1327786 : iterator%ilist = 0
194 1327786 : iterator%nlist = 0
195 1327786 : iterator%inode = 0
196 1327786 : iterator%nnode = 0
197 :
198 1327786 : iterator%iatom = 0
199 1327786 : iterator%jatom = 0
200 :
201 1327786 : NULLIFY (iterator%neighbor_list)
202 1327786 : NULLIFY (iterator%neighbor_node)
203 2655572 : NULLIFY (iterator%list_search)
204 : END DO
205 :
206 2655572 : iterator_set(:)%last = 0
207 :
208 1327786 : IF (PRESENT(search)) THEN
209 24947 : IF (search) THEN
210 74841 : ALLOCATE (list_search(SIZE(nl)))
211 114266 : DO il = 1, SIZE(nl)
212 114266 : IF (ASSOCIATED(nl(il)%neighbor_list_set)) THEN
213 88311 : CALL get_neighbor_list_set(neighbor_list_set=nl(il)%neighbor_list_set, nlist=nlist)
214 88311 : list_search(il)%nlist = nlist
215 240001 : ALLOCATE (list_search(il)%atom_list(nlist))
216 240001 : ALLOCATE (list_search(il)%atom_index(nlist))
217 240001 : ALLOCATE (list_search(il)%neighbor_list(nlist))
218 :
219 88311 : NULLIFY (neighbor_list)
220 195905 : DO ilist = 1, nlist
221 107594 : IF (.NOT. ASSOCIATED(neighbor_list)) THEN
222 63379 : neighbor_list => first_list(nl(il)%neighbor_list_set)
223 : ELSE
224 44215 : neighbor_list => neighbor_list%next_neighbor_list
225 : END IF
226 107594 : CALL get_neighbor_list(neighbor_list=neighbor_list, atom=iatom)
227 107594 : list_search(il)%atom_list(ilist) = iatom
228 195905 : list_search(il)%neighbor_list(ilist)%neighbor_list => neighbor_list
229 : END DO
230 176622 : CALL sort(list_search(il)%atom_list, nlist, list_search(il)%atom_index)
231 :
232 : ELSE
233 1008 : list_search(il)%nlist = -1
234 1008 : NULLIFY (list_search(il)%atom_list, list_search(il)%atom_index, list_search(il)%neighbor_list)
235 : END IF
236 : END DO
237 49894 : DO il = 0, mthread - 1
238 24947 : iterator => iterator_set(il)%neighbor_list_iterator
239 49894 : iterator%list_search => list_search
240 : END DO
241 : END IF
242 : END IF
243 :
244 1327786 : END SUBROUTINE neighbor_list_iterator_create
245 :
246 : ! **************************************************************************************************
247 : !> \brief ...
248 : !> \param iterator_set ...
249 : ! **************************************************************************************************
250 1327786 : SUBROUTINE neighbor_list_iterator_release(iterator_set)
251 : TYPE(neighbor_list_iterator_p_type), &
252 : DIMENSION(:), POINTER :: iterator_set
253 :
254 : INTEGER :: il, mthread
255 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
256 :
257 : !all threads have the same search list
258 :
259 1327786 : iterator => iterator_set(0)%neighbor_list_iterator
260 1327786 : IF (ASSOCIATED(iterator%list_search)) THEN
261 114266 : DO il = 1, SIZE(iterator%list_search)
262 114266 : IF (iterator%list_search(il)%nlist >= 0) THEN
263 88311 : DEALLOCATE (iterator%list_search(il)%atom_list)
264 88311 : DEALLOCATE (iterator%list_search(il)%atom_index)
265 88311 : DEALLOCATE (iterator%list_search(il)%neighbor_list)
266 : END IF
267 : END DO
268 24947 : DEALLOCATE (iterator%list_search)
269 : END IF
270 :
271 1327786 : mthread = SIZE(iterator_set)
272 2655572 : DO il = 0, mthread - 1
273 2655572 : DEALLOCATE (iterator_set(il)%neighbor_list_iterator)
274 : END DO
275 1327786 : DEALLOCATE (iterator_set)
276 :
277 1327786 : END SUBROUTINE neighbor_list_iterator_release
278 :
279 : ! **************************************************************************************************
280 : !> \brief ...
281 : !> \param iterator_set ...
282 : !> \param ikind ...
283 : !> \param jkind ...
284 : !> \param iatom ...
285 : !> \param mepos ...
286 : ! **************************************************************************************************
287 3236161 : SUBROUTINE nl_set_sub_iterator(iterator_set, ikind, jkind, iatom, mepos)
288 : TYPE(neighbor_list_iterator_p_type), &
289 : DIMENSION(:), POINTER :: iterator_set
290 : INTEGER, INTENT(IN) :: ikind, jkind, iatom
291 : INTEGER, INTENT(IN), OPTIONAL :: mepos
292 :
293 : INTEGER :: i, ij, ilist, me, nlist, nnode
294 : TYPE(list_search_type), POINTER :: list_search
295 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
296 : TYPE(neighbor_list_type), POINTER :: neighbor_list
297 :
298 3236161 : IF (PRESENT(mepos)) THEN
299 2509959 : me = mepos
300 : ELSE
301 : me = 0
302 : END IF
303 :
304 : ! Set up my thread-local iterator for the list of iatom / jkind nodes
305 :
306 3236161 : iterator => iterator_set(me)%neighbor_list_iterator
307 3236161 : ij = ikind + iterator%nkind*(jkind - 1)
308 3236161 : IF (ASSOCIATED(iterator%list_search)) THEN
309 3236161 : list_search => iterator%list_search(ij)
310 3236161 : nlist = list_search%nlist
311 3236161 : ilist = 0
312 3236161 : NULLIFY (neighbor_list)
313 3236161 : IF (nlist > 0) THEN
314 3226013 : i = locate(list_search%atom_list, iatom)
315 3226013 : i = list_search%atom_index(i)
316 3226013 : IF (i > 0) neighbor_list => list_search%neighbor_list(i)%neighbor_list
317 : ilist = i
318 : END IF
319 3236161 : IF (ASSOCIATED(neighbor_list)) THEN
320 3226013 : CALL get_neighbor_list(neighbor_list=neighbor_list, nnode=nnode)
321 : ELSE
322 10148 : nnode = 0
323 : END IF
324 : ELSE
325 0 : CPABORT("")
326 : END IF
327 :
328 3236161 : iterator%ikind = ikind
329 3236161 : iterator%jkind = jkind
330 :
331 3236161 : iterator%ilist = ilist
332 3236161 : iterator%nlist = nlist
333 3236161 : iterator%inode = 0
334 3236161 : iterator%nnode = nnode
335 :
336 3236161 : iterator%iatom = iatom
337 3236161 : iterator%jatom = 0
338 :
339 3236161 : iterator%neighbor_list => neighbor_list
340 3236161 : NULLIFY (iterator%neighbor_node)
341 :
342 3236161 : END SUBROUTINE nl_set_sub_iterator
343 :
344 : ! **************************************************************************************************
345 : !> \brief ...
346 : !> \param iterator_set ...
347 : !> \param mepos ...
348 : !> \return ...
349 : ! **************************************************************************************************
350 811587971 : FUNCTION neighbor_list_iterate(iterator_set, mepos) RESULT(istat)
351 : TYPE(neighbor_list_iterator_p_type), &
352 : DIMENSION(:), POINTER :: iterator_set
353 : INTEGER, OPTIONAL :: mepos
354 : INTEGER :: istat
355 :
356 : INTEGER :: iab, last, me
357 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
358 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
359 811587971 : POINTER :: nl
360 :
361 0 : IF (SIZE(iterator_set) .NE. 1 .AND. .NOT. PRESENT(mepos)) &
362 0 : CPABORT("Parallel iterator calls must include 'mepos'")
363 :
364 811587971 : IF (PRESENT(mepos)) THEN
365 7926021 : me = mepos
366 : ELSE
367 : me = 0
368 : END IF
369 :
370 811587971 : istat = 0
371 :
372 1623175942 : !$OMP CRITICAL(neighbour_list_iterate_critical)
373 811587971 : last = iterator_set(0)%last
374 811587971 : IF (last /= me) THEN
375 0 : iterator_set(me)%neighbor_list_iterator = iterator_set(last)%neighbor_list_iterator
376 : END IF
377 811587971 : iterator => iterator_set(me)%neighbor_list_iterator
378 811587971 : nl => iterator%nl
379 :
380 811587971 : IF (iterator%inode < iterator%nnode) THEN
381 : ! we can be sure that there is another node in this list
382 802887070 : iterator%inode = iterator%inode + 1
383 802887070 : iterator%neighbor_node => iterator%neighbor_node%next_neighbor_node
384 : ELSE
385 8700901 : iab = MAX(iterator%ikind + iterator%nkind*(iterator%jkind - 1), 0)
386 5470121 : kindloop: DO ! look for the next list with nnode /= 0
387 : listloop: DO
388 14928184 : IF (iterator%ilist >= iterator%nlist) EXIT listloop
389 8155224 : iterator%ilist = iterator%ilist + 1
390 8155224 : IF (ASSOCIATED(iterator%neighbor_list)) THEN
391 4422157 : iterator%neighbor_list => iterator%neighbor_list%next_neighbor_list
392 : ELSE
393 3733067 : iterator%neighbor_list => first_list(nl(iab)%neighbor_list_set)
394 : END IF
395 : CALL get_neighbor_list(neighbor_list=iterator%neighbor_list, atom=iterator%iatom, &
396 8155224 : nnode=iterator%nnode)
397 14928184 : IF (iterator%nnode > 0) EXIT kindloop
398 : END DO listloop
399 14171022 : IF (iab >= iterator%nkind**2) THEN
400 : istat = 1
401 : EXIT kindloop
402 : ELSE
403 5470121 : iab = iab + 1
404 5470121 : iterator%jkind = (iab - 1)/iterator%nkind + 1
405 5470121 : iterator%ikind = iab - iterator%nkind*(iterator%jkind - 1)
406 5470121 : iterator%ilist = 0
407 5470121 : IF (.NOT. ASSOCIATED(nl(iab)%neighbor_list_set)) THEN
408 : iterator%ilist = 0
409 102914 : iterator%nlist = 0
410 : ELSE
411 : CALL get_neighbor_list_set(neighbor_list_set= &
412 5367207 : nl(iab)%neighbor_list_set, nlist=iterator%nlist)
413 5367207 : iterator%ilist = 0
414 : END IF
415 5470121 : NULLIFY (iterator%neighbor_list)
416 : END IF
417 : END DO kindloop
418 8700901 : IF (istat == 0) THEN
419 7398062 : iterator%inode = 1
420 7398062 : iterator%neighbor_node => first_node(iterator%neighbor_list)
421 : END IF
422 : END IF
423 8700901 : IF (istat == 0) THEN
424 810285132 : CALL get_neighbor_node(neighbor_node=iterator%neighbor_node, neighbor=iterator%jatom)
425 : END IF
426 :
427 : ! mark the last iterator updated
428 1623175942 : iterator_set(:)%last = me
429 : !$OMP END CRITICAL(neighbour_list_iterate_critical)
430 :
431 811587971 : END FUNCTION neighbor_list_iterate
432 :
433 : ! **************************************************************************************************
434 : !> \brief ...
435 : !> \param iterator_set ...
436 : !> \param mepos ...
437 : !> \return ...
438 : ! **************************************************************************************************
439 145710648 : FUNCTION nl_sub_iterate(iterator_set, mepos) RESULT(istat)
440 : TYPE(neighbor_list_iterator_p_type), &
441 : DIMENSION(:), POINTER :: iterator_set
442 : INTEGER, INTENT(IN), OPTIONAL :: mepos
443 : INTEGER :: istat
444 :
445 : INTEGER :: me
446 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
447 :
448 : ! Each thread's sub-iterator are independent, no need to synchronise with other threads
449 :
450 145710648 : IF (PRESENT(mepos)) THEN
451 139078193 : me = mepos
452 : ELSE
453 : me = 0
454 : END IF
455 :
456 145710648 : istat = 0
457 :
458 145710648 : iterator => iterator_set(me)%neighbor_list_iterator
459 :
460 145710648 : IF (ASSOCIATED(iterator%neighbor_list)) THEN
461 145700500 : IF (iterator%inode >= iterator%nnode) THEN
462 : ! end of loop
463 : istat = 1
464 142770417 : ELSEIF (iterator%inode == 0) THEN
465 2850474 : iterator%inode = 1
466 2850474 : iterator%neighbor_node => first_node(iterator%neighbor_list)
467 139919943 : ELSEIF (iterator%inode > 0) THEN
468 : ! we can be sure that there is another node in this list
469 139919943 : iterator%inode = iterator%inode + 1
470 139919943 : iterator%neighbor_node => iterator%neighbor_node%next_neighbor_node
471 : ELSE
472 0 : CPABORT("wrong")
473 : END IF
474 : ELSE
475 : ! no list available
476 : istat = 1
477 : END IF
478 : IF (istat == 0) THEN
479 142770417 : CALL get_neighbor_node(neighbor_node=iterator%neighbor_node, neighbor=iterator%jatom)
480 : END IF
481 :
482 145710648 : END FUNCTION nl_sub_iterate
483 :
484 : ! **************************************************************************************************
485 : !> \brief wrap nl_sub_iterate s.t. external loop over kinds and calls to nl_set_sub_iterator
486 : !> are no longer needed. This fixes first atom of iter_sub to second atom of iter_ref.
487 : !> \param iter_sub ...
488 : !> \param iter_ref ...
489 : !> \param mepos ...
490 : !> \return ...
491 : ! **************************************************************************************************
492 6408543 : RECURSIVE FUNCTION nl_sub_iterate_ref(iter_sub, iter_ref, mepos) RESULT(iter_stat)
493 : TYPE(neighbor_list_iterator_p_type), &
494 : DIMENSION(:), POINTER :: iter_sub, iter_ref
495 : INTEGER, INTENT(IN), OPTIONAL :: mepos
496 : INTEGER :: iter_stat
497 :
498 : INTEGER :: atom_ref, kind_ref, kind_sub, me, nkind
499 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
500 :
501 6408543 : IF (PRESENT(mepos)) THEN
502 0 : me = mepos
503 : ELSE
504 : me = 0
505 : END IF
506 :
507 6408543 : iterator => iter_sub(me)%neighbor_list_iterator
508 6408543 : kind_sub = iterator%jkind
509 :
510 6408543 : CALL get_iterator_info(iter_ref, jatom=atom_ref, jkind=kind_ref)
511 :
512 6408543 : IF (iterator%inode == 0) THEN
513 295930 : CALL nl_set_sub_iterator(iter_sub, kind_ref, MAX(kind_sub, 1), atom_ref)
514 : END IF
515 6408543 : iter_stat = nl_sub_iterate(iter_sub)
516 6408543 : IF (iter_stat == 0) RETURN
517 :
518 295930 : nkind = iterator%nkind
519 :
520 295930 : IF (kind_sub == nkind) THEN
521 157288 : CALL nl_set_sub_iterator(iter_sub, kind_ref, 1, atom_ref)
522 157288 : RETURN
523 : ELSE
524 138642 : kind_sub = kind_sub + 1
525 138642 : CALL nl_set_sub_iterator(iter_sub, kind_ref, kind_sub, atom_ref)
526 138642 : iter_stat = nl_sub_iterate_ref(iter_sub, iter_ref)
527 : END IF
528 :
529 138642 : END FUNCTION
530 :
531 : ! **************************************************************************************************
532 : !> \brief ...
533 : !> \param iterator_set ...
534 : !> \param mepos ...
535 : !> \param ikind ...
536 : !> \param jkind ...
537 : !> \param nkind ...
538 : !> \param ilist ...
539 : !> \param nlist ...
540 : !> \param inode ...
541 : !> \param nnode ...
542 : !> \param iatom ...
543 : !> \param jatom ...
544 : !> \param r ...
545 : !> \param cell ...
546 : ! **************************************************************************************************
547 1010990278 : SUBROUTINE get_iterator_info(iterator_set, mepos, &
548 : ikind, jkind, nkind, ilist, nlist, inode, nnode, iatom, jatom, r, cell)
549 : TYPE(neighbor_list_iterator_p_type), &
550 : DIMENSION(:), POINTER :: iterator_set
551 : INTEGER, OPTIONAL :: mepos, ikind, jkind, nkind, ilist, &
552 : nlist, inode, nnode, iatom, jatom
553 : REAL(dp), DIMENSION(3), OPTIONAL :: r
554 : INTEGER, DIMENSION(3), OPTIONAL :: cell
555 :
556 : INTEGER :: me
557 : TYPE(neighbor_list_iterator_type), POINTER :: iterator
558 :
559 1010990278 : IF (SIZE(iterator_set) .NE. 1 .AND. .NOT. PRESENT(mepos)) &
560 0 : CPABORT("Parallel iterator calls must include 'mepos'")
561 :
562 1010990278 : IF (PRESENT(mepos)) THEN
563 144455959 : me = mepos
564 : ELSE
565 : me = 0
566 : END IF
567 1010990278 : iterator => iterator_set(me)%neighbor_list_iterator
568 :
569 1010990278 : IF (PRESENT(ikind)) ikind = iterator%ikind
570 1010990278 : IF (PRESENT(jkind)) jkind = iterator%jkind
571 1010990278 : IF (PRESENT(nkind)) nkind = iterator%nkind
572 1010990278 : IF (PRESENT(ilist)) ilist = iterator%ilist
573 1010990278 : IF (PRESENT(nlist)) nlist = iterator%nlist
574 1010990278 : IF (PRESENT(inode)) inode = iterator%inode
575 1010990278 : IF (PRESENT(nnode)) nnode = iterator%nnode
576 1010990278 : IF (PRESENT(iatom)) iatom = iterator%iatom
577 1010990278 : IF (PRESENT(jatom)) jatom = iterator%jatom
578 1010990278 : IF (PRESENT(r)) THEN
579 316308567 : CALL get_neighbor_node(neighbor_node=iterator%neighbor_node, r=r)
580 : END IF
581 1010990278 : IF (PRESENT(cell)) THEN
582 92365738 : CALL get_neighbor_node(neighbor_node=iterator%neighbor_node, cell=cell)
583 : END IF
584 :
585 1010990278 : END SUBROUTINE get_iterator_info
586 :
587 : ! **************************************************************************************************
588 : !> \brief Captures the current state of the iterator in a neighbor_list_task_type
589 : !> \param iterator_set the iterator / array of iterators (for multiple threads)
590 : !> \param task the task structure which is returned
591 : !> \param mepos OpenMP thread index
592 : ! **************************************************************************************************
593 36728110 : SUBROUTINE get_iterator_task(iterator_set, task, mepos)
594 : TYPE(neighbor_list_iterator_p_type), &
595 : DIMENSION(:), POINTER :: iterator_set
596 : TYPE(neighbor_list_task_type), INTENT(OUT) :: task
597 : INTEGER, OPTIONAL :: mepos
598 :
599 36728110 : IF (PRESENT(mepos)) THEN
600 : CALL get_iterator_info(iterator_set, mepos=mepos, ikind=task%ikind, jkind=task%jkind, &
601 : nkind=task%nkind, &
602 : ilist=task%ilist, nlist=task%nlist, &
603 : inode=task%inode, nnode=task%nnode, &
604 : iatom=task%iatom, jatom=task%jatom, &
605 0 : r=task%r, cell=task%cell)
606 : ELSE
607 : CALL get_iterator_info(iterator_set, ikind=task%ikind, jkind=task%jkind, &
608 : nkind=task%nkind, &
609 : ilist=task%ilist, nlist=task%nlist, &
610 : inode=task%inode, nnode=task%nnode, &
611 : iatom=task%iatom, jatom=task%jatom, &
612 36728110 : r=task%r, cell=task%cell)
613 : END IF
614 :
615 36728110 : NULLIFY (task%next)
616 :
617 36728110 : END SUBROUTINE get_iterator_task
618 :
619 : ! **************************************************************************************************
620 : !> \brief Add a new neighbor list to a neighbor list set.
621 : !> \param neighbor_list_set ...
622 : !> \param atom ...
623 : !> \param neighbor_list ...
624 : !> \date 13.09.2000
625 : !> \author MK
626 : !> \version 1.0
627 : ! **************************************************************************************************
628 627399 : SUBROUTINE add_neighbor_list(neighbor_list_set, atom, neighbor_list)
629 :
630 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
631 : INTEGER, INTENT(IN) :: atom
632 : TYPE(neighbor_list_type), POINTER :: neighbor_list
633 :
634 : TYPE(neighbor_list_type), POINTER :: new_neighbor_list
635 :
636 627399 : IF (ASSOCIATED(neighbor_list_set)) THEN
637 :
638 627399 : IF (ASSOCIATED(neighbor_list_set%last_neighbor_list)) THEN
639 :
640 : new_neighbor_list => &
641 336160 : neighbor_list_set%last_neighbor_list%next_neighbor_list
642 :
643 336160 : IF (.NOT. ASSOCIATED(new_neighbor_list)) THEN
644 :
645 : ! *** Allocate a new neighbor list ***
646 :
647 336160 : ALLOCATE (new_neighbor_list)
648 :
649 336160 : NULLIFY (new_neighbor_list%next_neighbor_list)
650 336160 : NULLIFY (new_neighbor_list%first_neighbor_node)
651 :
652 : ! *** Link the new neighbor list to the neighbor list set ***
653 :
654 336160 : neighbor_list_set%last_neighbor_list%next_neighbor_list => new_neighbor_list
655 :
656 : END IF
657 :
658 : ELSE
659 :
660 291239 : new_neighbor_list => neighbor_list_set%first_neighbor_list
661 :
662 291239 : IF (.NOT. ASSOCIATED(new_neighbor_list)) THEN
663 :
664 : ! *** Allocate a new first neighbor list ***
665 :
666 291239 : ALLOCATE (new_neighbor_list)
667 :
668 291239 : NULLIFY (new_neighbor_list%next_neighbor_list)
669 291239 : NULLIFY (new_neighbor_list%first_neighbor_node)
670 :
671 : ! *** Link the new first neighbor list to the neighbor list set ***
672 :
673 291239 : neighbor_list_set%first_neighbor_list => new_neighbor_list
674 :
675 : END IF
676 :
677 : END IF
678 :
679 : ! *** Store the data set of the new neighbor list ***
680 :
681 627399 : NULLIFY (new_neighbor_list%last_neighbor_node)
682 627399 : new_neighbor_list%atom = atom
683 627399 : new_neighbor_list%nnode = 0
684 :
685 : ! *** Update the pointer to the last neighbor ***
686 : ! *** list of the neighbor list set ***
687 :
688 627399 : neighbor_list_set%last_neighbor_list => new_neighbor_list
689 :
690 : ! *** Increment the neighbor list counter ***
691 :
692 627399 : neighbor_list_set%nlist = neighbor_list_set%nlist + 1
693 :
694 : ! *** Return a pointer to the new neighbor list ***
695 :
696 627399 : neighbor_list => new_neighbor_list
697 :
698 : ELSE
699 :
700 0 : CPABORT("The requested neighbor list set is not associated")
701 :
702 : END IF
703 :
704 627399 : END SUBROUTINE add_neighbor_list
705 :
706 : ! **************************************************************************************************
707 : !> \brief Add a new neighbor list node to a neighbor list.
708 : !> \param neighbor_list ...
709 : !> \param neighbor ...
710 : !> \param cell ...
711 : !> \param r ...
712 : !> \param exclusion_list ...
713 : !> \param nkind ...
714 : !> \date 23.06.2000
715 : !> \author MK
716 : !> \version 1.0
717 : ! **************************************************************************************************
718 36063883 : SUBROUTINE add_neighbor_node(neighbor_list, neighbor, cell, r, exclusion_list, nkind)
719 :
720 : TYPE(neighbor_list_type), POINTER :: neighbor_list
721 : INTEGER, INTENT(IN) :: neighbor
722 : INTEGER, DIMENSION(3), INTENT(IN) :: cell
723 : REAL(dp), DIMENSION(3), INTENT(IN) :: r
724 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: exclusion_list
725 : INTEGER, INTENT(IN), OPTIONAL :: nkind
726 :
727 : INTEGER :: iatom, my_nkind
728 : TYPE(neighbor_node_type), POINTER :: new_neighbor_node
729 :
730 36063883 : IF (ASSOCIATED(neighbor_list)) THEN
731 :
732 : ! *** Check for exclusions ***
733 :
734 36063883 : IF (PRESENT(exclusion_list)) THEN
735 0 : IF (ASSOCIATED(exclusion_list)) THEN
736 0 : DO iatom = 1, SIZE(exclusion_list)
737 0 : IF (exclusion_list(iatom) == 0) EXIT
738 0 : IF (exclusion_list(iatom) == neighbor) RETURN
739 : END DO
740 : END IF
741 : END IF
742 :
743 36063883 : my_nkind = 0
744 36063883 : IF (PRESENT(nkind)) my_nkind = nkind
745 :
746 36063883 : IF (ASSOCIATED(neighbor_list%last_neighbor_node)) THEN
747 :
748 35481704 : new_neighbor_node => neighbor_list%last_neighbor_node%next_neighbor_node
749 :
750 35481704 : IF (.NOT. ASSOCIATED(new_neighbor_node)) THEN
751 :
752 : ! *** Allocate a new neighbor node ***
753 :
754 35481704 : ALLOCATE (new_neighbor_node)
755 :
756 35481704 : NULLIFY (new_neighbor_node%next_neighbor_node)
757 :
758 : ! *** Link the new neighbor node to the neighbor list ***
759 :
760 35481704 : neighbor_list%last_neighbor_node%next_neighbor_node => new_neighbor_node
761 :
762 : END IF
763 :
764 : ELSE
765 :
766 582179 : new_neighbor_node => neighbor_list%first_neighbor_node
767 :
768 582179 : IF (.NOT. ASSOCIATED(new_neighbor_node)) THEN
769 :
770 : ! *** Allocate a new first neighbor node ***
771 :
772 582179 : ALLOCATE (new_neighbor_node)
773 :
774 582179 : NULLIFY (new_neighbor_node%next_neighbor_node)
775 :
776 : ! *** Link the new first neighbor node to the neighbor list ***
777 :
778 582179 : neighbor_list%first_neighbor_node => new_neighbor_node
779 :
780 : END IF
781 :
782 : END IF
783 :
784 : ! *** Store the data set of the new neighbor ***
785 :
786 36063883 : new_neighbor_node%neighbor = neighbor
787 144255532 : new_neighbor_node%cell(:) = cell(:)
788 144255532 : new_neighbor_node%r(:) = r(:)
789 :
790 : ! *** Update the pointer to the last neighbor node of the neighbor list ***
791 :
792 36063883 : neighbor_list%last_neighbor_node => new_neighbor_node
793 :
794 : ! *** Increment the neighbor node counter ***
795 :
796 36063883 : neighbor_list%nnode = neighbor_list%nnode + 1
797 :
798 : ELSE
799 :
800 0 : CPABORT("The requested neighbor list is not associated")
801 :
802 : END IF
803 :
804 : END SUBROUTINE add_neighbor_node
805 :
806 : ! **************************************************************************************************
807 : !> \brief Allocate and initialize a set of neighbor lists.
808 : !> \param neighbor_list_set ...
809 : !> \param symmetric ...
810 : !> \date 23.06.2000
811 : !> \author MK
812 : !> \version 1.0
813 : ! **************************************************************************************************
814 407406 : SUBROUTINE allocate_neighbor_list_set(neighbor_list_set, symmetric)
815 :
816 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
817 : LOGICAL, INTENT(IN) :: symmetric
818 :
819 : ! *** Deallocate the old neighbor list set ***
820 :
821 407406 : IF (ASSOCIATED(neighbor_list_set)) THEN
822 0 : CALL deallocate_neighbor_list_set(neighbor_list_set)
823 : END IF
824 :
825 : ! *** Allocate a set of neighbor lists ***
826 :
827 407406 : ALLOCATE (neighbor_list_set)
828 :
829 407406 : NULLIFY (neighbor_list_set%first_neighbor_list)
830 :
831 : ! *** Initialize the pointers to the first neighbor list ***
832 :
833 407406 : CALL init_neighbor_list_set(neighbor_list_set, symmetric)
834 :
835 407406 : END SUBROUTINE allocate_neighbor_list_set
836 :
837 : ! **************************************************************************************************
838 : !> \brief Deallocate a neighbor list.
839 : !> \param neighbor_list ...
840 : !> \date 20.09.2002
841 : !> \author MK
842 : !> \version 1.0
843 : ! **************************************************************************************************
844 627399 : SUBROUTINE deallocate_neighbor_list(neighbor_list)
845 :
846 : TYPE(neighbor_list_type), POINTER :: neighbor_list
847 :
848 : TYPE(neighbor_node_type), POINTER :: neighbor_node, next_neighbor_node
849 :
850 627399 : IF (ASSOCIATED(neighbor_list)) THEN
851 :
852 627399 : neighbor_node => neighbor_list%first_neighbor_node
853 :
854 36691282 : DO WHILE (ASSOCIATED(neighbor_node))
855 36063883 : next_neighbor_node => neighbor_node%next_neighbor_node
856 36063883 : DEALLOCATE (neighbor_node)
857 36063883 : neighbor_node => next_neighbor_node
858 : END DO
859 :
860 627399 : DEALLOCATE (neighbor_list)
861 :
862 : END IF
863 :
864 627399 : END SUBROUTINE deallocate_neighbor_list
865 :
866 : ! **************************************************************************************************
867 : !> \brief Deallocate a neighbor list set.
868 : !> \param neighbor_list_set ...
869 : !> \date 03.11.2000
870 : !> \author MK
871 : !> \version 1.0
872 : ! **************************************************************************************************
873 447082 : SUBROUTINE deallocate_neighbor_list_set(neighbor_list_set)
874 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
875 :
876 : TYPE(neighbor_list_type), POINTER :: neighbor_list, next_neighbor_list
877 :
878 447082 : IF (ASSOCIATED(neighbor_list_set)) THEN
879 :
880 407406 : neighbor_list => neighbor_list_set%first_neighbor_list
881 :
882 1034805 : DO WHILE (ASSOCIATED(neighbor_list))
883 627399 : next_neighbor_list => neighbor_list%next_neighbor_list
884 627399 : CALL deallocate_neighbor_list(neighbor_list)
885 627399 : neighbor_list => next_neighbor_list
886 : END DO
887 :
888 407406 : DEALLOCATE (neighbor_list_set)
889 :
890 : END IF
891 :
892 447082 : END SUBROUTINE deallocate_neighbor_list_set
893 :
894 : ! **************************************************************************************************
895 : !> \brief Return a pointer to the first neighbor list of a neighbor list set.
896 : !> \param neighbor_list_set ...
897 : !> \return ...
898 : !> \date 13.09.2000
899 : !> \author MK
900 : !> \version 1.0
901 : ! **************************************************************************************************
902 3796446 : FUNCTION first_list(neighbor_list_set) RESULT(first_neighbor_list)
903 :
904 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
905 : TYPE(neighbor_list_type), POINTER :: first_neighbor_list
906 :
907 3796446 : first_neighbor_list => neighbor_list_set%first_neighbor_list
908 :
909 3796446 : END FUNCTION first_list
910 :
911 : ! **************************************************************************************************
912 : !> \brief Return a pointer to the first neighbor node of a neighbor list.
913 : !> \param neighbor_list ...
914 : !> \return ...
915 : !> \date 23.06.2000,
916 : !> \author MK
917 : !> \version 1.0
918 : ! **************************************************************************************************
919 10248536 : FUNCTION first_node(neighbor_list) RESULT(first_neighbor_node)
920 :
921 : TYPE(neighbor_list_type), POINTER :: neighbor_list
922 : TYPE(neighbor_node_type), POINTER :: first_neighbor_node
923 :
924 10248536 : first_neighbor_node => neighbor_list%first_neighbor_node
925 :
926 10248536 : END FUNCTION first_node
927 :
928 : ! **************************************************************************************************
929 : !> \brief Return the requested data of a neighbor list.
930 : !> \param neighbor_list ...
931 : !> \param atom ...
932 : !> \param nnode ...
933 : !> \date 13.09.2000
934 : !> \author MK
935 : !> \version 1.0
936 : ! **************************************************************************************************
937 11488831 : SUBROUTINE get_neighbor_list(neighbor_list, atom, nnode)
938 :
939 : TYPE(neighbor_list_type), POINTER :: neighbor_list
940 : INTEGER, INTENT(OUT), OPTIONAL :: atom, nnode
941 :
942 11488831 : IF (ASSOCIATED(neighbor_list)) THEN
943 :
944 11488831 : IF (PRESENT(atom)) atom = neighbor_list%atom
945 11488831 : IF (PRESENT(nnode)) nnode = neighbor_list%nnode
946 :
947 : ELSE
948 :
949 0 : CPABORT("The requested neighbor list is not associated")
950 :
951 : END IF
952 :
953 11488831 : END SUBROUTINE get_neighbor_list
954 :
955 : ! **************************************************************************************************
956 : !> \brief Return the components of a neighbor list set.
957 : !> \param neighbor_list_set ...
958 : !> \param nlist ...
959 : !> \param symmetric ...
960 : !> \date 10.11.2000
961 : !> \author MK
962 : !> \version 1.0
963 : ! **************************************************************************************************
964 5455518 : SUBROUTINE get_neighbor_list_set(neighbor_list_set, nlist, symmetric)
965 :
966 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
967 : INTEGER, INTENT(OUT), OPTIONAL :: nlist
968 : LOGICAL, INTENT(OUT), OPTIONAL :: symmetric
969 :
970 5455518 : IF (ASSOCIATED(neighbor_list_set)) THEN
971 :
972 5455518 : IF (PRESENT(nlist)) nlist = neighbor_list_set%nlist
973 5455518 : IF (PRESENT(symmetric)) symmetric = neighbor_list_set%symmetric
974 :
975 : ELSE
976 :
977 0 : CPABORT("The requested neighbor list set is not associated")
978 :
979 : END IF
980 :
981 5455518 : END SUBROUTINE get_neighbor_list_set
982 :
983 : ! **************************************************************************************************
984 : !> \brief Return the components of the first neighbor list set.
985 : !> \param neighbor_list_sets ...
986 : !> \param nlist ...
987 : !> \param symmetric ...
988 : !> \date 07.2014
989 : !> \author JGH
990 : !> \version 1.0
991 : ! **************************************************************************************************
992 868581 : SUBROUTINE get_neighbor_list_set_p(neighbor_list_sets, nlist, symmetric)
993 :
994 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
995 : POINTER :: neighbor_list_sets
996 : INTEGER, INTENT(OUT), OPTIONAL :: nlist
997 : LOGICAL, INTENT(OUT), OPTIONAL :: symmetric
998 :
999 : INTEGER :: i
1000 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
1001 :
1002 868581 : IF (ASSOCIATED(neighbor_list_sets)) THEN
1003 :
1004 868581 : NULLIFY (neighbor_list_set)
1005 868625 : DO i = 1, SIZE(neighbor_list_sets)
1006 868625 : neighbor_list_set => neighbor_list_sets(i)%neighbor_list_set
1007 868625 : IF (ASSOCIATED(neighbor_list_set)) EXIT
1008 : END DO
1009 :
1010 868581 : IF (ASSOCIATED(neighbor_list_set)) THEN
1011 868581 : IF (PRESENT(nlist)) nlist = neighbor_list_set%nlist
1012 868581 : IF (PRESENT(symmetric)) symmetric = neighbor_list_set%symmetric
1013 : ELSE
1014 : CALL cp_abort(__LOCATION__, "No neighbor list set is associated. "// &
1015 0 : "Did you specify *all* required basis-sets, eg. for ADMM?")
1016 : END IF
1017 :
1018 : ELSE
1019 :
1020 0 : CPABORT("The requested neighbor list sets are not associated")
1021 :
1022 : END IF
1023 :
1024 868581 : END SUBROUTINE get_neighbor_list_set_p
1025 :
1026 : ! **************************************************************************************************
1027 : !> \brief Return the requested data of a neighbor node.
1028 : !> \param neighbor_node ...
1029 : !> \param neighbor ...
1030 : !> \param cell ...
1031 : !> \param r ...
1032 : !> \date 23.06.2000
1033 : !> \author MK
1034 : !> \version 1.0
1035 : ! **************************************************************************************************
1036 1361729854 : SUBROUTINE get_neighbor_node(neighbor_node, neighbor, cell, r)
1037 :
1038 : TYPE(neighbor_node_type), POINTER :: neighbor_node
1039 : INTEGER, INTENT(OUT), OPTIONAL :: neighbor
1040 : INTEGER, DIMENSION(3), INTENT(OUT), OPTIONAL :: cell
1041 : REAL(dp), DIMENSION(3), INTENT(OUT), OPTIONAL :: r
1042 :
1043 1361729854 : IF (ASSOCIATED(neighbor_node)) THEN
1044 :
1045 1361729854 : IF (PRESENT(neighbor)) neighbor = neighbor_node%neighbor
1046 2310655555 : IF (PRESENT(r)) r(:) = neighbor_node%r(:)
1047 1638827068 : IF (PRESENT(cell)) cell(:) = neighbor_node%cell(:)
1048 :
1049 : ELSE
1050 :
1051 0 : CPABORT("The requested neighbor node is not associated")
1052 :
1053 : END IF
1054 :
1055 1361729854 : END SUBROUTINE get_neighbor_node
1056 :
1057 : ! **************************************************************************************************
1058 : !> \brief Initialize a neighbor list set. Nothing is (de)allocated here.
1059 : !> This routine is also used to prepare a neighbor list set for
1060 : !> overwriting.
1061 : !> \param neighbor_list_set ...
1062 : !> \param symmetric ...
1063 : !> \date 20.09.2002
1064 : !> \author MK
1065 : !> \version 1.0
1066 : ! **************************************************************************************************
1067 407406 : SUBROUTINE init_neighbor_list_set(neighbor_list_set, symmetric)
1068 :
1069 : TYPE(neighbor_list_set_type), POINTER :: neighbor_list_set
1070 : LOGICAL, INTENT(IN) :: symmetric
1071 :
1072 407406 : IF (ASSOCIATED(neighbor_list_set)) THEN
1073 :
1074 : ! *** Initialize the pointers to the last neighbor list ***
1075 407406 : NULLIFY (neighbor_list_set%last_neighbor_list)
1076 :
1077 : ! *** Initialize the neighbor list counter ***
1078 407406 : neighbor_list_set%nlist = 0
1079 :
1080 : ! *** Initialize the neighbor list build properties
1081 407406 : neighbor_list_set%symmetric = symmetric
1082 :
1083 : ELSE
1084 :
1085 0 : CPABORT("The requested neighbor list set is not associated")
1086 :
1087 : END IF
1088 :
1089 407406 : END SUBROUTINE init_neighbor_list_set
1090 :
1091 : ! **************************************************************************************************
1092 : !> \brief releases an array of neighbor_list_sets
1093 : !> \param nlists ...
1094 : !> \author Ole Schuett
1095 : ! **************************************************************************************************
1096 281361 : SUBROUTINE release_neighbor_list_sets(nlists)
1097 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1098 : POINTER :: nlists
1099 :
1100 : INTEGER :: i
1101 :
1102 281361 : IF (ASSOCIATED(nlists)) THEN
1103 551103 : DO i = 1, SIZE(nlists)
1104 551103 : CALL deallocate_neighbor_list_set(nlists(i)%neighbor_list_set)
1105 : END DO
1106 104021 : IF (ASSOCIATED(nlists(1)%nlist_task)) THEN
1107 104021 : DEALLOCATE (nlists(1)%nlist_task)
1108 : END IF
1109 104021 : DEALLOCATE (nlists)
1110 : END IF
1111 281361 : END SUBROUTINE release_neighbor_list_sets
1112 :
1113 0 : END MODULE qs_neighbor_list_types
|
