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 Manages a pool of grids (to be used for example as tmp objects),
10 : !> but can also be used to instantiate grids that are never given back.
11 : !>
12 : !> Multigrid pools are just an array of pw_pools
13 : !> \note
14 : !> The pool could also work without pointers (doing = each time),
15 : !> but I find it *very* ugly.
16 : !>
17 : !> The pool could be integrated into pw_grid_type, I don't know if
18 : !> it would be a good or bad idea (but would add a circular dependence
19 : !> between pw and pw_grid types).
20 : !> \par History
21 : !> 08.2002 created [fawzi]
22 : !> \author Fawzi Mohamed
23 : ! **************************************************************************************************
24 : MODULE pw_pool_types
25 : #:include 'pw_types.fypp'
26 : #:for kind in pw_kinds
27 : USE cp_linked_list_pw, ONLY: cp_sll_${kind[1:]}$_${kind[0]}$_dealloc, cp_sll_${kind[1:]}$_${kind[0]}$_get_first_el, &
28 : cp_sll_${kind[1:]}$_${kind[0]}$_get_length, &
29 : cp_sll_${kind[1:]}$_${kind[0]}$_insert_el, cp_sll_${kind[1:]}$_${kind[0]}$_next, &
30 : cp_sll_${kind[1:]}$_${kind[0]}$_rm_first_el, cp_sll_${kind[1:]}$_${kind[0]}$_type
31 : #:endfor
32 : USE kinds, ONLY: dp
33 : USE pw_grid_types, ONLY: pw_grid_type
34 : USE pw_grids, ONLY: pw_grid_compare, &
35 : pw_grid_release, &
36 : pw_grid_retain
37 : #:for space in pw_spaces
38 : #:for kind in pw_kinds
39 : USE pw_types, ONLY: pw_${kind}$_${space}$_type
40 : #:endfor
41 : #:endfor
42 : #include "../base/base_uses.f90"
43 :
44 : IMPLICIT NONE
45 : PRIVATE
46 :
47 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_pool_types'
48 : INTEGER, PARAMETER :: default_max_cache = 75, max_max_cache = 150
49 :
50 : PUBLIC :: pw_pool_type, pw_pool_p_type
51 : PUBLIC :: pw_pool_create, pw_pool_release
52 : PUBLIC :: pw_pools_copy, pw_pools_dealloc, &
53 : pw_pools_create_pws, pw_pools_give_back_pws
54 :
55 : ! **************************************************************************************************
56 : !> \brief Manages a pool of grids (to be used for example as tmp objects),
57 : !> but can also be used to instantiate grids that are never given back.
58 : !> \param ref_count reference count (see /cp2k/doc/ReferenceCounting.html)
59 : !> \param real 1d_array, c1d_array, complex3d_array: liked list with
60 : !> the cached grids of the corresponding type
61 : !> \note
62 : !> As of now I would like replace the linked lists by arrays
63 : !> (no annoying list elements that are allocated would show up when
64 : !> tracking leaks) [fawzi]
65 : !> \par History
66 : !> 08.2002 created [fawzi]
67 : !> \author Fawzi Mohamed
68 : ! **************************************************************************************************
69 : TYPE pw_pool_type
70 : INTEGER :: ref_count = 0, max_cache = 0
71 : TYPE(pw_grid_type), POINTER :: pw_grid => NULL()
72 : #:for kind in pw_kinds
73 : TYPE(cp_sll_${kind[1:]}$_${kind[0]}$_type), POINTER :: ${kind}$_array => NULL()
74 : #:endfor
75 : CONTAINS
76 : PROCEDURE, PUBLIC, NON_OVERRIDABLE :: retain => pw_pool_retain
77 : #:for space in pw_spaces
78 : #:for i, kind in enumerate(pw_kinds)
79 : PROCEDURE, PUBLIC, NON_OVERRIDABLE :: pw_pool_create_pw_${kind}$_${space}$
80 : GENERIC, PUBLIC :: create_pw => pw_pool_create_pw_${kind}$_${space}$
81 : PROCEDURE, PUBLIC, NON_OVERRIDABLE :: pw_pool_give_back_pw_${kind}$_${space}$
82 : GENERIC, PUBLIC :: give_back_pw => pw_pool_give_back_pw_${kind}$_${space}$
83 : #:endfor
84 : #:endfor
85 : PROCEDURE, PUBLIC, NON_OVERRIDABLE :: create_cr3d => pw_pool_create_cr3d
86 : PROCEDURE, PUBLIC, NON_OVERRIDABLE :: give_back_cr3d => pw_pool_give_back_cr3d
87 : END TYPE pw_pool_type
88 :
89 : ! **************************************************************************************************
90 : !> \brief to create arrays of pools
91 : !> \param pool the pool
92 : !> \par History
93 : !> 08.2002 created [fawzi]
94 : !> \author Fawzi Mohamed
95 : ! **************************************************************************************************
96 : TYPE pw_pool_p_type
97 : TYPE(pw_pool_type), POINTER :: pool => NULL()
98 : END TYPE pw_pool_p_type
99 :
100 : INTERFACE pw_pools_create_pws
101 : #:for space in pw_spaces
102 : #:for kind in pw_kinds
103 : MODULE PROCEDURE pw_pools_create_pws_${kind}$_${space}$
104 : #:endfor
105 : #:endfor
106 : END INTERFACE
107 :
108 : INTERFACE pw_pools_give_back_pws
109 : #:for space in pw_spaces
110 : #:for kind in pw_kinds
111 : MODULE PROCEDURE pw_pools_give_back_pws_${kind}$_${space}$
112 : #:endfor
113 : #:endfor
114 : END INTERFACE
115 :
116 : CONTAINS
117 :
118 : ! **************************************************************************************************
119 : !> \brief creates a pool for pw
120 : !> \param pool the pool to create
121 : !> \param pw_grid the grid that is used to create the pw
122 : !> \param max_cache ...
123 : !> \par History
124 : !> 08.2002 created [fawzi]
125 : !> \author Fawzi Mohamed
126 : ! **************************************************************************************************
127 98545 : SUBROUTINE pw_pool_create(pool, pw_grid, max_cache)
128 : TYPE(pw_pool_type), POINTER :: pool
129 : TYPE(pw_grid_type), POINTER :: pw_grid
130 : INTEGER, OPTIONAL :: max_cache
131 :
132 98545 : ALLOCATE (pool)
133 98545 : pool%pw_grid => pw_grid
134 98545 : CALL pw_grid_retain(pw_grid)
135 98545 : pool%ref_count = 1
136 98545 : pool%max_cache = default_max_cache
137 98545 : IF (PRESENT(max_cache)) pool%max_cache = max_cache
138 98545 : pool%max_cache = MIN(max_max_cache, pool%max_cache)
139 98545 : END SUBROUTINE pw_pool_create
140 :
141 : ! **************************************************************************************************
142 : !> \brief retains the pool (see cp2k/doc/ReferenceCounting.html)
143 : !> \param pool the pool to retain
144 : !> \par History
145 : !> 08.2002 created [fawzi]
146 : !> \author Fawzi Mohamed
147 : ! **************************************************************************************************
148 203001 : SUBROUTINE pw_pool_retain(pool)
149 : CLASS(pw_pool_type), INTENT(INOUT) :: pool
150 :
151 203001 : CPASSERT(pool%ref_count > 0)
152 :
153 203001 : pool%ref_count = pool%ref_count + 1
154 203001 : END SUBROUTINE pw_pool_retain
155 :
156 : ! **************************************************************************************************
157 : !> \brief deallocates all the cached grids
158 : !> \param pool the pool to flush
159 : !> \par History
160 : !> 08.2002 created [fawzi]
161 : !> \author Fawzi Mohamed
162 : ! **************************************************************************************************
163 98545 : SUBROUTINE pw_pool_flush_cache(pool)
164 : TYPE(pw_pool_type), INTENT(INOUT) :: pool
165 :
166 : #:for kind, type in zip(pw_kinds, pw_types)
167 98545 : ${type}$, CONTIGUOUS, POINTER :: ${kind}$_att
168 : TYPE(cp_sll_${kind[1:]}$_${kind[0]}$_type), POINTER :: ${kind}$_iterator
169 : #:endfor
170 :
171 : #:for kind in pw_kinds
172 394180 : NULLIFY (${kind}$_iterator, ${kind}$_att)
173 295635 : ${kind}$_iterator => pool%${kind}$_array
174 338518 : DO
175 732698 : IF (.NOT. cp_sll_${kind[1:]}$_${kind[0]}$_next(${kind}$_iterator, el_att=${kind}$_att)) EXIT
176 338518 : DEALLOCATE (${kind}$_att)
177 : END DO
178 394180 : CALL cp_sll_${kind[1:]}$_${kind[0]}$_dealloc(pool%${kind}$_array)
179 : #:endfor
180 :
181 98545 : END SUBROUTINE pw_pool_flush_cache
182 :
183 : ! **************************************************************************************************
184 : !> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
185 : !> \param pool the pool to release
186 : !> \par History
187 : !> 08.2002 created [fawzi]
188 : !> \author Fawzi Mohamed
189 : ! **************************************************************************************************
190 323919 : SUBROUTINE pw_pool_release(pool)
191 : TYPE(pw_pool_type), POINTER :: pool
192 :
193 323919 : IF (ASSOCIATED(pool)) THEN
194 301546 : CPASSERT(pool%ref_count > 0)
195 301546 : pool%ref_count = pool%ref_count - 1
196 301546 : IF (pool%ref_count == 0) THEN
197 98545 : CALL pw_pool_flush_cache(pool)
198 98545 : CALL pw_grid_release(pool%pw_grid)
199 :
200 98545 : DEALLOCATE (pool)
201 : END IF
202 : END IF
203 323919 : NULLIFY (pool)
204 323919 : END SUBROUTINE pw_pool_release
205 :
206 : #:for kind, type in zip(pw_kinds, pw_types)
207 : ! **************************************************************************************************
208 : !> \brief tries to pop an element from the given list (no error on failure)
209 : !> \param list the list to pop
210 : !> \return ...
211 : !> \par History
212 : !> 08.2002 created [fawzi]
213 : !> \author Fawzi Mohamed
214 : !> \note
215 : !> private function
216 : ! **************************************************************************************************
217 6952823 : FUNCTION try_pop_${kind}$ (list) RESULT(res)
218 : TYPE(cp_sll_${kind[1:]}$_${kind[0]}$_type), POINTER :: list
219 : ${type}$, CONTIGUOUS, POINTER :: res
220 :
221 6952823 : IF (ASSOCIATED(list)) THEN
222 6557928 : res => cp_sll_${kind[1:]}$_${kind[0]}$_get_first_el(list)
223 6557928 : CALL cp_sll_${kind[1:]}$_${kind[0]}$_rm_first_el(list)
224 : ELSE
225 394895 : NULLIFY (res)
226 : END IF
227 6952823 : END FUNCTION try_pop_${kind}$
228 :
229 : #:for space in pw_spaces
230 : ! **************************************************************************************************
231 : !> \brief returns a pw, allocating it if none is in the pool
232 : !> \param pool the pool from where you get the pw
233 : !> \param pw will contain the new pw
234 : !> \par History
235 : !> 08.2002 created [fawzi]
236 : !> \author Fawzi Mohamed
237 : ! **************************************************************************************************
238 6952823 : SUBROUTINE pw_pool_create_pw_${kind}$_${space}$ (pool, pw)
239 : CLASS(pw_pool_type), INTENT(IN) :: pool
240 : TYPE(pw_${kind}$_${space}$_type), INTENT(OUT) :: pw
241 :
242 : CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
243 :
244 : INTEGER :: handle
245 6952823 : ${type}$, CONTIGUOUS, POINTER :: array_ptr
246 :
247 6952823 : CALL timeset(routineN, handle)
248 6952823 : NULLIFY (array_ptr)
249 :
250 6952823 : array_ptr => try_pop_${kind}$ (pool%${kind}$_array)
251 6952823 : CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
252 :
253 6952823 : CALL timestop(handle)
254 :
255 6952823 : END SUBROUTINE pw_pool_create_pw_${kind}$_${space}$
256 :
257 : ! **************************************************************************************************
258 : !> \brief returns the pw to the pool
259 : !> \param pool the pool where to reintegrate the pw
260 : !> \param pw the pw to give back
261 : !> \par History
262 : !> 08.2002 created [fawzi]
263 : !> \author Fawzi Mohamed
264 : ! **************************************************************************************************
265 7541135 : SUBROUTINE pw_pool_give_back_pw_${kind}$_${space}$ (pool, pw)
266 : CLASS(pw_pool_type), INTENT(IN) :: pool
267 : TYPE(pw_${kind}$_${space}$_type), INTENT(INOUT) :: pw
268 :
269 : CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
270 :
271 : INTEGER :: handle
272 :
273 7541135 : CALL timeset(routineN, handle)
274 7541135 : IF (ASSOCIATED(pw%pw_grid)) THEN
275 7186104 : IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
276 7186100 : IF (ASSOCIATED(pw%array)) THEN
277 6691011 : IF (cp_sll_${kind[1:]}$_${kind[0]}$_get_length(pool%${kind}$_array) < pool%max_cache) THEN
278 6691011 : CALL cp_sll_${kind[1:]}$_${kind[0]}$_insert_el(pool%${kind}$_array, el=pw%array)
279 6691011 : NULLIFY (pw%array)
280 : ELSE IF (max_max_cache >= 0) THEN
281 0 : CPWARN("hit max_cache")
282 : END IF
283 : END IF
284 : END IF
285 : END IF
286 7541135 : CALL pw%release()
287 7541135 : CALL timestop(handle)
288 7541135 : END SUBROUTINE pw_pool_give_back_pw_${kind}$_${space}$
289 :
290 : ! **************************************************************************************************
291 : !> \brief creates a multigrid structure
292 : !> \param pools the multigrid pool (i.e. an array of pw_pool)
293 : !> \param pws the multigrid of coefficent you want to initialize
294 : !> \par History
295 : !> 07.2004 created [fawzi]
296 : !> \author Fawzi Mohamed
297 : ! **************************************************************************************************
298 985622 : SUBROUTINE pw_pools_create_pws_${kind}$_${space}$ (pools, pws)
299 : TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
300 : TYPE(pw_${kind}$_${space}$_type), ALLOCATABLE, DIMENSION(:), &
301 : INTENT(OUT) :: pws
302 :
303 : INTEGER :: i
304 :
305 6864042 : ALLOCATE (pws(SIZE(pools)))
306 4892798 : DO i = 1, SIZE(pools)
307 4892798 : CALL pw_pool_create_pw_${kind}$_${space}$ (pools(i)%pool, pws(i))
308 : END DO
309 985622 : END SUBROUTINE pw_pools_create_pws_${kind}$_${space}$
310 :
311 : ! **************************************************************************************************
312 : !> \brief returns the pw part of the coefficients into the pools
313 : !> \param pools the pools that will cache the pws %pw
314 : !> \param pws the coefficients to give back
315 : !> \par History
316 : !> 08.2002 created [fawzi]
317 : !> \author Fawzi Mohamed
318 : ! **************************************************************************************************
319 985622 : SUBROUTINE pw_pools_give_back_pws_${kind}$_${space}$ (pools, pws)
320 : TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
321 : TYPE(pw_${kind}$_${space}$_type), ALLOCATABLE, DIMENSION(:), &
322 : INTENT(INOUT) :: pws
323 :
324 : INTEGER :: i
325 :
326 985622 : CPASSERT(SIZE(pws) == SIZE(pools))
327 4892798 : DO i = 1, SIZE(pools)
328 4892798 : CALL pw_pool_give_back_pw_${kind}$_${space}$ (pools(i)%pool, pws(i))
329 : END DO
330 985622 : DEALLOCATE (pws)
331 985622 : END SUBROUTINE pw_pools_give_back_pws_${kind}$_${space}$
332 : #:endfor
333 : #:endfor
334 :
335 : ! **************************************************************************************************
336 : !> \brief returns a 3d real array of coefficients as the one used by pw with
337 : !> REALDATA3D, allocating it if none is present in the pool
338 : !> \param pw_pool the pool that caches the cr3d
339 : !> \param cr3d the pointer that will contain the array
340 : !> \par History
341 : !> 11.2003 created [fawzi]
342 : !> \author fawzi
343 : ! **************************************************************************************************
344 733411 : SUBROUTINE pw_pool_create_cr3d(pw_pool, cr3d)
345 : CLASS(pw_pool_type), INTENT(IN) :: pw_pool
346 : REAL(kind=dp), DIMENSION(:, :, :), POINTER :: cr3d
347 :
348 733411 : IF (ASSOCIATED(pw_pool%r3d_array)) THEN
349 442647 : cr3d => cp_sll_3d_r_get_first_el(pw_pool%r3d_array)
350 442647 : CALL cp_sll_3d_r_rm_first_el(pw_pool%r3d_array)
351 : END IF
352 733411 : IF (.NOT. ASSOCIATED(cr3d)) THEN
353 : ALLOCATE (cr3d(pw_pool%pw_grid%bounds_local(1, 1):pw_pool%pw_grid%bounds_local(2, 1), &
354 : pw_pool%pw_grid%bounds_local(1, 2):pw_pool%pw_grid%bounds_local(2, 2), &
355 1453820 : pw_pool%pw_grid%bounds_local(1, 3):pw_pool%pw_grid%bounds_local(2, 3)))
356 : END IF
357 733411 : END SUBROUTINE pw_pool_create_cr3d
358 :
359 : ! **************************************************************************************************
360 : !> \brief returns a 3d real array of coefficients as the one used by pw with
361 : !> REALDATA3D, allocating it if none is present in the pool
362 : !> \param pw_pool the pool that caches the cr3d
363 : !> \param cr3d the pointer that will contain the array
364 : !> \par History
365 : !> 11.2003 created [fawzi]
366 : !> \author fawzi
367 : ! **************************************************************************************************
368 4851227 : SUBROUTINE pw_pool_give_back_cr3d(pw_pool, cr3d)
369 : CLASS(pw_pool_type), INTENT(IN) :: pw_pool
370 : REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
371 : POINTER :: cr3d
372 :
373 : LOGICAL :: compatible
374 :
375 4851227 : IF (ASSOCIATED(cr3d)) THEN
376 : compatible = ALL(MERGE(pw_pool%pw_grid%bounds_local(1, :) == LBOUND(cr3d) .AND. &
377 : pw_pool%pw_grid%bounds_local(2, :) == UBOUND(cr3d), &
378 : pw_pool%pw_grid%bounds_local(2, :) < pw_pool%pw_grid%bounds_local(1, :), &
379 7128946 : UBOUND(cr3d) >= LBOUND(cr3d)))
380 648086 : IF (compatible) THEN
381 648086 : IF (cp_sll_3d_r_get_length(pw_pool%r3d_array) < pw_pool%max_cache) THEN
382 648082 : CALL cp_sll_3d_r_insert_el(pw_pool%r3d_array, el=cr3d)
383 : ELSE
384 4 : CPWARN_IF(max_max_cache >= 0, "hit max_cache")
385 4 : DEALLOCATE (cr3d)
386 : END IF
387 : ELSE
388 0 : DEALLOCATE (cr3d)
389 : END IF
390 : END IF
391 4851227 : NULLIFY (cr3d)
392 4851227 : END SUBROUTINE pw_pool_give_back_cr3d
393 :
394 : ! **************************************************************************************************
395 : !> \brief copies a multigrid pool, the underlying pools are shared
396 : !> \param source_pools the pools to copy
397 : !> \param target_pools will hold the copy of the pools
398 : !> \par History
399 : !> 08.2002 created [fawzi]
400 : !> \author Fawzi Mohamed
401 : ! **************************************************************************************************
402 12110 : SUBROUTINE pw_pools_copy(source_pools, target_pools)
403 : TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: source_pools
404 : TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: target_pools
405 :
406 : INTEGER :: i
407 :
408 68504 : ALLOCATE (target_pools(SIZE(source_pools)))
409 44284 : DO i = 1, SIZE(source_pools)
410 32174 : target_pools(i)%pool => source_pools(i)%pool
411 44284 : CALL source_pools(i)%pool%retain()
412 : END DO
413 12110 : END SUBROUTINE pw_pools_copy
414 :
415 : ! **************************************************************************************************
416 : !> \brief deallocates the given pools (releasing each of the underlying
417 : !> pools)
418 : !> \param pools the pols to deallocate
419 : !> \par History
420 : !> 08.2002 created [fawzi]
421 : !> \author Fawzi Mohamed
422 : ! **************************************************************************************************
423 41578 : SUBROUTINE pw_pools_dealloc(pools)
424 : TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pools
425 :
426 : INTEGER :: i
427 :
428 41578 : IF (ASSOCIATED(pools)) THEN
429 85068 : DO i = 1, SIZE(pools)
430 85068 : CALL pw_pool_release(pools(i)%pool)
431 : END DO
432 22090 : DEALLOCATE (pools)
433 : END IF
434 41578 : NULLIFY (pools)
435 41578 : END SUBROUTINE pw_pools_dealloc
436 :
437 0 : END MODULE pw_pool_types
|
