Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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, fm_pool_retain, &
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 ref_count reference count (see /cp2k/doc/ReferenceCounting.html)
50 : !> \param el_struct the structure of the elements stored in this pool
51 : !> \param cache linked list with the elements in the pool
52 : !> \par History
53 : !> 08.2002 created [fawzi]
54 : !> \author Fawzi Mohamed
55 : ! **************************************************************************************************
56 : TYPE cp_fm_pool_type
57 : PRIVATE
58 : INTEGER :: ref_count = -1
59 : TYPE(cp_fm_struct_type), POINTER :: el_struct => NULL()
60 : TYPE(cp_sll_fm_type), POINTER :: cache => NULL()
61 : END TYPE cp_fm_pool_type
62 :
63 : ! **************************************************************************************************
64 : !> \brief to create arrays of pools
65 : !> \param pool the pool
66 : !> \par History
67 : !> 08.2002 created [fawzi]
68 : !> \author Fawzi Mohamed
69 : ! **************************************************************************************************
70 : TYPE cp_fm_pool_p_type
71 : TYPE(cp_fm_pool_type), POINTER :: pool => NULL()
72 : END TYPE cp_fm_pool_p_type
73 :
74 : INTERFACE fm_pools_create_fm_vect
75 : MODULE PROCEDURE fm_pools_create_fm_m1_p_type_pointer
76 : MODULE PROCEDURE fm_pools_create_fm_m1_p_type_alloc
77 : MODULE PROCEDURE fm_pools_create_fm_m1_array_pointer
78 : MODULE PROCEDURE fm_pools_create_fm_m1_array_alloc
79 : END INTERFACE
80 :
81 : INTERFACE fm_pools_give_back_fm_vect
82 : MODULE PROCEDURE fm_pools_give_back_fm_m1_p_type_pointer
83 : MODULE PROCEDURE fm_pools_give_back_fm_m1_p_type_alloc
84 : MODULE PROCEDURE fm_pools_give_back_fm_m1_array_pointer
85 : MODULE PROCEDURE fm_pools_give_back_fm_m1_array_alloc
86 : END INTERFACE
87 :
88 : CONTAINS
89 :
90 : ! **************************************************************************************************
91 : !> \brief creates a pool of elements
92 : !> \param pool the pool to create
93 : !> \param el_struct the structure of the elements that are stored in
94 : !> this pool
95 : !> \par History
96 : !> 08.2002 created [fawzi]
97 : !> \author Fawzi Mohamed
98 : ! **************************************************************************************************
99 24864 : SUBROUTINE fm_pool_create(pool, el_struct)
100 : TYPE(cp_fm_pool_type), POINTER :: pool
101 : TYPE(cp_fm_struct_type), TARGET :: el_struct
102 :
103 24864 : ALLOCATE (pool)
104 24864 : pool%el_struct => el_struct
105 24864 : CALL cp_fm_struct_retain(pool%el_struct)
106 24864 : pool%ref_count = 1
107 :
108 24864 : END SUBROUTINE fm_pool_create
109 :
110 : ! **************************************************************************************************
111 : !> \brief retains the pool (see cp2k/doc/ReferenceCounting.html)
112 : !> \param pool the pool to retain
113 : !> \par History
114 : !> 08.2002 created [fawzi]
115 : !> \author Fawzi Mohamed
116 : ! **************************************************************************************************
117 3215 : SUBROUTINE fm_pool_retain(pool)
118 : TYPE(cp_fm_pool_type), INTENT(INOUT) :: pool
119 :
120 3215 : CPASSERT(pool%ref_count > 0)
121 :
122 3215 : pool%ref_count = pool%ref_count + 1
123 3215 : END SUBROUTINE fm_pool_retain
124 :
125 : ! **************************************************************************************************
126 : !> \brief deallocates all the cached elements
127 : !> \param pool the pool to flush
128 : !> \par History
129 : !> 08.2002 created [fawzi]
130 : !> \author Fawzi Mohamed
131 : ! **************************************************************************************************
132 24864 : SUBROUTINE fm_pool_flush_cache(pool)
133 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
134 :
135 : TYPE(cp_fm_type), POINTER :: el_att
136 : TYPE(cp_sll_fm_type), POINTER :: iterator
137 :
138 24864 : iterator => pool%cache
139 47652 : DO
140 72516 : IF (.NOT. cp_sll_fm_next(iterator, el_att=el_att)) EXIT
141 47652 : CALL cp_fm_release(el_att)
142 47652 : DEALLOCATE (el_att)
143 24864 : NULLIFY (el_att)
144 : END DO
145 24864 : CALL cp_sll_fm_dealloc(pool%cache)
146 24864 : END SUBROUTINE fm_pool_flush_cache
147 :
148 : ! **************************************************************************************************
149 : !> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
150 : !> \param pool the pool to release
151 : !> \par History
152 : !> 08.2002 created [fawzi]
153 : !> \author Fawzi Mohamed
154 : ! **************************************************************************************************
155 54950 : SUBROUTINE fm_pool_release(pool)
156 : TYPE(cp_fm_pool_type), POINTER :: pool
157 :
158 54950 : IF (ASSOCIATED(pool)) THEN
159 28079 : CPASSERT(pool%ref_count > 0)
160 28079 : pool%ref_count = pool%ref_count - 1
161 28079 : IF (pool%ref_count == 0) THEN
162 24864 : pool%ref_count = 1
163 24864 : CALL fm_pool_flush_cache(pool)
164 24864 : CALL cp_fm_struct_release(pool%el_struct)
165 24864 : pool%ref_count = 0
166 :
167 24864 : DEALLOCATE (pool)
168 : END IF
169 : END IF
170 54950 : NULLIFY (pool)
171 54950 : END SUBROUTINE fm_pool_release
172 :
173 : ! **************************************************************************************************
174 : !> \brief returns an element, allocating it if none is in the pool
175 : !> \param pool the pool from where you get the element
176 : !> \param element will contain the new element
177 : !>\param name the name for the new matrix (optional)
178 : !> \param name ...
179 : !> \par History
180 : !> 08.2002 created [fawzi]
181 : !> \author Fawzi Mohamed
182 : ! **************************************************************************************************
183 91182 : SUBROUTINE fm_pool_create_fm(pool, element, &
184 : name)
185 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
186 : TYPE(cp_fm_type), INTENT(OUT) :: element
187 : CHARACTER(len=*), INTENT(in), OPTIONAL :: name
188 :
189 : TYPE(cp_fm_type), POINTER :: el
190 :
191 91182 : NULLIFY (el)
192 91182 : IF (ASSOCIATED(pool%cache)) THEN
193 9006 : el => cp_sll_fm_get_first_el(pool%cache)
194 9006 : CALL cp_sll_fm_rm_first_el(pool%cache)
195 : END IF
196 9006 : IF (ASSOCIATED(el)) THEN
197 9006 : element = el
198 9006 : DEALLOCATE (el)
199 : ELSE
200 82176 : CALL cp_fm_create(element, matrix_struct=pool%el_struct)
201 : END IF
202 :
203 91182 : IF (PRESENT(name)) THEN
204 30076 : element%name = name
205 : ELSE
206 61106 : element%name = "tmp"
207 : END IF
208 :
209 91182 : END SUBROUTINE fm_pool_create_fm
210 :
211 : ! **************************************************************************************************
212 : !> \brief returns the element to the pool
213 : !> \param pool the pool where to cache the element
214 : !> \param element the element to give back
215 : !> \par History
216 : !> 08.2002 created [fawzi]
217 : !> \author Fawzi Mohamed
218 : !> \note
219 : !> transfers the ownership of the element to the pool
220 : !> (it is as if you had called cp_fm_release)
221 : !> Accept give_backs of non associated elements?
222 : ! **************************************************************************************************
223 56658 : SUBROUTINE fm_pool_give_back_fm(pool, element)
224 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
225 : TYPE(cp_fm_type), INTENT(INOUT) :: element
226 :
227 56658 : IF (.NOT. ASSOCIATED(pool%el_struct, element%matrix_struct)) THEN
228 0 : CALL cp_fm_release(element)
229 : ELSE
230 : BLOCK
231 : TYPE(cp_fm_type), POINTER :: el
232 56658 : ALLOCATE (el)
233 56658 : el = element
234 56658 : CALL cp_sll_fm_insert_el(pool%cache, el=el)
235 56658 : NULLIFY (element%matrix_struct, element%local_data, element%local_data_sp)
236 : END BLOCK
237 : END IF
238 56658 : END SUBROUTINE fm_pool_give_back_fm
239 :
240 : ! **************************************************************************************************
241 : !> \brief returns the structure of the elements in this pool
242 : !> \param pool the pool you are interested in
243 : !> \return ...
244 : !> \par History
245 : !> 05.2002 created [fawzi]
246 : !> \author Fawzi Mohamed
247 : ! **************************************************************************************************
248 20527 : FUNCTION fm_pool_get_el_struct(pool) RESULT(res)
249 : TYPE(cp_fm_pool_type), INTENT(IN) :: pool
250 : TYPE(cp_fm_struct_type), POINTER :: res
251 :
252 20527 : res => pool%el_struct
253 20527 : END FUNCTION fm_pool_get_el_struct
254 :
255 : !================== pools ================
256 :
257 : ! **************************************************************************************************
258 : !> \brief shallow copy of an array of pools (retains each pool)
259 : !> \param source_pools the pools to copy
260 : !> \param target_pools will contains the new pools
261 : !> \par History
262 : !> 11.2002 created [fawzi]
263 : !> \author Fawzi Mohamed
264 : ! **************************************************************************************************
265 0 : SUBROUTINE fm_pools_copy(source_pools, target_pools)
266 : TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: source_pools, target_pools
267 :
268 : INTEGER :: i
269 :
270 0 : CPASSERT(ASSOCIATED(source_pools))
271 0 : ALLOCATE (target_pools(SIZE(source_pools)))
272 0 : DO i = 1, SIZE(source_pools)
273 0 : target_pools(i)%pool => source_pools(i)%pool
274 0 : CALL fm_pool_retain(source_pools(i)%pool)
275 : END DO
276 0 : END SUBROUTINE fm_pools_copy
277 :
278 : ! **************************************************************************************************
279 : !> \brief deallocate an array of pools (releasing each pool)
280 : !> \param pools the pools to release
281 : !> \par History
282 : !> 11.2002 created [fawzi]
283 : !> \author Fawzi Mohamed
284 : ! **************************************************************************************************
285 21990 : SUBROUTINE fm_pools_dealloc(pools)
286 : TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: pools
287 :
288 : INTEGER :: i
289 :
290 21990 : IF (ASSOCIATED(pools)) THEN
291 48861 : DO i = 1, SIZE(pools)
292 48861 : CALL fm_pool_release(pools(i)%pool)
293 : END DO
294 21990 : DEALLOCATE (pools)
295 : END IF
296 21990 : END SUBROUTINE fm_pools_dealloc
297 :
298 : #:mute
299 : #:set types = [("cp_fm_type", "array", ""), ("cp_fm_p_type", "p_type","%matrix")]
300 : #:set attributes = [("ALLOCATABLE", "alloc", "ALLOCATED"), ("POINTER", "pointer", "ASSOCIATED")]
301 : #:endmute
302 :
303 : #:for typename, shortname, appendix in types
304 : #:for attr, shortattr, create in attributes
305 : ! **************************************************************************************************
306 : !> \brief Returns a vector with an element from each pool
307 : !> \param pools the pools to create the elements from
308 : !> \param elements will contain the vector of elements
309 : !> \param name the name for the new matrixes (optional)
310 : !> \par History
311 : !> 09.2002 created [fawzi]
312 : !> \author Fawzi Mohamed
313 : ! **************************************************************************************************
314 15368 : SUBROUTINE fm_pools_create_fm_m1_${shortname}$_${shortattr}$ (pools, elements, &
315 : name)
316 : TYPE(cp_fm_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
317 : TYPE(${typename}$), DIMENSION(:), ${attr}$ :: elements
318 : CHARACTER(len=*), INTENT(in), OPTIONAL :: name
319 :
320 : INTEGER :: i
321 : TYPE(cp_fm_pool_type), POINTER :: pool
322 :
323 15368 : NULLIFY (pool)
324 :
325 64221 : ALLOCATE (elements(SIZE(pools)))
326 33485 : DO i = 1, SIZE(pools)
327 18117 : pool => pools(i)%pool
328 : #:if typename=="cp_fm_p_type"
329 0 : ALLOCATE (elements(i)%matrix)
330 : #:endif
331 33485 : IF (PRESENT(name)) THEN
332 : CALL fm_pool_create_fm(pool, elements(i) ${appendix}$, &
333 18117 : name=name//"-"//ADJUSTL(cp_to_string(i)))
334 : ELSE
335 0 : CALL fm_pool_create_fm(pool, elements(i) ${appendix}$)
336 : END IF
337 :
338 : END DO
339 :
340 15368 : END SUBROUTINE fm_pools_create_fm_m1_${shortname}$_${shortattr}$
341 :
342 : ! **************************************************************************************************
343 : !> \brief returns a vector to the pools. The vector is deallocated
344 : !> (like cp_fm_vect_dealloc)
345 : !> \param pools the pool where to give back the vector
346 : !> \param elements the vector of elements to give back
347 : !> \par History
348 : !> 09.2002 created [fawzi]
349 : !> \author Fawzi Mohamed
350 : !> \note
351 : !> accept unassociated vect?
352 : ! **************************************************************************************************
353 616 : SUBROUTINE fm_pools_give_back_fm_m1_${shortname}$_${shortattr}$ (pools, elements)
354 : TYPE(cp_fm_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
355 : TYPE(${typename}$), DIMENSION(:), ${attr}$ :: elements
356 :
357 : INTEGER :: i
358 :
359 616 : IF (${create}$ (elements)) THEN
360 42 : CPASSERT(SIZE(pools) == SIZE(elements))
361 126 : DO i = 1, SIZE(pools)
362 : CALL fm_pool_give_back_fm(pools(i)%pool, &
363 126 : elements(i) ${appendix}$)
364 : #:if typename == "cp_fm_p_type"
365 0 : DEALLOCATE (elements(i)%matrix)
366 : #:endif
367 : END DO
368 42 : DEALLOCATE (elements)
369 : #:if attr == "POINTER"
370 : NULLIFY (elements)
371 : #:endif
372 : END IF
373 616 : END SUBROUTINE fm_pools_give_back_fm_m1_${shortname}$_${shortattr}$
374 : #:endfor
375 : #:endfor
376 :
377 0 : END MODULE cp_fm_pool_types
|
