(git:0de0cc2)
molecule_list_types.F
Go to the documentation of this file.
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 represent a simple array based list of the given type
10 !> \par History
11 !> 08.2003 created [fawzi]
12 !> 01.2017 ported to Fypp [Ole Schuett]
13 !> \author Fawzi Mohamed
14 ! **************************************************************************************************
17  molecule_type
18 
19 #include "../base/base_uses.f90"
20 
21  IMPLICIT NONE
22  PRIVATE
23 
24 
25 
26 
27  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
28 
29  !API
30  PUBLIC :: molecule_list_type, molecule_list_p_type, &
33 
34 ! **************************************************************************************************
35 !> \brief represent a list of objects
36 !> \param ref_count reference count (see doc/ReferenceCounting.html)
37 !> \param n_el the number of elements in the list
38 !> \param owns_list if the els are owned by this structure, and
39 !> should be deallocated by it
40 !> \param list the array of object, might be oversized,
41 !> only the fist n_el have some meaning
42 !> \par History
43 !> 08.2003 created [fawzi]
44 !> \author Fawzi Mohamed
45 ! **************************************************************************************************
46  TYPE molecule_list_type
47  INTEGER :: ref_count = 0, n_els = 0
48  LOGICAL :: owns_els = .false.
49  TYPE(molecule_type), DIMENSION(:), POINTER :: els => null()
50  END TYPE molecule_list_type
51 
52 ! **************************************************************************************************
53 !> \brief represents a pointer to a list
54 !> \param list the pointer to the list
55 !> \par History
56 !> 08.2003 created [fawzi]
57 !> \author Fawzi Mohamed
58 ! **************************************************************************************************
59  TYPE molecule_list_p_type
60  TYPE(molecule_list_type), POINTER :: list => null()
61  END TYPE molecule_list_p_type
62 
63  CONTAINS
64 
65 ! **************************************************************************************************
66 !> \brief creates a list
67 !> \param list the list to allocate and initialize
68 !> \param els_ptr the elements to store in the list (the array is only,
69 !> referenced, not copied!)
70 !> \param owns_els if the list takes the ownership of els_ptr and
71 !> will deallocate it (defaults to true)
72 !> \param n_els number of elements in the list (at least one els_ptr or
73 !> n_els should be given)
74 !> \par History
75 !> 08.2003 created [fawzi]
76 !> \author Fawzi Mohamed
77 ! **************************************************************************************************
78  SUBROUTINE molecule_list_create(list, els_ptr, &
79  owns_els, n_els)
80  TYPE(molecule_list_type), POINTER, OPTIONAL :: list
81  TYPE(molecule_type), DIMENSION(:), POINTER, OPTIONAL :: els_ptr
82  LOGICAL, INTENT(in), OPTIONAL :: owns_els
83  INTEGER, INTENT(in), OPTIONAL :: n_els
84 
85  cpassert(PRESENT(els_ptr) .OR. PRESENT(n_els))
86 
87  ALLOCATE (list)
88  list%ref_count = 1
89  list%owns_els = .true.
90  list%n_els = 0
91  IF (PRESENT(owns_els)) list%owns_els = owns_els
92  NULLIFY (list%els)
93  IF (PRESENT(els_ptr)) THEN
94  list%els => els_ptr
95  IF (ASSOCIATED(els_ptr)) THEN
96  list%n_els = SIZE(els_ptr)
97  END IF
98  END IF
99  IF (PRESENT(n_els)) list%n_els = n_els
100  IF (.NOT. ASSOCIATED(list%els)) THEN
101  ALLOCATE (list%els(list%n_els))
102  cpassert(list%owns_els)
103  END IF
104  END SUBROUTINE molecule_list_create
105 
106 ! **************************************************************************************************
107 !> \brief retains a list (see doc/ReferenceCounting.html)
108 !> \param list the list to retain
109 !> \par History
110 !> 08.2003 created [fawzi]
111 !> \author Fawzi Mohamed
112 ! **************************************************************************************************
113  SUBROUTINE molecule_list_retain(list)
114  TYPE(molecule_list_type), POINTER :: list
115 
116  cpassert(ASSOCIATED(list))
117  cpassert(list%ref_count > 0)
118  list%ref_count = list%ref_count + 1
119  END SUBROUTINE molecule_list_retain
120 
121 ! **************************************************************************************************
122 !> \brief releases a list (see doc/ReferenceCounting.html)
123 !> \param list the list to release
124 !> \par History
125 !> 08.2003 created [fawzi]
126 !> \author Fawzi Mohamed
127 ! **************************************************************************************************
128  SUBROUTINE molecule_list_release(list)
129  TYPE(molecule_list_type), POINTER :: list
130 
131  IF (ASSOCIATED(list)) THEN
132  cpassert(list%ref_count > 0)
133  list%ref_count = list%ref_count - 1
134  IF (list%ref_count == 0) THEN
135  IF (list%owns_els) THEN
136  IF (ASSOCIATED(list%els)) THEN
137  CALL deallocate_molecule_set(list%els)
138  END IF
139  END IF
140  NULLIFY (list%els)
141  DEALLOCATE (list)
142  END IF
143  END IF
144  NULLIFY (list)
145  END SUBROUTINE molecule_list_release
146 
147 
148 END MODULE molecule_list_types
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition: list.F:24
represent a simple array based list of the given type
subroutine, public molecule_list_retain(list)
retains a list (see doc/ReferenceCounting.html)
subroutine, public molecule_list_create(list, els_ptr, owns_els, n_els)
creates a list
subroutine, public molecule_list_release(list)
releases a list (see doc/ReferenceCounting.html)
Define the data structure for the molecule information.
subroutine, public deallocate_molecule_set(molecule_set)
Deallocate a molecule set.