mempool_collect_garbage Subroutine

private subroutine mempool_collect_garbage(pool)

Ensures that pool_size < max_size, e.g. that there is a free slot.

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_mempool_type), POINTER:: pool

Contents


Source Code

   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