Ensures that pool_size < max_size, e.g. that there is a free slot.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_mempool_type), | POINTER | :: | pool |
SUBROUTINE mempool_collect_garbage(pool)
!! Ensures that pool_size < max_size, e.g. that there is a free slot.
TYPE(dbcsr_mempool_type), POINTER :: pool
INTEGER :: n
TYPE(dbcsr_mempool_entry_type), POINTER :: cur, prev
IF (.NOT. ASSOCIATED(pool)) DBCSR_ABORT("pool not allocated")
!$ CALL OMP_SET_LOCK(pool%lock)
prev => pool%root
cur => pool%root%next
n = 0
DO WHILE (ASSOCIATED(cur))
n = n + 1
IF (n >= pool%capacity) THEN
CALL internal_data_deallocate(cur%area%d)
DEALLOCATE (cur%area%d)
prev%next => cur%next
DEALLOCATE (cur)
cur => prev%next
ELSE
prev => cur
cur => cur%next
END IF
END DO
!$ CALL OMP_UNSET_LOCK(pool%lock)
END SUBROUTINE mempool_collect_garbage