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