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 pool for for elements that are retained and released
10 : !> \par History
11 : !> 08.2002 created [fawzi]
12 : !> \author Fawzi Mohamed
13 : ! **************************************************************************************************
14 : MODULE cp_fm_pool_types
15 : USE cp_fm_struct, ONLY: cp_fm_struct_release, &
16 : cp_fm_struct_retain, &
17 : cp_fm_struct_type
18 : USE cp_fm_types, ONLY: cp_fm_create, &
19 : cp_fm_p_type, &
20 : cp_fm_release, &
21 : cp_fm_type
22 : USE cp_linked_list_fm, ONLY: cp_sll_fm_dealloc, &
23 : cp_sll_fm_get_first_el, &
24 : cp_sll_fm_insert_el, &
25 : cp_sll_fm_next, &
26 : cp_sll_fm_rm_first_el, &
27 : cp_sll_fm_type
28 : USE cp_log_handling, ONLY: cp_to_string
29 : #include "../base/base_uses.f90"
30 :
31 : IMPLICIT NONE
32 : PRIVATE
33 :
34 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
35 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_pool_types'
36 :
37 : PUBLIC :: cp_fm_pool_type, cp_fm_pool_p_type
38 : PUBLIC :: fm_pool_create, &
39 : fm_pool_release, &
40 : fm_pool_create_fm, fm_pool_give_back_fm, &
41 : fm_pool_get_el_struct
42 : PUBLIC :: fm_pools_dealloc, &
43 : fm_pools_create_fm_vect, &
44 : fm_pools_give_back_fm_vect
45 : !***
46 :
47 : ! **************************************************************************************************
48 : !> \brief represent a pool of elements with the same structure
49 : !> \param el_struct the structure of the elements stored in this pool
50 : !> \param cache linked list with the elements in the pool
51 : !> \par History
52 : !> 08.2002 created [fawzi]
53 : !> \author Fawzi Mohamed
54 : ! **************************************************************************************************
55 : TYPE cp_fm_pool_type
56 : PRIVATE
57 : TYPE(cp_fm_struct_type), POINTER :: el_struct => NULL()
58 : TYPE(cp_sll_fm_type), POINTER :: cache => NULL()
59 : END TYPE cp_fm_pool_type
60 :
61 : ! **************************************************************************************************
62 : !> \brief to create arrays of pools
63 : !> \param pool the pool
64 : !> \par History
65 : !> 08.2002 created [fawzi]
66 : !> \author Fawzi Mohamed
67 : ! **************************************************************************************************
68 : TYPE cp_fm_pool_p_type
69 : TYPE(cp_fm_pool_type), POINTER :: pool => NULL()
70 : END TYPE cp_fm_pool_p_type
71 :
72 : INTERFACE fm_pools_create_fm_vect
73 : MODULE PROCEDURE fm_pools_create_fm_m1_p_type_pointer
74 : MODULE PROCEDURE fm_pools_create_fm_m1_p_type_alloc
75 : MODULE PROCEDURE fm_pools_create_fm_m1_array_pointer
76 : MODULE PROCEDURE fm_pools_create_fm_m1_array_alloc
77 : END INTERFACE
78 :
79 : INTERFACE fm_pools_give_back_fm_vect
80 : MODULE PROCEDURE fm_pools_give_back_fm_m1_p_type_pointer
81 : MODULE PROCEDURE fm_pools_give_back_fm_m1_p_type_alloc
82 : MODULE PROCEDURE fm_pools_give_back_fm_m1_array_pointer
83 : MODULE PROCEDURE fm_pools_give_back_fm_m1_array_alloc
84 : END INTERFACE
85 :
86 : CONTAINS
87 :
88 : ! **************************************************************************************************
89 : !> \brief creates a pool of elements
90 : !> \param pool the pool to create
91 : !> \param el_struct the structure of the elements that are stored in
92 : !> this pool
93 : !> \par History
94 : !> 08.2002 created [fawzi]
95 : !> \author Fawzi Mohamed
96 : ! **************************************************************************************************
97 43064 : SUBROUTINE fm_pool_create(pool, el_struct)
98 : TYPE(cp_fm_pool_type), POINTER :: pool
99 : TYPE(cp_fm_struct_type), TARGET :: el_struct
100 :
101 43064 : ALLOCATE (pool)
102 43064 : pool%el_struct => el_struct
103 43064 : CALL cp_fm_struct_retain(pool%el_struct)
104 :
105 43064 : END SUBROUTINE fm_pool_create
106 :
107 : ! **************************************************************************************************
108 : !> \brief deallocates all the cached elements
109 : !> \param pool the pool to flush
110 : !> \par History
111 : !> 08.2002 created [fawzi]
112 : !> \author Fawzi Mohamed
113 : ! **************************************************************************************************
114 43064 : SUBROUTINE fm_pool_flush_cache(pool)
115 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
116 :
117 : TYPE(cp_fm_type), POINTER :: el_att
118 : TYPE(cp_sll_fm_type), POINTER :: iterator
119 :
120 43064 : iterator => pool%cache
121 70038 : DO
122 113102 : IF (.NOT. cp_sll_fm_next(iterator, el_att=el_att)) EXIT
123 70038 : CALL cp_fm_release(el_att)
124 70038 : DEALLOCATE (el_att)
125 43064 : NULLIFY (el_att)
126 : END DO
127 43064 : CALL cp_sll_fm_dealloc(pool%cache)
128 43064 : END SUBROUTINE fm_pool_flush_cache
129 :
130 : ! **************************************************************************************************
131 : !> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
132 : !> \param pool the pool to release
133 : !> \par History
134 : !> 08.2002 created [fawzi]
135 : !> \author Fawzi Mohamed
136 : ! **************************************************************************************************
137 84436 : SUBROUTINE fm_pool_release(pool)
138 : TYPE(cp_fm_pool_type), POINTER :: pool
139 :
140 84436 : IF (ASSOCIATED(pool)) THEN
141 43064 : CALL fm_pool_flush_cache(pool)
142 43064 : CALL cp_fm_struct_release(pool%el_struct)
143 43064 : DEALLOCATE (pool)
144 : END IF
145 84436 : NULLIFY (pool)
146 84436 : END SUBROUTINE fm_pool_release
147 :
148 : ! **************************************************************************************************
149 : !> \brief returns an element, allocating it if none is in the pool
150 : !> \param pool the pool from where you get the element
151 : !> \param element will contain the new element
152 : !>\param name the name for the new matrix (optional)
153 : !> \param name ...
154 : !> \par History
155 : !> 08.2002 created [fawzi]
156 : !> \author Fawzi Mohamed
157 : ! **************************************************************************************************
158 190582 : SUBROUTINE fm_pool_create_fm(pool, element, &
159 : name)
160 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
161 : TYPE(cp_fm_type), INTENT(OUT) :: element
162 : CHARACTER(len=*), INTENT(in), OPTIONAL :: name
163 :
164 : TYPE(cp_fm_type), POINTER :: el
165 :
166 190582 : NULLIFY (el)
167 190582 : IF (ASSOCIATED(pool%cache)) THEN
168 83652 : el => cp_sll_fm_get_first_el(pool%cache)
169 83652 : CALL cp_sll_fm_rm_first_el(pool%cache)
170 : END IF
171 83652 : IF (ASSOCIATED(el)) THEN
172 83652 : element = el
173 83652 : DEALLOCATE (el)
174 : ELSE
175 106930 : CALL cp_fm_create(element, matrix_struct=pool%el_struct, set_zero=.TRUE.)
176 : END IF
177 :
178 190582 : IF (PRESENT(name)) THEN
179 28372 : element%name = name
180 : ELSE
181 162210 : element%name = "tmp"
182 : END IF
183 :
184 190582 : END SUBROUTINE fm_pool_create_fm
185 :
186 : ! **************************************************************************************************
187 : !> \brief returns the element to the pool
188 : !> \param pool the pool where to cache the element
189 : !> \param element the element to give back
190 : !> \par History
191 : !> 08.2002 created [fawzi]
192 : !> \author Fawzi Mohamed
193 : !> \note
194 : !> transfers the ownership of the element to the pool
195 : !> (it is as if you had called cp_fm_release)
196 : !> Accept give_backs of non associated elements?
197 : ! **************************************************************************************************
198 153690 : SUBROUTINE fm_pool_give_back_fm(pool, element)
199 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
200 : TYPE(cp_fm_type), INTENT(INOUT) :: element
201 :
202 153690 : IF (.NOT. ASSOCIATED(pool%el_struct, element%matrix_struct)) THEN
203 0 : CALL cp_fm_release(element)
204 : ELSE
205 : BLOCK
206 : TYPE(cp_fm_type), POINTER :: el
207 153690 : ALLOCATE (el)
208 153690 : el = element
209 153690 : CALL cp_sll_fm_insert_el(pool%cache, el=el)
210 153690 : NULLIFY (element%matrix_struct, element%local_data)
211 : END BLOCK
212 : END IF
213 153690 : END SUBROUTINE fm_pool_give_back_fm
214 :
215 : ! **************************************************************************************************
216 : !> \brief returns the structure of the elements in this pool
217 : !> \param pool the pool you are interested in
218 : !> \return ...
219 : !> \par History
220 : !> 05.2002 created [fawzi]
221 : !> \author Fawzi Mohamed
222 : ! **************************************************************************************************
223 41801 : FUNCTION fm_pool_get_el_struct(pool) RESULT(res)
224 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
225 : TYPE(cp_fm_struct_type), POINTER :: res
226 :
227 41801 : res => pool%el_struct
228 41801 : END FUNCTION fm_pool_get_el_struct
229 :
230 : !================== pools ================
231 :
232 : ! **************************************************************************************************
233 : !> \brief deallocate an array of pools (releasing each pool)
234 : !> \param pools the pools to release
235 : !> \par History
236 : !> 11.2002 created [fawzi]
237 : !> \author Fawzi Mohamed
238 : ! **************************************************************************************************
239 24664 : SUBROUTINE fm_pools_dealloc(pools)
240 : TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: pools
241 :
242 : INTEGER :: i
243 :
244 24664 : IF (ASSOCIATED(pools)) THEN
245 53686 : DO i = 1, SIZE(pools)
246 53686 : CALL fm_pool_release(pools(i)%pool)
247 : END DO
248 24664 : DEALLOCATE (pools)
249 : END IF
250 24664 : END SUBROUTINE fm_pools_dealloc
251 :
252 : #:mute
253 : #:set types = [("cp_fm_type", "array", ""), ("cp_fm_p_type", "p_type","%matrix")]
254 : #:set attributes = [("ALLOCATABLE", "alloc", "ALLOCATED"), ("POINTER", "pointer", "ASSOCIATED")]
255 : #:endmute
256 :
257 : #:for typename, shortname, appendix in types
258 : #:for attr, shortattr, create in attributes
259 : ! **************************************************************************************************
260 : !> \brief Returns a vector with an element from each pool
261 : !> \param pools the pools to create the elements from
262 : !> \param elements will contain the vector of elements
263 : !> \param name the name for the new matrixes (optional)
264 : !> \par History
265 : !> 09.2002 created [fawzi]
266 : !> \author Fawzi Mohamed
267 : ! **************************************************************************************************
268 15534 : SUBROUTINE fm_pools_create_fm_m1_${shortname}$_${shortattr}$ (pools, elements, &
269 : name)
270 : TYPE(cp_fm_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
271 : TYPE(${typename}$), DIMENSION(:), ${attr}$ :: elements
272 : CHARACTER(len=*), INTENT(in), OPTIONAL :: name
273 :
274 : INTEGER :: i
275 : TYPE(cp_fm_pool_type), POINTER :: pool
276 :
277 15534 : NULLIFY (pool)
278 :
279 64779 : ALLOCATE (elements(SIZE(pools)))
280 33711 : DO i = 1, SIZE(pools)
281 18177 : pool => pools(i)%pool
282 : #:if typename=="cp_fm_p_type"
283 0 : ALLOCATE (elements(i)%matrix)
284 : #:endif
285 33711 : IF (PRESENT(name)) THEN
286 : CALL fm_pool_create_fm(pool, elements(i) ${appendix}$, &
287 18177 : name=name//"-"//ADJUSTL(cp_to_string(i)))
288 : ELSE
289 0 : CALL fm_pool_create_fm(pool, elements(i) ${appendix}$)
290 : END IF
291 :
292 : END DO
293 :
294 15534 : END SUBROUTINE fm_pools_create_fm_m1_${shortname}$_${shortattr}$
295 :
296 : ! **************************************************************************************************
297 : !> \brief returns a vector to the pools. The vector is deallocated
298 : !> (like cp_fm_vect_dealloc)
299 : !> \param pools the pool where to give back the vector
300 : !> \param elements the vector of elements to give back
301 : !> \par History
302 : !> 09.2002 created [fawzi]
303 : !> \author Fawzi Mohamed
304 : !> \note
305 : !> accept unassociated vect?
306 : ! **************************************************************************************************
307 3606 : SUBROUTINE fm_pools_give_back_fm_m1_${shortname}$_${shortattr}$ (pools, elements)
308 : TYPE(cp_fm_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
309 : TYPE(${typename}$), DIMENSION(:), ${attr}$ :: elements
310 :
311 : INTEGER :: i
312 :
313 3606 : IF (${create}$ (elements)) THEN
314 42 : CPASSERT(SIZE(pools) == SIZE(elements))
315 126 : DO i = 1, SIZE(pools)
316 : CALL fm_pool_give_back_fm(pools(i)%pool, &
317 126 : elements(i) ${appendix}$)
318 : #:if typename == "cp_fm_p_type"
319 0 : DEALLOCATE (elements(i)%matrix)
320 : #:endif
321 : END DO
322 42 : DEALLOCATE (elements)
323 : #:if attr == "POINTER"
324 : NULLIFY (elements)
325 : #:endif
326 : END IF
327 3606 : END SUBROUTINE fm_pools_give_back_fm_m1_${shortname}$_${shortattr}$
328 : #:endfor
329 : #:endfor
330 :
331 0 : END MODULE cp_fm_pool_types
|
