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