Picks a suitable data_area from mempool, returns Null() if none found.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_memtype_type) | :: | memtype | ||||
integer, | intent(in) | :: | datatype | |||
integer, | intent(in) | :: | datasize |
FUNCTION dbcsr_mempool_get(memtype, datatype, datasize) RESULT(res)
!! Picks a suitable data_area from mempool, returns Null() if none found.
TYPE(dbcsr_memtype_type) :: memtype
INTEGER, INTENT(IN) :: datatype, datasize
TYPE(dbcsr_data_obj) :: res
INTEGER :: best_size, s
TYPE(dbcsr_mempool_entry_type), POINTER :: best_cur, best_prev, cur, prev
TYPE(dbcsr_mempool_type), POINTER :: pool
pool => memtype%pool
IF (.NOT. ASSOCIATED(pool)) DBCSR_ABORT("pool not allocated")
!$ CALL OMP_SET_LOCK(pool%lock)
res%d => Null()
best_cur => Null()
best_prev => Null()
best_size = HUGE(1)
prev => Null()
cur => pool%root
DO WHILE (ASSOCIATED(cur%next))
prev => cur
cur => cur%next
s = dbcsr_data_get_size(cur%area)
IF (s < datasize) CYCLE
IF (.NOT. dbcsr_memtype_equal(cur%area%d%memory_type, memtype)) CYCLE
IF (cur%area%d%data_type /= datatype) CYCLE
!we found a match
IF (s < best_size) THEN
best_cur => cur
best_prev => prev
best_size = s
END IF
END DO
IF (ASSOCIATED(best_cur)) THEN
IF (best_cur%area%d%refcount /= 0) DBCSR_ABORT("refcount /= 0")
best_cur%area%d%refcount = 1
best_prev%next => best_cur%next
res = best_cur%area
DEALLOCATE (best_cur)
END IF
!$ CALL OMP_UNSET_LOCK(pool%lock)
IF (.NOT. ASSOCIATED(res%d)) &
CALL mempool_collect_garbage(pool)
END FUNCTION dbcsr_mempool_get