1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief pool for for elements that are retained and released
8!> \par History
9!>      08.2002 created [fawzi]
10!> \author Fawzi Mohamed
11! **************************************************************************************************
12MODULE cp_fm_pool_types
13   USE cp_fm_struct,                    ONLY: cp_fm_struct_release,&
14                                              cp_fm_struct_retain,&
15                                              cp_fm_struct_type
16   USE cp_fm_types,                     ONLY: cp_fm_create,&
17                                              cp_fm_p_type,&
18                                              cp_fm_release,&
19                                              cp_fm_type
20   USE cp_linked_list_fm,               ONLY: cp_sll_fm_dealloc,&
21                                              cp_sll_fm_get_first_el,&
22                                              cp_sll_fm_insert_el,&
23                                              cp_sll_fm_next,&
24                                              cp_sll_fm_rm_first_el,&
25                                              cp_sll_fm_type
26   USE cp_log_handling,                 ONLY: cp_to_string
27#include "../base/base_uses.f90"
28
29   IMPLICIT NONE
30   PRIVATE
31
32   LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
33   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_pool_types'
34   INTEGER, SAVE, PRIVATE :: last_fm_pool_id_nr = 0
35
36   PUBLIC :: cp_fm_pool_type, cp_fm_pool_p_type
37   PUBLIC :: fm_pool_create, fm_pool_retain, &
38             fm_pool_release, &
39             fm_pool_create_fm, fm_pool_give_back_fm, &
40             fm_pool_get_el_struct
41   PUBLIC :: fm_pools_dealloc, &
42             fm_pools_create_fm_vect, &
43             fm_pools_give_back_fm_vect
44!***
45
46! **************************************************************************************************
47!> \brief represent a pool of elements with the same structure
48!> \param ref_count reference count (see /cp2k/doc/ReferenceCounting.html)
49!> \param el_struct the structure of the elements stored in this pool
50!> \param cache linked list with the elements in the pool
51!> \par History
52!>      08.2002 created [fawzi]
53!> \author Fawzi Mohamed
54! **************************************************************************************************
55   TYPE cp_fm_pool_type
56      PRIVATE
57      INTEGER :: ref_count, id_nr
58      TYPE(cp_fm_struct_type), POINTER :: el_struct
59
60      TYPE(cp_sll_fm_type), POINTER :: cache
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
72   END TYPE cp_fm_pool_p_type
73
74CONTAINS
75
76! **************************************************************************************************
77!> \brief creates a pool of elements
78!> \param pool the pool to create
79!> \param el_struct the structure of the elements that are stored in
80!>        this pool
81!> \par History
82!>      08.2002 created [fawzi]
83!> \author Fawzi Mohamed
84! **************************************************************************************************
85   SUBROUTINE fm_pool_create(pool, el_struct)
86      TYPE(cp_fm_pool_type), POINTER                     :: pool
87      TYPE(cp_fm_struct_type), POINTER                   :: el_struct
88
89      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_create', routineP = moduleN//':'//routineN
90
91      ALLOCATE (pool)
92      pool%el_struct => el_struct
93      CALL cp_fm_struct_retain(pool%el_struct)
94      last_fm_pool_id_nr = last_fm_pool_id_nr + 1
95      pool%id_nr = last_fm_pool_id_nr
96      pool%ref_count = 1
97      NULLIFY (pool%cache)
98
99   END SUBROUTINE fm_pool_create
100
101! **************************************************************************************************
102!> \brief retains the pool (see cp2k/doc/ReferenceCounting.html)
103!> \param pool the pool to retain
104!> \par History
105!>      08.2002 created [fawzi]
106!> \author Fawzi Mohamed
107! **************************************************************************************************
108   SUBROUTINE fm_pool_retain(pool)
109      TYPE(cp_fm_pool_type), POINTER                     :: pool
110
111      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_retain', routineP = moduleN//':'//routineN
112
113      CPASSERT(ASSOCIATED(pool))
114      CPASSERT(pool%ref_count > 0)
115
116      pool%ref_count = pool%ref_count + 1
117   END SUBROUTINE fm_pool_retain
118
119! **************************************************************************************************
120!> \brief deallocates all the cached elements
121!> \param pool the pool to flush
122!> \par History
123!>      08.2002 created [fawzi]
124!> \author Fawzi Mohamed
125! **************************************************************************************************
126   SUBROUTINE fm_pool_flush_cache(pool)
127      TYPE(cp_fm_pool_type), POINTER                     :: pool
128
129      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_flush_cache', &
130         routineP = moduleN//':'//routineN
131
132      TYPE(cp_fm_type), POINTER                          :: el_att
133      TYPE(cp_sll_fm_type), POINTER                      :: iterator
134
135      CPASSERT(ASSOCIATED(pool))
136      CPASSERT(pool%ref_count > 0)
137      iterator => pool%cache
138      DO
139         IF (.NOT. cp_sll_fm_next(iterator, el_att=el_att)) EXIT
140         CALL cp_fm_release(el_att)
141      END DO
142      CALL cp_sll_fm_dealloc(pool%cache)
143   END SUBROUTINE fm_pool_flush_cache
144
145! **************************************************************************************************
146!> \brief releases the given pool (see cp2k/doc/ReferenceCounting.html)
147!> \param pool the pool to release
148!> \par History
149!>      08.2002 created [fawzi]
150!> \author Fawzi Mohamed
151! **************************************************************************************************
152   SUBROUTINE fm_pool_release(pool)
153      TYPE(cp_fm_pool_type), POINTER                     :: pool
154
155      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_release', &
156         routineP = moduleN//':'//routineN
157
158      IF (ASSOCIATED(pool)) THEN
159         CPASSERT(pool%ref_count > 0)
160         pool%ref_count = pool%ref_count - 1
161         IF (pool%ref_count == 0) THEN
162            pool%ref_count = 1
163            CALL fm_pool_flush_cache(pool)
164            CALL cp_fm_struct_release(pool%el_struct)
165            pool%ref_count = 0
166
167            DEALLOCATE (pool)
168         END IF
169      END IF
170      NULLIFY (pool)
171   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   SUBROUTINE fm_pool_create_fm(pool, element, &
184                                name)
185      TYPE(cp_fm_pool_type), POINTER                     :: pool
186      TYPE(cp_fm_type), POINTER                          :: element
187      CHARACTER(len=*), INTENT(in), OPTIONAL             :: name
188
189      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_create_fm', &
190         routineP = moduleN//':'//routineN
191
192      CPASSERT(ASSOCIATED(pool))
193      CPASSERT(pool%ref_count > 0)
194      IF (ASSOCIATED(pool%cache)) THEN
195         element => cp_sll_fm_get_first_el(pool%cache)
196         CALL cp_sll_fm_rm_first_el(pool%cache)
197
198      ELSE
199         NULLIFY (element)
200         CALL cp_fm_create(element, matrix_struct=pool%el_struct)
201      END IF
202
203      IF (PRESENT(name)) THEN
204         element%name = name
205         element%print_count = 0
206      ELSE
207         element%name = "tmp-"//TRIM(ADJUSTL(cp_to_string(element%id_nr)))
208         element%print_count = 0
209         ! guarantee output unicity?
210      END IF
211
212      CPASSERT(ASSOCIATED(element))
213      CPASSERT(element%ref_count == 1)
214   END SUBROUTINE fm_pool_create_fm
215
216! **************************************************************************************************
217!> \brief returns the element to the pool
218!> \param pool the pool where to cache the element
219!> \param element the element to give back
220!> \par History
221!>      08.2002 created [fawzi]
222!> \author Fawzi Mohamed
223!> \note
224!>      transfers the ownership of the element to the pool
225!>      (it is as if you had called cp_fm_release)
226!>      Accept give_backs of non associated elements?
227! **************************************************************************************************
228   SUBROUTINE fm_pool_give_back_fm(pool, element)
229      TYPE(cp_fm_pool_type), POINTER                     :: pool
230      TYPE(cp_fm_type), POINTER                          :: element
231
232      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_give_back_fm', &
233         routineP = moduleN//':'//routineN
234
235      CPASSERT(ASSOCIATED(pool))
236      CPASSERT(pool%ref_count > 0)
237      CPASSERT(ASSOCIATED(element))
238      IF (pool%el_struct%id_nr /= element%matrix_struct%id_nr) &
239         CPABORT("pool cannot reuse matrixes with another structure")
240
241      CPASSERT(element%ref_count == 1)
242      CALL cp_sll_fm_insert_el(pool%cache, el=element)
243      NULLIFY (element)
244   END SUBROUTINE fm_pool_give_back_fm
245
246! **************************************************************************************************
247!> \brief returns the structure of the elements in this pool
248!> \param pool the pool you are interested in
249!> \return ...
250!> \par History
251!>      05.2002 created [fawzi]
252!> \author Fawzi Mohamed
253! **************************************************************************************************
254   FUNCTION fm_pool_get_el_struct(pool) RESULT(res)
255      TYPE(cp_fm_pool_type), POINTER                     :: pool
256      TYPE(cp_fm_struct_type), POINTER                   :: res
257
258      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pool_get_el_struct', &
259         routineP = moduleN//':'//routineN
260
261      CPASSERT(ASSOCIATED(pool))
262      CPASSERT(pool%ref_count > 0)
263      res => pool%el_struct
264   END FUNCTION fm_pool_get_el_struct
265
266!================== pools ================
267
268! **************************************************************************************************
269!> \brief shallow copy of an array of pools (retains each pool)
270!> \param source_pools the pools to copy
271!> \param target_pools will contains the new pools
272!> \par History
273!>      11.2002 created [fawzi]
274!> \author Fawzi Mohamed
275! **************************************************************************************************
276   SUBROUTINE fm_pools_copy(source_pools, target_pools)
277      TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: source_pools, target_pools
278
279      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pools_copy', routineP = moduleN//':'//routineN
280
281      INTEGER                                            :: i
282
283      CPASSERT(ASSOCIATED(source_pools))
284      ALLOCATE (target_pools(SIZE(source_pools)))
285      DO i = 1, SIZE(source_pools)
286         target_pools(i)%pool => source_pools(i)%pool
287         CALL fm_pool_retain(source_pools(i)%pool)
288      END DO
289   END SUBROUTINE fm_pools_copy
290
291! **************************************************************************************************
292!> \brief deallocate an array of pools (releasing each pool)
293!> \param pools the pools to release
294!> \par History
295!>      11.2002 created [fawzi]
296!> \author Fawzi Mohamed
297! **************************************************************************************************
298   SUBROUTINE fm_pools_dealloc(pools)
299      TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: pools
300
301      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pools_dealloc', &
302         routineP = moduleN//':'//routineN
303
304      INTEGER                                            :: i
305
306      IF (ASSOCIATED(pools)) THEN
307         DO i = 1, SIZE(pools)
308            CALL fm_pool_release(pools(i)%pool)
309         END DO
310         DEALLOCATE (pools)
311      END IF
312   END SUBROUTINE fm_pools_dealloc
313
314! **************************************************************************************************
315!> \brief Returns a vector with an element from each pool
316!> \param pools the pools to create the elements from
317!> \param elements will contain the vector of elements
318!> \param name the name for the new matrixes (optional)
319!> \par History
320!>      09.2002 created [fawzi]
321!> \author Fawzi Mohamed
322! **************************************************************************************************
323   SUBROUTINE fm_pools_create_fm_vect(pools, elements, &
324                                      name)
325      TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: pools
326      TYPE(cp_fm_p_type), DIMENSION(:), POINTER          :: elements
327      CHARACTER(len=*), INTENT(in), OPTIONAL             :: name
328
329      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pools_create_fm_vect', &
330         routineP = moduleN//':'//routineN
331
332      INTEGER                                            :: i
333      TYPE(cp_fm_pool_type), POINTER                     :: pool
334
335      NULLIFY (pool)
336
337      CPASSERT(ASSOCIATED(pools))
338      ALLOCATE (elements(SIZE(pools)))
339      DO i = 1, SIZE(pools)
340         NULLIFY (elements(i)%matrix)
341         pool => pools(i)%pool
342         IF (PRESENT(name)) THEN
343            CALL fm_pool_create_fm(pool, elements(i)%matrix, &
344                                   name=name//"-"//ADJUSTL(cp_to_string(i)))
345         ELSE
346            CALL fm_pool_create_fm(pool, elements(i)%matrix)
347         END IF
348
349      END DO
350
351   END SUBROUTINE fm_pools_create_fm_vect
352
353! **************************************************************************************************
354!> \brief returns a vector to the pools. The vector is deallocated
355!>      (like cp_fm_vect_dealloc)
356!> \param pools the pool where to give back the vector
357!> \param elements the vector of elements to give back
358!> \par History
359!>      09.2002 created [fawzi]
360!> \author Fawzi Mohamed
361!> \note
362!>      accept unassociated vect?
363! **************************************************************************************************
364   SUBROUTINE fm_pools_give_back_fm_vect(pools, elements)
365      TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: pools
366      TYPE(cp_fm_p_type), DIMENSION(:), POINTER          :: elements
367
368      CHARACTER(len=*), PARAMETER :: routineN = 'fm_pools_give_back_fm_vect', &
369         routineP = moduleN//':'//routineN
370
371      INTEGER                                            :: i
372
373      CPASSERT(ASSOCIATED(pools))
374      CPASSERT(ASSOCIATED(elements))
375      CPASSERT(SIZE(pools) == SIZE(elements))
376      DO i = 1, SIZE(pools)
377         CALL fm_pool_give_back_fm(pools(i)%pool, &
378                                   elements(i)%matrix)
379      END DO
380      DEALLOCATE (elements)
381   END SUBROUTINE fm_pools_give_back_fm_vect
382
383END MODULE cp_fm_pool_types
384