(git:d18deda)
Loading...
Searching...
No Matches
pw_pool_types.F
Go to the documentation of this file.
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! **************************************************************************************************
24MODULE pw_pool_types
25
26
27 USE cp_linked_list_pw, ONLY: cp_sll_1d_r_dealloc, cp_sll_1d_r_get_first_el, &
28 cp_sll_1d_r_get_length, &
29 cp_sll_1d_r_insert_el, cp_sll_1d_r_next, &
30 cp_sll_1d_r_rm_first_el, cp_sll_1d_r_type
31 USE cp_linked_list_pw, ONLY: cp_sll_3d_r_dealloc, cp_sll_3d_r_get_first_el, &
32 cp_sll_3d_r_get_length, &
33 cp_sll_3d_r_insert_el, cp_sll_3d_r_next, &
34 cp_sll_3d_r_rm_first_el, cp_sll_3d_r_type
35 USE cp_linked_list_pw, ONLY: cp_sll_1d_c_dealloc, cp_sll_1d_c_get_first_el, &
36 cp_sll_1d_c_get_length, &
37 cp_sll_1d_c_insert_el, cp_sll_1d_c_next, &
38 cp_sll_1d_c_rm_first_el, cp_sll_1d_c_type
39 USE cp_linked_list_pw, ONLY: cp_sll_3d_c_dealloc, cp_sll_3d_c_get_first_el, &
40 cp_sll_3d_c_get_length, &
41 cp_sll_3d_c_insert_el, cp_sll_3d_c_next, &
42 cp_sll_3d_c_rm_first_el, cp_sll_3d_c_type
43 USE kinds, ONLY: dp
44 USE pw_grid_types, ONLY: pw_grid_type
45 USE pw_grids, ONLY: pw_grid_compare, &
46 pw_grid_release, &
47 pw_grid_retain
48 USE pw_types, ONLY: pw_r1d_rs_type
49 USE pw_types, ONLY: pw_r3d_rs_type
50 USE pw_types, ONLY: pw_c1d_rs_type
51 USE pw_types, ONLY: pw_c3d_rs_type
52 USE pw_types, ONLY: pw_r1d_gs_type
53 USE pw_types, ONLY: pw_r3d_gs_type
54 USE pw_types, ONLY: pw_c1d_gs_type
55 USE pw_types, ONLY: pw_c3d_gs_type
56#include "../base/base_uses.f90"
57
58 IMPLICIT NONE
59 PRIVATE
60
61 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_pool_types'
62 INTEGER, PARAMETER :: default_max_cache = 75, max_max_cache = 150
63
64 PUBLIC :: pw_pool_type, pw_pool_p_type
65 PUBLIC :: pw_pool_create, pw_pool_release
66 PUBLIC :: pw_pools_copy, pw_pools_dealloc, &
67 pw_pools_create_pws, pw_pools_give_back_pws
68
69! **************************************************************************************************
70!> \brief Manages a pool of grids (to be used for example as tmp objects),
71!> but can also be used to instantiate grids that are never given back.
72!> \param ref_count reference count (see /cp2k/doc/ReferenceCounting.html)
73!> \param real 1d_array, c1d_array, complex3d_array: liked list with
74!> the cached grids of the corresponding type
75!> \note
76!> As of now I would like replace the linked lists by arrays
77!> (no annoying list elements that are allocated would show up when
78!> tracking leaks) [fawzi]
79!> \par History
80!> 08.2002 created [fawzi]
81!> \author Fawzi Mohamed
82! **************************************************************************************************
83 TYPE pw_pool_type
84 INTEGER :: ref_count = 0, max_cache = 0
85 TYPE(pw_grid_type), POINTER :: pw_grid => null()
86 TYPE(cp_sll_1d_r_type), POINTER :: r1d_array => null()
87 TYPE(cp_sll_3d_r_type), POINTER :: r3d_array => null()
88 TYPE(cp_sll_1d_c_type), POINTER :: c1d_array => null()
89 TYPE(cp_sll_3d_c_type), POINTER :: c3d_array => null()
90 CONTAINS
91 PROCEDURE, PUBLIC, non_overridable :: retain => pw_pool_retain
92 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_r1d_rs
93 generic, PUBLIC :: create_pw => pw_pool_create_pw_r1d_rs
94 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_r1d_rs
95 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_r1d_rs
96 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_r3d_rs
97 generic, PUBLIC :: create_pw => pw_pool_create_pw_r3d_rs
98 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_r3d_rs
99 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_r3d_rs
100 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_c1d_rs
101 generic, PUBLIC :: create_pw => pw_pool_create_pw_c1d_rs
102 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_c1d_rs
103 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_c1d_rs
104 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_c3d_rs
105 generic, PUBLIC :: create_pw => pw_pool_create_pw_c3d_rs
106 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_c3d_rs
107 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_c3d_rs
108 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_r1d_gs
109 generic, PUBLIC :: create_pw => pw_pool_create_pw_r1d_gs
110 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_r1d_gs
111 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_r1d_gs
112 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_r3d_gs
113 generic, PUBLIC :: create_pw => pw_pool_create_pw_r3d_gs
114 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_r3d_gs
115 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_r3d_gs
116 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_c1d_gs
117 generic, PUBLIC :: create_pw => pw_pool_create_pw_c1d_gs
118 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_c1d_gs
119 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_c1d_gs
120 PROCEDURE, PUBLIC, non_overridable :: pw_pool_create_pw_c3d_gs
121 generic, PUBLIC :: create_pw => pw_pool_create_pw_c3d_gs
122 PROCEDURE, PUBLIC, non_overridable :: pw_pool_give_back_pw_c3d_gs
123 generic, PUBLIC :: give_back_pw => pw_pool_give_back_pw_c3d_gs
124 PROCEDURE, PUBLIC, non_overridable :: create_cr3d => pw_pool_create_cr3d
125 PROCEDURE, PUBLIC, non_overridable :: give_back_cr3d => pw_pool_give_back_cr3d
126 END TYPE pw_pool_type
127
128! **************************************************************************************************
129!> \brief to create arrays of pools
130!> \param pool the pool
131!> \par History
132!> 08.2002 created [fawzi]
133!> \author Fawzi Mohamed
134! **************************************************************************************************
135 TYPE pw_pool_p_type
136 TYPE(pw_pool_type), POINTER :: pool => null()
137 END TYPE pw_pool_p_type
138
139 INTERFACE pw_pools_create_pws
140 MODULE PROCEDURE pw_pools_create_pws_r1d_rs
141 MODULE PROCEDURE pw_pools_create_pws_r3d_rs
142 MODULE PROCEDURE pw_pools_create_pws_c1d_rs
143 MODULE PROCEDURE pw_pools_create_pws_c3d_rs
144 MODULE PROCEDURE pw_pools_create_pws_r1d_gs
145 MODULE PROCEDURE pw_pools_create_pws_r3d_gs
146 MODULE PROCEDURE pw_pools_create_pws_c1d_gs
147 MODULE PROCEDURE pw_pools_create_pws_c3d_gs
148 END INTERFACE
149
150 INTERFACE pw_pools_give_back_pws
151 MODULE PROCEDURE pw_pools_give_back_pws_r1d_rs
152 MODULE PROCEDURE pw_pools_give_back_pws_r3d_rs
153 MODULE PROCEDURE pw_pools_give_back_pws_c1d_rs
154 MODULE PROCEDURE pw_pools_give_back_pws_c3d_rs
155 MODULE PROCEDURE pw_pools_give_back_pws_r1d_gs
156 MODULE PROCEDURE pw_pools_give_back_pws_r3d_gs
157 MODULE PROCEDURE pw_pools_give_back_pws_c1d_gs
158 MODULE PROCEDURE pw_pools_give_back_pws_c3d_gs
159 END INTERFACE
160
161CONTAINS
162
163! **************************************************************************************************
164!> \brief creates a pool for pw
165!> \param pool the pool to create
166!> \param pw_grid the grid that is used to create the pw
167!> \param max_cache ...
168!> \par History
169!> 08.2002 created [fawzi]
170!> \author Fawzi Mohamed
171! **************************************************************************************************
172 SUBROUTINE pw_pool_create(pool, pw_grid, max_cache)
173 TYPE(pw_pool_type), POINTER :: pool
174 TYPE(pw_grid_type), POINTER :: pw_grid
175 INTEGER, OPTIONAL :: max_cache
176
177 ALLOCATE (pool)
178 pool%pw_grid => pw_grid
179 CALL pw_grid_retain(pw_grid)
180 pool%ref_count = 1
181 pool%max_cache = default_max_cache
182 IF (PRESENT(max_cache)) pool%max_cache = max_cache
183 pool%max_cache = min(max_max_cache, pool%max_cache)
184 END SUBROUTINE pw_pool_create
185
186! **************************************************************************************************
187!> \brief retains the pool (see cp2k/doc/ReferenceCounting.html)
188!> \param pool the pool to retain
189!> \par History
190!> 08.2002 created [fawzi]
191!> \author Fawzi Mohamed
192! **************************************************************************************************
193 SUBROUTINE pw_pool_retain(pool)
194 CLASS(pw_pool_type), INTENT(INOUT) :: pool
195
196 cpassert(pool%ref_count > 0)
197
198 pool%ref_count = pool%ref_count + 1
199 END SUBROUTINE pw_pool_retain
200
201! **************************************************************************************************
202!> \brief deallocates all the cached grids
203!> \param pool the pool to flush
204!> \par History
205!> 08.2002 created [fawzi]
206!> \author Fawzi Mohamed
207! **************************************************************************************************
208 SUBROUTINE pw_pool_flush_cache(pool)
209 TYPE(pw_pool_type), INTENT(INOUT) :: pool
210
211 REAL(kind=dp), DIMENSION(:), CONTIGUOUS, POINTER :: r1d_att
212 TYPE(cp_sll_1d_r_type), POINTER :: r1d_iterator
213 REAL(kind=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: r3d_att
214 TYPE(cp_sll_3d_r_type), POINTER :: r3d_iterator
215 COMPLEX(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: c1d_att
216 TYPE(cp_sll_1d_c_type), POINTER :: c1d_iterator
217 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: c3d_att
218 TYPE(cp_sll_3d_c_type), POINTER :: c3d_iterator
219
220 NULLIFY (r1d_iterator, r1d_att)
221 r1d_iterator => pool%r1d_array
222 DO
223 IF (.NOT. cp_sll_1d_r_next(r1d_iterator, el_att=r1d_att)) EXIT
224 DEALLOCATE (r1d_att)
225 END DO
226 CALL cp_sll_1d_r_dealloc(pool%r1d_array)
227 NULLIFY (r3d_iterator, r3d_att)
228 r3d_iterator => pool%r3d_array
229 DO
230 IF (.NOT. cp_sll_3d_r_next(r3d_iterator, el_att=r3d_att)) EXIT
231 DEALLOCATE (r3d_att)
232 END DO
233 CALL cp_sll_3d_r_dealloc(pool%r3d_array)
234 NULLIFY (c1d_iterator, c1d_att)
235 c1d_iterator => pool%c1d_array
236 DO
237 IF (.NOT. cp_sll_1d_c_next(c1d_iterator, el_att=c1d_att)) EXIT
238 DEALLOCATE (c1d_att)
239 END DO
240 CALL cp_sll_1d_c_dealloc(pool%c1d_array)
241 NULLIFY (c3d_iterator, c3d_att)
242 c3d_iterator => pool%c3d_array
243 DO
244 IF (.NOT. cp_sll_3d_c_next(c3d_iterator, el_att=c3d_att)) EXIT
245 DEALLOCATE (c3d_att)
246 END DO
247 CALL cp_sll_3d_c_dealloc(pool%c3d_array)
248
249 END SUBROUTINE pw_pool_flush_cache
250
251! **************************************************************************************************
252!> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
253!> \param pool the pool to release
254!> \par History
255!> 08.2002 created [fawzi]
256!> \author Fawzi Mohamed
257! **************************************************************************************************
258 SUBROUTINE pw_pool_release(pool)
259 TYPE(pw_pool_type), POINTER :: pool
260
261 IF (ASSOCIATED(pool)) THEN
262 cpassert(pool%ref_count > 0)
263 pool%ref_count = pool%ref_count - 1
264 IF (pool%ref_count == 0) THEN
265 CALL pw_pool_flush_cache(pool)
266 CALL pw_grid_release(pool%pw_grid)
267
268 DEALLOCATE (pool)
269 END IF
270 END IF
271 NULLIFY (pool)
272 END SUBROUTINE pw_pool_release
273
274! **************************************************************************************************
275!> \brief tries to pop an element from the given list (no error on failure)
276!> \param list the list to pop
277!> \return ...
278!> \par History
279!> 08.2002 created [fawzi]
280!> \author Fawzi Mohamed
281!> \note
282!> private function
283! **************************************************************************************************
284 FUNCTION try_pop_r1d (list) RESULT(res)
285 TYPE(cp_sll_1d_r_type), POINTER :: list
286 REAL(kind=dp), DIMENSION(:), CONTIGUOUS, POINTER :: res
287
288 IF (ASSOCIATED(list)) THEN
289 res => cp_sll_1d_r_get_first_el(list)
290 CALL cp_sll_1d_r_rm_first_el(list)
291 ELSE
292 NULLIFY (res)
293 END IF
294 END FUNCTION try_pop_r1d
295
296! **************************************************************************************************
297!> \brief returns a pw, allocating it if none is in the pool
298!> \param pool the pool from where you get the pw
299!> \param pw will contain the new pw
300!> \par History
301!> 08.2002 created [fawzi]
302!> \author Fawzi Mohamed
303! **************************************************************************************************
304 SUBROUTINE pw_pool_create_pw_r1d_rs (pool, pw)
305 CLASS(pw_pool_type), INTENT(IN) :: pool
306 TYPE(pw_r1d_rs_type), INTENT(OUT) :: pw
307
308 CHARACTER(len=*), PARAMETER :: routinen = 'pw_pool_create_pw'
309
310 INTEGER :: handle
311 REAL(kind=dp), DIMENSION(:), CONTIGUOUS, POINTER :: array_ptr
312
313 CALL timeset(routinen, handle)
314 NULLIFY (array_ptr)
315
316 array_ptr => try_pop_r1d(pool%r1d_array)
317 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
318
319 CALL timestop(handle)
320
321 END SUBROUTINE pw_pool_create_pw_r1d_rs
322
323! **************************************************************************************************
324!> \brief returns the pw to the pool
325!> \param pool the pool where to reintegrate the pw
326!> \param pw the pw to give back
327!> \par History
328!> 08.2002 created [fawzi]
329!> \author Fawzi Mohamed
330! **************************************************************************************************
331 SUBROUTINE pw_pool_give_back_pw_r1d_rs (pool, pw)
332 CLASS(pw_pool_type), INTENT(IN) :: pool
333 TYPE(pw_r1d_rs_type), INTENT(INOUT) :: pw
334
335 CHARACTER(len=*), PARAMETER :: routinen = 'pw_pool_give_back_pw'
336
337 INTEGER :: handle
338
339 CALL timeset(routinen, handle)
340 IF (ASSOCIATED(pw%pw_grid)) THEN
341 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
342 IF (ASSOCIATED(pw%array)) THEN
343 IF (cp_sll_1d_r_get_length(pool%r1d_array) < pool%max_cache) THEN
344 CALL cp_sll_1d_r_insert_el(pool%r1d_array, el=pw%array)
345 NULLIFY (pw%array)
346 ELSE IF (max_max_cache >= 0) THEN
347 cpwarn("hit max_cache")
348 END IF
349 END IF
350 END IF
351 END IF
352 CALL pw%release()
353 CALL timestop(handle)
354 END SUBROUTINE pw_pool_give_back_pw_r1d_rs
355
356! **************************************************************************************************
357!> \brief creates a multigrid structure
358!> \param pools the multigrid pool (i.e. an array of pw_pool)
359!> \param pws the multigrid of coefficent you want to initialize
360!> \par History
361!> 07.2004 created [fawzi]
362!> \author Fawzi Mohamed
363! **************************************************************************************************
364 SUBROUTINE pw_pools_create_pws_r1d_rs (pools, pws)
365 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
366 TYPE(pw_r1d_rs_type), ALLOCATABLE, DIMENSION(:), &
367 INTENT(OUT) :: pws
368
369 INTEGER :: i
370
371 ALLOCATE (pws(SIZE(pools)))
372 DO i = 1, SIZE(pools)
373 CALL pw_pool_create_pw_r1d_rs (pools(i)%pool, pws(i))
374 END DO
375 END SUBROUTINE pw_pools_create_pws_r1d_rs
376
377! **************************************************************************************************
378!> \brief returns the pw part of the coefficients into the pools
379!> \param pools the pools that will cache the pws %pw
380!> \param pws the coefficients to give back
381!> \par History
382!> 08.2002 created [fawzi]
383!> \author Fawzi Mohamed
384! **************************************************************************************************
385 SUBROUTINE pw_pools_give_back_pws_r1d_rs (pools, pws)
386 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
387 TYPE(pw_r1d_rs_type), ALLOCATABLE, DIMENSION(:), &
388 INTENT(INOUT) :: pws
389
390 INTEGER :: i
391
392 cpassert(SIZE(pws) == SIZE(pools))
393 DO i = 1, SIZE(pools)
394 CALL pw_pool_give_back_pw_r1d_rs (pools(i)%pool, pws(i))
395 END DO
396 DEALLOCATE (pws)
397 END SUBROUTINE pw_pools_give_back_pws_r1d_rs
398! **************************************************************************************************
399!> \brief returns a pw, allocating it if none is in the pool
400!> \param pool the pool from where you get the pw
401!> \param pw will contain the new pw
402!> \par History
403!> 08.2002 created [fawzi]
404!> \author Fawzi Mohamed
405! **************************************************************************************************
406 SUBROUTINE pw_pool_create_pw_r1d_gs (pool, pw)
407 CLASS(pw_pool_type), INTENT(IN) :: pool
408 TYPE(pw_r1d_gs_type), INTENT(OUT) :: pw
409
410 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
411
412 INTEGER :: handle
413 REAL(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: array_ptr
414
415 CALL timeset(routinen, handle)
416 NULLIFY (array_ptr)
417
418 array_ptr => try_pop_r1d(pool%r1d_array)
419 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
420
421 CALL timestop(handle)
422
423 END SUBROUTINE pw_pool_create_pw_r1d_gs
424
425! **************************************************************************************************
426!> \brief returns the pw to the pool
427!> \param pool the pool where to reintegrate the pw
428!> \param pw the pw to give back
429!> \par History
430!> 08.2002 created [fawzi]
431!> \author Fawzi Mohamed
432! **************************************************************************************************
433 SUBROUTINE pw_pool_give_back_pw_r1d_gs (pool, pw)
434 CLASS(pw_pool_type), INTENT(IN) :: pool
435 TYPE(pw_r1d_gs_type), INTENT(INOUT) :: pw
436
437 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
438
439 INTEGER :: handle
440
441 CALL timeset(routinen, handle)
442 IF (ASSOCIATED(pw%pw_grid)) THEN
443 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
444 IF (ASSOCIATED(pw%array)) THEN
445 IF (cp_sll_1d_r_get_length(pool%r1d_array) < pool%max_cache) THEN
446 CALL cp_sll_1d_r_insert_el(pool%r1d_array, el=pw%array)
447 NULLIFY (pw%array)
448 ELSE IF (max_max_cache >= 0) THEN
449 cpwarn("hit max_cache")
450 END IF
451 END IF
452 END IF
453 END IF
454 CALL pw%release()
455 CALL timestop(handle)
456 END SUBROUTINE pw_pool_give_back_pw_r1d_gs
457
458! **************************************************************************************************
459!> \brief creates a multigrid structure
460!> \param pools the multigrid pool (i.e. an array of pw_pool)
461!> \param pws the multigrid of coefficent you want to initialize
462!> \par History
463!> 07.2004 created [fawzi]
464!> \author Fawzi Mohamed
465! **************************************************************************************************
466 SUBROUTINE pw_pools_create_pws_r1d_gs (pools, pws)
467 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
468 TYPE(pw_r1d_gs_type), ALLOCATABLE, DIMENSION(:), &
469 INTENT(OUT) :: pws
470
471 INTEGER :: i
472
473 ALLOCATE (pws(SIZE(pools)))
474 DO i = 1, SIZE(pools)
475 CALL pw_pool_create_pw_r1d_gs (pools(i)%pool, pws(i))
476 END DO
477 END SUBROUTINE pw_pools_create_pws_r1d_gs
478
479! **************************************************************************************************
480!> \brief returns the pw part of the coefficients into the pools
481!> \param pools the pools that will cache the pws %pw
482!> \param pws the coefficients to give back
483!> \par History
484!> 08.2002 created [fawzi]
485!> \author Fawzi Mohamed
486! **************************************************************************************************
487 SUBROUTINE pw_pools_give_back_pws_r1d_gs (pools, pws)
488 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
489 TYPE(pw_r1d_gs_type), ALLOCATABLE, DIMENSION(:), &
490 INTENT(INOUT) :: pws
491
492 INTEGER :: i
493
494 cpassert(SIZE(pws) == SIZE(pools))
495 DO i = 1, SIZE(pools)
496 CALL pw_pool_give_back_pw_r1d_gs (pools(i)%pool, pws(i))
497 END DO
498 DEALLOCATE (pws)
499 END SUBROUTINE pw_pools_give_back_pws_r1d_gs
500! **************************************************************************************************
501!> \brief tries to pop an element from the given list (no error on failure)
502!> \param list the list to pop
503!> \return ...
504!> \par History
505!> 08.2002 created [fawzi]
506!> \author Fawzi Mohamed
507!> \note
508!> private function
509! **************************************************************************************************
510 FUNCTION try_pop_r3d (list) RESULT(res)
511 TYPE(cp_sll_3d_r_type), POINTER :: list
512 REAL(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: res
513
514 IF (ASSOCIATED(list)) THEN
515 res => cp_sll_3d_r_get_first_el(list)
516 CALL cp_sll_3d_r_rm_first_el(list)
517 ELSE
518 NULLIFY (res)
519 END IF
520 END FUNCTION try_pop_r3d
521
522! **************************************************************************************************
523!> \brief returns a pw, allocating it if none is in the pool
524!> \param pool the pool from where you get the pw
525!> \param pw will contain the new pw
526!> \par History
527!> 08.2002 created [fawzi]
528!> \author Fawzi Mohamed
529! **************************************************************************************************
530 SUBROUTINE pw_pool_create_pw_r3d_rs (pool, pw)
531 CLASS(pw_pool_type), INTENT(IN) :: pool
532 TYPE(pw_r3d_rs_type), INTENT(OUT) :: pw
533
534 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
535
536 INTEGER :: handle
537 REAL(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: array_ptr
538
539 CALL timeset(routinen, handle)
540 NULLIFY (array_ptr)
541
542 array_ptr => try_pop_r3d(pool%r3d_array)
543 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
544
545 CALL timestop(handle)
546
547 END SUBROUTINE pw_pool_create_pw_r3d_rs
548
549! **************************************************************************************************
550!> \brief returns the pw to the pool
551!> \param pool the pool where to reintegrate the pw
552!> \param pw the pw to give back
553!> \par History
554!> 08.2002 created [fawzi]
555!> \author Fawzi Mohamed
556! **************************************************************************************************
557 SUBROUTINE pw_pool_give_back_pw_r3d_rs (pool, pw)
558 CLASS(pw_pool_type), INTENT(IN) :: pool
559 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: pw
560
561 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
562
563 INTEGER :: handle
564
565 CALL timeset(routinen, handle)
566 IF (ASSOCIATED(pw%pw_grid)) THEN
567 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
568 IF (ASSOCIATED(pw%array)) THEN
569 IF (cp_sll_3d_r_get_length(pool%r3d_array) < pool%max_cache) THEN
570 CALL cp_sll_3d_r_insert_el(pool%r3d_array, el=pw%array)
571 NULLIFY (pw%array)
572 ELSE IF (max_max_cache >= 0) THEN
573 cpwarn("hit max_cache")
574 END IF
575 END IF
576 END IF
577 END IF
578 CALL pw%release()
579 CALL timestop(handle)
580 END SUBROUTINE pw_pool_give_back_pw_r3d_rs
581
582! **************************************************************************************************
583!> \brief creates a multigrid structure
584!> \param pools the multigrid pool (i.e. an array of pw_pool)
585!> \param pws the multigrid of coefficent you want to initialize
586!> \par History
587!> 07.2004 created [fawzi]
588!> \author Fawzi Mohamed
589! **************************************************************************************************
590 SUBROUTINE pw_pools_create_pws_r3d_rs (pools, pws)
591 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
592 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:), &
593 INTENT(OUT) :: pws
594
595 INTEGER :: i
596
597 ALLOCATE (pws(SIZE(pools)))
598 DO i = 1, SIZE(pools)
599 CALL pw_pool_create_pw_r3d_rs (pools(i)%pool, pws(i))
600 END DO
601 END SUBROUTINE pw_pools_create_pws_r3d_rs
602
603! **************************************************************************************************
604!> \brief returns the pw part of the coefficients into the pools
605!> \param pools the pools that will cache the pws %pw
606!> \param pws the coefficients to give back
607!> \par History
608!> 08.2002 created [fawzi]
609!> \author Fawzi Mohamed
610! **************************************************************************************************
611 SUBROUTINE pw_pools_give_back_pws_r3d_rs (pools, pws)
612 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
613 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:), &
614 INTENT(INOUT) :: pws
615
616 INTEGER :: i
617
618 cpassert(SIZE(pws) == SIZE(pools))
619 DO i = 1, SIZE(pools)
620 CALL pw_pool_give_back_pw_r3d_rs (pools(i)%pool, pws(i))
621 END DO
622 DEALLOCATE (pws)
623 END SUBROUTINE pw_pools_give_back_pws_r3d_rs
624! **************************************************************************************************
625!> \brief returns a pw, allocating it if none is in the pool
626!> \param pool the pool from where you get the pw
627!> \param pw will contain the new pw
628!> \par History
629!> 08.2002 created [fawzi]
630!> \author Fawzi Mohamed
631! **************************************************************************************************
632 SUBROUTINE pw_pool_create_pw_r3d_gs (pool, pw)
633 CLASS(pw_pool_type), INTENT(IN) :: pool
634 TYPE(pw_r3d_gs_type), INTENT(OUT) :: pw
635
636 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
637
638 INTEGER :: handle
639 REAL(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: array_ptr
640
641 CALL timeset(routinen, handle)
642 NULLIFY (array_ptr)
643
644 array_ptr => try_pop_r3d(pool%r3d_array)
645 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
646
647 CALL timestop(handle)
648
649 END SUBROUTINE pw_pool_create_pw_r3d_gs
650
651! **************************************************************************************************
652!> \brief returns the pw to the pool
653!> \param pool the pool where to reintegrate the pw
654!> \param pw the pw to give back
655!> \par History
656!> 08.2002 created [fawzi]
657!> \author Fawzi Mohamed
658! **************************************************************************************************
659 SUBROUTINE pw_pool_give_back_pw_r3d_gs (pool, pw)
660 CLASS(pw_pool_type), INTENT(IN) :: pool
661 TYPE(pw_r3d_gs_type), INTENT(INOUT) :: pw
662
663 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
664
665 INTEGER :: handle
666
667 CALL timeset(routinen, handle)
668 IF (ASSOCIATED(pw%pw_grid)) THEN
669 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
670 IF (ASSOCIATED(pw%array)) THEN
671 IF (cp_sll_3d_r_get_length(pool%r3d_array) < pool%max_cache) THEN
672 CALL cp_sll_3d_r_insert_el(pool%r3d_array, el=pw%array)
673 NULLIFY (pw%array)
674 ELSE IF (max_max_cache >= 0) THEN
675 cpwarn("hit max_cache")
676 END IF
677 END IF
678 END IF
679 END IF
680 CALL pw%release()
681 CALL timestop(handle)
682 END SUBROUTINE pw_pool_give_back_pw_r3d_gs
683
684! **************************************************************************************************
685!> \brief creates a multigrid structure
686!> \param pools the multigrid pool (i.e. an array of pw_pool)
687!> \param pws the multigrid of coefficent you want to initialize
688!> \par History
689!> 07.2004 created [fawzi]
690!> \author Fawzi Mohamed
691! **************************************************************************************************
692 SUBROUTINE pw_pools_create_pws_r3d_gs (pools, pws)
693 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
694 TYPE(pw_r3d_gs_type), ALLOCATABLE, DIMENSION(:), &
695 INTENT(OUT) :: pws
696
697 INTEGER :: i
698
699 ALLOCATE (pws(SIZE(pools)))
700 DO i = 1, SIZE(pools)
701 CALL pw_pool_create_pw_r3d_gs (pools(i)%pool, pws(i))
702 END DO
703 END SUBROUTINE pw_pools_create_pws_r3d_gs
704
705! **************************************************************************************************
706!> \brief returns the pw part of the coefficients into the pools
707!> \param pools the pools that will cache the pws %pw
708!> \param pws the coefficients to give back
709!> \par History
710!> 08.2002 created [fawzi]
711!> \author Fawzi Mohamed
712! **************************************************************************************************
713 SUBROUTINE pw_pools_give_back_pws_r3d_gs (pools, pws)
714 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
715 TYPE(pw_r3d_gs_type), ALLOCATABLE, DIMENSION(:), &
716 INTENT(INOUT) :: pws
717
718 INTEGER :: i
719
720 cpassert(SIZE(pws) == SIZE(pools))
721 DO i = 1, SIZE(pools)
722 CALL pw_pool_give_back_pw_r3d_gs (pools(i)%pool, pws(i))
723 END DO
724 DEALLOCATE (pws)
725 END SUBROUTINE pw_pools_give_back_pws_r3d_gs
726! **************************************************************************************************
727!> \brief tries to pop an element from the given list (no error on failure)
728!> \param list the list to pop
729!> \return ...
730!> \par History
731!> 08.2002 created [fawzi]
732!> \author Fawzi Mohamed
733!> \note
734!> private function
735! **************************************************************************************************
736 FUNCTION try_pop_c1d (list) RESULT(res)
737 TYPE(cp_sll_1d_c_type), POINTER :: list
738 COMPLEX(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: res
739
740 IF (ASSOCIATED(list)) THEN
741 res => cp_sll_1d_c_get_first_el(list)
742 CALL cp_sll_1d_c_rm_first_el(list)
743 ELSE
744 NULLIFY (res)
745 END IF
746 END FUNCTION try_pop_c1d
747
748! **************************************************************************************************
749!> \brief returns a pw, allocating it if none is in the pool
750!> \param pool the pool from where you get the pw
751!> \param pw will contain the new pw
752!> \par History
753!> 08.2002 created [fawzi]
754!> \author Fawzi Mohamed
755! **************************************************************************************************
756 SUBROUTINE pw_pool_create_pw_c1d_rs (pool, pw)
757 CLASS(pw_pool_type), INTENT(IN) :: pool
758 TYPE(pw_c1d_rs_type), INTENT(OUT) :: pw
759
760 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
761
762 INTEGER :: handle
763 COMPLEX(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: array_ptr
764
765 CALL timeset(routinen, handle)
766 NULLIFY (array_ptr)
767
768 array_ptr => try_pop_c1d(pool%c1d_array)
769 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
770
771 CALL timestop(handle)
772
773 END SUBROUTINE pw_pool_create_pw_c1d_rs
774
775! **************************************************************************************************
776!> \brief returns the pw to the pool
777!> \param pool the pool where to reintegrate the pw
778!> \param pw the pw to give back
779!> \par History
780!> 08.2002 created [fawzi]
781!> \author Fawzi Mohamed
782! **************************************************************************************************
783 SUBROUTINE pw_pool_give_back_pw_c1d_rs (pool, pw)
784 CLASS(pw_pool_type), INTENT(IN) :: pool
785 TYPE(pw_c1d_rs_type), INTENT(INOUT) :: pw
786
787 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
788
789 INTEGER :: handle
790
791 CALL timeset(routinen, handle)
792 IF (ASSOCIATED(pw%pw_grid)) THEN
793 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
794 IF (ASSOCIATED(pw%array)) THEN
795 IF (cp_sll_1d_c_get_length(pool%c1d_array) < pool%max_cache) THEN
796 CALL cp_sll_1d_c_insert_el(pool%c1d_array, el=pw%array)
797 NULLIFY (pw%array)
798 ELSE IF (max_max_cache >= 0) THEN
799 cpwarn("hit max_cache")
800 END IF
801 END IF
802 END IF
803 END IF
804 CALL pw%release()
805 CALL timestop(handle)
806 END SUBROUTINE pw_pool_give_back_pw_c1d_rs
807
808! **************************************************************************************************
809!> \brief creates a multigrid structure
810!> \param pools the multigrid pool (i.e. an array of pw_pool)
811!> \param pws the multigrid of coefficent you want to initialize
812!> \par History
813!> 07.2004 created [fawzi]
814!> \author Fawzi Mohamed
815! **************************************************************************************************
816 SUBROUTINE pw_pools_create_pws_c1d_rs (pools, pws)
817 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
818 TYPE(pw_c1d_rs_type), ALLOCATABLE, DIMENSION(:), &
819 INTENT(OUT) :: pws
820
821 INTEGER :: i
822
823 ALLOCATE (pws(SIZE(pools)))
824 DO i = 1, SIZE(pools)
825 CALL pw_pool_create_pw_c1d_rs (pools(i)%pool, pws(i))
826 END DO
827 END SUBROUTINE pw_pools_create_pws_c1d_rs
828
829! **************************************************************************************************
830!> \brief returns the pw part of the coefficients into the pools
831!> \param pools the pools that will cache the pws %pw
832!> \param pws the coefficients to give back
833!> \par History
834!> 08.2002 created [fawzi]
835!> \author Fawzi Mohamed
836! **************************************************************************************************
837 SUBROUTINE pw_pools_give_back_pws_c1d_rs (pools, pws)
838 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
839 TYPE(pw_c1d_rs_type), ALLOCATABLE, DIMENSION(:), &
840 INTENT(INOUT) :: pws
841
842 INTEGER :: i
843
844 cpassert(SIZE(pws) == SIZE(pools))
845 DO i = 1, SIZE(pools)
846 CALL pw_pool_give_back_pw_c1d_rs (pools(i)%pool, pws(i))
847 END DO
848 DEALLOCATE (pws)
849 END SUBROUTINE pw_pools_give_back_pws_c1d_rs
850! **************************************************************************************************
851!> \brief returns a pw, allocating it if none is in the pool
852!> \param pool the pool from where you get the pw
853!> \param pw will contain the new pw
854!> \par History
855!> 08.2002 created [fawzi]
856!> \author Fawzi Mohamed
857! **************************************************************************************************
858 SUBROUTINE pw_pool_create_pw_c1d_gs (pool, pw)
859 CLASS(pw_pool_type), INTENT(IN) :: pool
860 TYPE(pw_c1d_gs_type), INTENT(OUT) :: pw
861
862 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
863
864 INTEGER :: handle
865 COMPLEX(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: array_ptr
866
867 CALL timeset(routinen, handle)
868 NULLIFY (array_ptr)
869
870 array_ptr => try_pop_c1d(pool%c1d_array)
871 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
872
873 CALL timestop(handle)
874
875 END SUBROUTINE pw_pool_create_pw_c1d_gs
876
877! **************************************************************************************************
878!> \brief returns the pw to the pool
879!> \param pool the pool where to reintegrate the pw
880!> \param pw the pw to give back
881!> \par History
882!> 08.2002 created [fawzi]
883!> \author Fawzi Mohamed
884! **************************************************************************************************
885 SUBROUTINE pw_pool_give_back_pw_c1d_gs (pool, pw)
886 CLASS(pw_pool_type), INTENT(IN) :: pool
887 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: pw
888
889 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
890
891 INTEGER :: handle
892
893 CALL timeset(routinen, handle)
894 IF (ASSOCIATED(pw%pw_grid)) THEN
895 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
896 IF (ASSOCIATED(pw%array)) THEN
897 IF (cp_sll_1d_c_get_length(pool%c1d_array) < pool%max_cache) THEN
898 CALL cp_sll_1d_c_insert_el(pool%c1d_array, el=pw%array)
899 NULLIFY (pw%array)
900 ELSE IF (max_max_cache >= 0) THEN
901 cpwarn("hit max_cache")
902 END IF
903 END IF
904 END IF
905 END IF
906 CALL pw%release()
907 CALL timestop(handle)
908 END SUBROUTINE pw_pool_give_back_pw_c1d_gs
909
910! **************************************************************************************************
911!> \brief creates a multigrid structure
912!> \param pools the multigrid pool (i.e. an array of pw_pool)
913!> \param pws the multigrid of coefficent you want to initialize
914!> \par History
915!> 07.2004 created [fawzi]
916!> \author Fawzi Mohamed
917! **************************************************************************************************
918 SUBROUTINE pw_pools_create_pws_c1d_gs (pools, pws)
919 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
920 TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:), &
921 INTENT(OUT) :: pws
922
923 INTEGER :: i
924
925 ALLOCATE (pws(SIZE(pools)))
926 DO i = 1, SIZE(pools)
927 CALL pw_pool_create_pw_c1d_gs (pools(i)%pool, pws(i))
928 END DO
929 END SUBROUTINE pw_pools_create_pws_c1d_gs
930
931! **************************************************************************************************
932!> \brief returns the pw part of the coefficients into the pools
933!> \param pools the pools that will cache the pws %pw
934!> \param pws the coefficients to give back
935!> \par History
936!> 08.2002 created [fawzi]
937!> \author Fawzi Mohamed
938! **************************************************************************************************
939 SUBROUTINE pw_pools_give_back_pws_c1d_gs (pools, pws)
940 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
941 TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:), &
942 INTENT(INOUT) :: pws
943
944 INTEGER :: i
945
946 cpassert(SIZE(pws) == SIZE(pools))
947 DO i = 1, SIZE(pools)
948 CALL pw_pool_give_back_pw_c1d_gs (pools(i)%pool, pws(i))
949 END DO
950 DEALLOCATE (pws)
951 END SUBROUTINE pw_pools_give_back_pws_c1d_gs
952! **************************************************************************************************
953!> \brief tries to pop an element from the given list (no error on failure)
954!> \param list the list to pop
955!> \return ...
956!> \par History
957!> 08.2002 created [fawzi]
958!> \author Fawzi Mohamed
959!> \note
960!> private function
961! **************************************************************************************************
962 FUNCTION try_pop_c3d (list) RESULT(res)
963 TYPE(cp_sll_3d_c_type), POINTER :: list
964 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: res
965
966 IF (ASSOCIATED(list)) THEN
967 res => cp_sll_3d_c_get_first_el(list)
968 CALL cp_sll_3d_c_rm_first_el(list)
969 ELSE
970 NULLIFY (res)
971 END IF
972 END FUNCTION try_pop_c3d
973
974! **************************************************************************************************
975!> \brief returns a pw, allocating it if none is in the pool
976!> \param pool the pool from where you get the pw
977!> \param pw will contain the new pw
978!> \par History
979!> 08.2002 created [fawzi]
980!> \author Fawzi Mohamed
981! **************************************************************************************************
982 SUBROUTINE pw_pool_create_pw_c3d_rs (pool, pw)
983 CLASS(pw_pool_type), INTENT(IN) :: pool
984 TYPE(pw_c3d_rs_type), INTENT(OUT) :: pw
985
986 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
987
988 INTEGER :: handle
989 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: array_ptr
990
991 CALL timeset(routinen, handle)
992 NULLIFY (array_ptr)
993
994 array_ptr => try_pop_c3d(pool%c3d_array)
995 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
996
997 CALL timestop(handle)
998
999 END SUBROUTINE pw_pool_create_pw_c3d_rs
1000
1001! **************************************************************************************************
1002!> \brief returns the pw to the pool
1003!> \param pool the pool where to reintegrate the pw
1004!> \param pw the pw to give back
1005!> \par History
1006!> 08.2002 created [fawzi]
1007!> \author Fawzi Mohamed
1008! **************************************************************************************************
1009 SUBROUTINE pw_pool_give_back_pw_c3d_rs (pool, pw)
1010 CLASS(pw_pool_type), INTENT(IN) :: pool
1011 TYPE(pw_c3d_rs_type), INTENT(INOUT) :: pw
1012
1013 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
1014
1015 INTEGER :: handle
1016
1017 CALL timeset(routinen, handle)
1018 IF (ASSOCIATED(pw%pw_grid)) THEN
1019 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
1020 IF (ASSOCIATED(pw%array)) THEN
1021 IF (cp_sll_3d_c_get_length(pool%c3d_array) < pool%max_cache) THEN
1022 CALL cp_sll_3d_c_insert_el(pool%c3d_array, el=pw%array)
1023 NULLIFY (pw%array)
1024 ELSE IF (max_max_cache >= 0) THEN
1025 cpwarn("hit max_cache")
1026 END IF
1027 END IF
1028 END IF
1029 END IF
1030 CALL pw%release()
1031 CALL timestop(handle)
1032 END SUBROUTINE pw_pool_give_back_pw_c3d_rs
1033
1034! **************************************************************************************************
1035!> \brief creates a multigrid structure
1036!> \param pools the multigrid pool (i.e. an array of pw_pool)
1037!> \param pws the multigrid of coefficent you want to initialize
1038!> \par History
1039!> 07.2004 created [fawzi]
1040!> \author Fawzi Mohamed
1041! **************************************************************************************************
1042 SUBROUTINE pw_pools_create_pws_c3d_rs (pools, pws)
1043 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
1044 TYPE(pw_c3d_rs_type), ALLOCATABLE, DIMENSION(:), &
1045 INTENT(OUT) :: pws
1046
1047 INTEGER :: i
1048
1049 ALLOCATE (pws(SIZE(pools)))
1050 DO i = 1, SIZE(pools)
1051 CALL pw_pool_create_pw_c3d_rs (pools(i)%pool, pws(i))
1052 END DO
1053 END SUBROUTINE pw_pools_create_pws_c3d_rs
1054
1055! **************************************************************************************************
1056!> \brief returns the pw part of the coefficients into the pools
1057!> \param pools the pools that will cache the pws %pw
1058!> \param pws the coefficients to give back
1059!> \par History
1060!> 08.2002 created [fawzi]
1061!> \author Fawzi Mohamed
1062! **************************************************************************************************
1063 SUBROUTINE pw_pools_give_back_pws_c3d_rs (pools, pws)
1064 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
1065 TYPE(pw_c3d_rs_type), ALLOCATABLE, DIMENSION(:), &
1066 INTENT(INOUT) :: pws
1067
1068 INTEGER :: i
1069
1070 cpassert(SIZE(pws) == SIZE(pools))
1071 DO i = 1, SIZE(pools)
1072 CALL pw_pool_give_back_pw_c3d_rs (pools(i)%pool, pws(i))
1073 END DO
1074 DEALLOCATE (pws)
1075 END SUBROUTINE pw_pools_give_back_pws_c3d_rs
1076! **************************************************************************************************
1077!> \brief returns a pw, allocating it if none is in the pool
1078!> \param pool the pool from where you get the pw
1079!> \param pw will contain the new pw
1080!> \par History
1081!> 08.2002 created [fawzi]
1082!> \author Fawzi Mohamed
1083! **************************************************************************************************
1084 SUBROUTINE pw_pool_create_pw_c3d_gs (pool, pw)
1085 CLASS(pw_pool_type), INTENT(IN) :: pool
1086 TYPE(pw_c3d_gs_type), INTENT(OUT) :: pw
1087
1088 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_create_pw'
1089
1090 INTEGER :: handle
1091 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: array_ptr
1092
1093 CALL timeset(routinen, handle)
1094 NULLIFY (array_ptr)
1095
1096 array_ptr => try_pop_c3d(pool%c3d_array)
1097 CALL pw%create(pool%pw_grid, array_ptr=array_ptr)
1098
1099 CALL timestop(handle)
1100
1101 END SUBROUTINE pw_pool_create_pw_c3d_gs
1102
1103! **************************************************************************************************
1104!> \brief returns the pw to the pool
1105!> \param pool the pool where to reintegrate the pw
1106!> \param pw the pw to give back
1107!> \par History
1108!> 08.2002 created [fawzi]
1109!> \author Fawzi Mohamed
1110! **************************************************************************************************
1111 SUBROUTINE pw_pool_give_back_pw_c3d_gs (pool, pw)
1112 CLASS(pw_pool_type), INTENT(IN) :: pool
1113 TYPE(pw_c3d_gs_type), INTENT(INOUT) :: pw
1114
1115 CHARACTER(len=*), PARAMETER :: routineN = 'pw_pool_give_back_pw'
1116
1117 INTEGER :: handle
1118
1119 CALL timeset(routinen, handle)
1120 IF (ASSOCIATED(pw%pw_grid)) THEN
1121 IF (pw_grid_compare(pw%pw_grid, pool%pw_grid)) THEN
1122 IF (ASSOCIATED(pw%array)) THEN
1123 IF (cp_sll_3d_c_get_length(pool%c3d_array) < pool%max_cache) THEN
1124 CALL cp_sll_3d_c_insert_el(pool%c3d_array, el=pw%array)
1125 NULLIFY (pw%array)
1126 ELSE IF (max_max_cache >= 0) THEN
1127 cpwarn("hit max_cache")
1128 END IF
1129 END IF
1130 END IF
1131 END IF
1132 CALL pw%release()
1133 CALL timestop(handle)
1134 END SUBROUTINE pw_pool_give_back_pw_c3d_gs
1135
1136! **************************************************************************************************
1137!> \brief creates a multigrid structure
1138!> \param pools the multigrid pool (i.e. an array of pw_pool)
1139!> \param pws the multigrid of coefficent you want to initialize
1140!> \par History
1141!> 07.2004 created [fawzi]
1142!> \author Fawzi Mohamed
1143! **************************************************************************************************
1144 SUBROUTINE pw_pools_create_pws_c3d_gs (pools, pws)
1145 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
1146 TYPE(pw_c3d_gs_type), ALLOCATABLE, DIMENSION(:), &
1147 INTENT(OUT) :: pws
1148
1149 INTEGER :: i
1150
1151 ALLOCATE (pws(SIZE(pools)))
1152 DO i = 1, SIZE(pools)
1153 CALL pw_pool_create_pw_c3d_gs (pools(i)%pool, pws(i))
1154 END DO
1155 END SUBROUTINE pw_pools_create_pws_c3d_gs
1156
1157! **************************************************************************************************
1158!> \brief returns the pw part of the coefficients into the pools
1159!> \param pools the pools that will cache the pws %pw
1160!> \param pws the coefficients to give back
1161!> \par History
1162!> 08.2002 created [fawzi]
1163!> \author Fawzi Mohamed
1164! **************************************************************************************************
1165 SUBROUTINE pw_pools_give_back_pws_c3d_gs (pools, pws)
1166 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: pools
1167 TYPE(pw_c3d_gs_type), ALLOCATABLE, DIMENSION(:), &
1168 INTENT(INOUT) :: pws
1169
1170 INTEGER :: i
1171
1172 cpassert(SIZE(pws) == SIZE(pools))
1173 DO i = 1, SIZE(pools)
1174 CALL pw_pool_give_back_pw_c3d_gs (pools(i)%pool, pws(i))
1175 END DO
1176 DEALLOCATE (pws)
1177 END SUBROUTINE pw_pools_give_back_pws_c3d_gs
1178
1179! **************************************************************************************************
1180!> \brief returns a 3d real array of coefficients as the one used by pw with
1181!> REALDATA3D, allocating it if none is present in the pool
1182!> \param pw_pool the pool that caches the cr3d
1183!> \param cr3d the pointer that will contain the array
1184!> \par History
1185!> 11.2003 created [fawzi]
1186!> \author fawzi
1187! **************************************************************************************************
1188 SUBROUTINE pw_pool_create_cr3d(pw_pool, cr3d)
1189 CLASS(pw_pool_type), INTENT(IN) :: pw_pool
1190 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: cr3d
1191
1192 IF (ASSOCIATED(pw_pool%r3d_array)) THEN
1193 cr3d => cp_sll_3d_r_get_first_el(pw_pool%r3d_array)
1194 CALL cp_sll_3d_r_rm_first_el(pw_pool%r3d_array)
1195 END IF
1196 IF (.NOT. ASSOCIATED(cr3d)) THEN
1197 ALLOCATE (cr3d(pw_pool%pw_grid%bounds_local(1, 1):pw_pool%pw_grid%bounds_local(2, 1), &
1198 pw_pool%pw_grid%bounds_local(1, 2):pw_pool%pw_grid%bounds_local(2, 2), &
1199 pw_pool%pw_grid%bounds_local(1, 3):pw_pool%pw_grid%bounds_local(2, 3)))
1200 END IF
1201 END SUBROUTINE pw_pool_create_cr3d
1202
1203! **************************************************************************************************
1204!> \brief returns a 3d real array of coefficients as the one used by pw with
1205!> REALDATA3D, allocating it if none is present in the pool
1206!> \param pw_pool the pool that caches the cr3d
1207!> \param cr3d the pointer that will contain the array
1208!> \par History
1209!> 11.2003 created [fawzi]
1210!> \author fawzi
1211! **************************************************************************************************
1212 SUBROUTINE pw_pool_give_back_cr3d(pw_pool, cr3d)
1213 CLASS(pw_pool_type), INTENT(IN) :: pw_pool
1214 REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :, :), &
1215 POINTER :: cr3d
1216
1217 LOGICAL :: compatible
1218
1219 IF (ASSOCIATED(cr3d)) THEN
1220 compatible = all(merge(pw_pool%pw_grid%bounds_local(1, :) == lbound(cr3d) .AND. &
1221 pw_pool%pw_grid%bounds_local(2, :) == ubound(cr3d), &
1222 pw_pool%pw_grid%bounds_local(2, :) < pw_pool%pw_grid%bounds_local(1, :), &
1223 ubound(cr3d) >= lbound(cr3d)))
1224 IF (compatible) THEN
1225 IF (cp_sll_3d_r_get_length(pw_pool%r3d_array) < pw_pool%max_cache) THEN
1226 CALL cp_sll_3d_r_insert_el(pw_pool%r3d_array, el=cr3d)
1227 ELSE
1228 cpwarn_if(max_max_cache >= 0, "hit max_cache")
1229 DEALLOCATE (cr3d)
1230 END IF
1231 ELSE
1232 DEALLOCATE (cr3d)
1233 END IF
1234 END IF
1235 NULLIFY (cr3d)
1236 END SUBROUTINE pw_pool_give_back_cr3d
1237
1238! **************************************************************************************************
1239!> \brief copies a multigrid pool, the underlying pools are shared
1240!> \param source_pools the pools to copy
1241!> \param target_pools will hold the copy of the pools
1242!> \par History
1243!> 08.2002 created [fawzi]
1244!> \author Fawzi Mohamed
1245! **************************************************************************************************
1246 SUBROUTINE pw_pools_copy(source_pools, target_pools)
1247 TYPE(pw_pool_p_type), DIMENSION(:), INTENT(IN) :: source_pools
1248 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: target_pools
1249
1250 INTEGER :: i
1251
1252 ALLOCATE (target_pools(SIZE(source_pools)))
1253 DO i = 1, SIZE(source_pools)
1254 target_pools(i)%pool => source_pools(i)%pool
1255 CALL source_pools(i)%pool%retain()
1256 END DO
1257 END SUBROUTINE pw_pools_copy
1258
1259! **************************************************************************************************
1260!> \brief deallocates the given pools (releasing each of the underlying
1261!> pools)
1262!> \param pools the pols to deallocate
1263!> \par History
1264!> 08.2002 created [fawzi]
1265!> \author Fawzi Mohamed
1266! **************************************************************************************************
1267 SUBROUTINE pw_pools_dealloc(pools)
1268 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pools
1269
1270 INTEGER :: i
1271
1272 IF (ASSOCIATED(pools)) THEN
1273 DO i = 1, SIZE(pools)
1274 CALL pw_pool_release(pools(i)%pool)
1275 END DO
1276 DEALLOCATE (pools)
1277 END IF
1278 NULLIFY (pools)
1279 END SUBROUTINE pw_pools_dealloc
1280
1281END MODULE pw_pool_types
pw_pool_types::pw_pools_create_pws
Definition pw_pool_types.F:139
pw_pool_types::pw_pools_give_back_pws
Definition pw_pool_types.F:150
cp_linked_list_pw
Definition cp_linked_list_pw.F:9
cp_linked_list_pw::cp_sll_1d_r_get_length
integer function, public cp_sll_1d_r_get_length(sll)
returns the length of the list
Definition cp_linked_list_pw.F:1022
cp_linked_list_pw::cp_sll_1d_c_dealloc
subroutine, public cp_sll_1d_c_dealloc(sll)
deallocates the singly linked list starting at sll. Does not work if loops are present!
Definition cp_linked_list_pw.F:584
cp_linked_list_pw::cp_sll_3d_r_get_length
integer function, public cp_sll_3d_r_get_length(sll)
returns the length of the list
Definition cp_linked_list_pw.F:968
cp_linked_list_pw::cp_sll_3d_c_get_length
integer function, public cp_sll_3d_c_get_length(sll)
returns the length of the list
Definition cp_linked_list_pw.F:995
cp_linked_list_pw::cp_sll_1d_r_rm_first_el
subroutine, public cp_sll_1d_r_rm_first_el(sll)
remove the first element of the linked list
Definition cp_linked_list_pw.F:1660
cp_linked_list_pw::cp_sll_1d_r_dealloc
subroutine, public cp_sll_1d_r_dealloc(sll)
deallocates the singly linked list starting at sll. Does not work if loops are present!
Definition cp_linked_list_pw.F:568
cp_linked_list_pw::cp_sll_1d_c_insert_el
subroutine, public cp_sll_1d_c_insert_el(sll, el)
insert an element at the beginning of the list
Definition cp_linked_list_pw.F:1571
cp_linked_list_pw::cp_sll_3d_c_rm_first_el
subroutine, public cp_sll_3d_c_rm_first_el(sll)
remove the first element of the linked list
Definition cp_linked_list_pw.F:1638
cp_linked_list_pw::cp_sll_1d_r_get_first_el
real(kind=dp) function, dimension(:), pointer, contiguous, public cp_sll_1d_r_get_first_el(sll)
returns the first element stored in the list
Definition cp_linked_list_pw.F:707
cp_linked_list_pw::cp_sll_3d_c_next
logical function, public cp_sll_3d_c_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_pw.F:1406
cp_linked_list_pw::cp_sll_1d_r_next
logical function, public cp_sll_1d_r_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_pw.F:1429
cp_linked_list_pw::cp_sll_1d_c_get_first_el
complex(kind=dp) function, dimension(:), pointer, contiguous, public cp_sll_1d_c_get_first_el(sll)
returns the first element stored in the list
Definition cp_linked_list_pw.F:721
cp_linked_list_pw::cp_sll_3d_r_insert_el
subroutine, public cp_sll_3d_r_insert_el(sll, el)
insert an element at the beginning of the list
Definition cp_linked_list_pw.F:1502
cp_linked_list_pw::cp_sll_1d_c_rm_first_el
subroutine, public cp_sll_1d_c_rm_first_el(sll)
remove the first element of the linked list
Definition cp_linked_list_pw.F:1682
cp_linked_list_pw::cp_sll_3d_c_dealloc
subroutine, public cp_sll_3d_c_dealloc(sll)
deallocates the singly linked list starting at sll. Does not work if loops are present!
Definition cp_linked_list_pw.F:552
cp_linked_list_pw::cp_sll_3d_r_next
logical function, public cp_sll_3d_r_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_pw.F:1383
cp_linked_list_pw::cp_sll_1d_c_get_length
integer function, public cp_sll_1d_c_get_length(sll)
returns the length of the list
Definition cp_linked_list_pw.F:1049
cp_linked_list_pw::cp_sll_3d_c_get_first_el
complex(kind=dp) function, dimension(:,:,:), pointer, contiguous, public cp_sll_3d_c_get_first_el(sll)
returns the first element stored in the list
Definition cp_linked_list_pw.F:693
cp_linked_list_pw::cp_sll_3d_r_get_first_el
real(kind=dp) function, dimension(:,:,:), pointer, contiguous, public cp_sll_3d_r_get_first_el(sll)
returns the first element stored in the list
Definition cp_linked_list_pw.F:679
cp_linked_list_pw::cp_sll_1d_r_insert_el
subroutine, public cp_sll_1d_r_insert_el(sll, el)
insert an element at the beginning of the list
Definition cp_linked_list_pw.F:1548
cp_linked_list_pw::cp_sll_3d_c_insert_el
subroutine, public cp_sll_3d_c_insert_el(sll, el)
insert an element at the beginning of the list
Definition cp_linked_list_pw.F:1525
cp_linked_list_pw::cp_sll_3d_r_rm_first_el
subroutine, public cp_sll_3d_r_rm_first_el(sll)
remove the first element of the linked list
Definition cp_linked_list_pw.F:1616
cp_linked_list_pw::cp_sll_3d_r_dealloc
subroutine, public cp_sll_3d_r_dealloc(sll)
deallocates the singly linked list starting at sll. Does not work if loops are present!
Definition cp_linked_list_pw.F:536
cp_linked_list_pw::cp_sll_1d_c_next
logical function, public cp_sll_1d_c_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_pw.F:1452
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
list
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
pw_grid_types
Definition pw_grid_types.F:13
pw_grids
This module defines the grid data type and some basic operations on it.
Definition pw_grids.F:36
pw_grids::pw_grid_compare
logical function, public pw_grid_compare(grida, gridb)
Check if two pw_grids are equal.
Definition pw_grids.F:148
pw_grids::pw_grid_release
subroutine, public pw_grid_release(pw_grid)
releases the given pw grid
Definition pw_grids.F:2163
pw_grids::pw_grid_retain
subroutine, public pw_grid_retain(pw_grid)
retains the given pw grid
Definition pw_grids.F:2147
pw_pool_types
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Definition pw_pool_types.F:24
pw_pool_types::pw_pools_dealloc
subroutine, public pw_pools_dealloc(pools)
deallocates the given pools (releasing each of the underlying pools)
Definition pw_pool_types.F:1268
pw_pool_types::pw_pools_copy
subroutine, public pw_pools_copy(source_pools, target_pools)
copies a multigrid pool, the underlying pools are shared
Definition pw_pool_types.F:1247
pw_pool_types::pw_pool_release
subroutine, public pw_pool_release(pool)
releases the given pool (see cp2k/doc/ReferenceCounting.html)
Definition pw_pool_types.F:259
pw_pool_types::pw_pool_create
subroutine, public pw_pool_create(pool, pw_grid, max_cache)
creates a pool for pw
Definition pw_pool_types.F:173
pw_types
Definition pw_types.F:24
cp_linked_list_pw::cp_sll_1d_c_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_pw.F:316
cp_linked_list_pw::cp_sll_1d_r_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_pw.F:290
cp_linked_list_pw::cp_sll_3d_c_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_pw.F:264
cp_linked_list_pw::cp_sll_3d_r_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_pw.F:238
pw_grid_types::pw_grid_type
Definition pw_grid_types.F:52
pw_pool_types::pw_pool_p_type
to create arrays of pools
Definition pw_pool_types.F:135
pw_pool_types::pw_pool_type
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Definition pw_pool_types.F:83
pw_types::pw_c1d_gs_type
Definition pw_types.F:127
pw_types::pw_c1d_rs_type
Definition pw_types.F:75
pw_types::pw_c3d_gs_type
Definition pw_types.F:140
pw_types::pw_c3d_rs_type
Definition pw_types.F:88
pw_types::pw_r1d_gs_type
Definition pw_types.F:101
pw_types::pw_r1d_rs_type
Definition pw_types.F:49
pw_types::pw_r3d_gs_type
Definition pw_types.F:114
pw_types::pw_r3d_rs_type
Definition pw_types.F:62