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