9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-10-03 22:55:58 +02:00
qp2/src/utils/map_module.f90

903 lines
24 KiB
Fortran
Raw Normal View History

2019-01-25 11:39:31 +01:00
module map_module
! A map is an array of maps (cache_maps)
! A cache map is an array of keys and values sorted by keys
! A cache map has its own OpenMP lock
! To access a (key,value) pair in the map, the
! index of the cache_map in the map array is obtained
! by removing the first 15 bits of the key.
! The key in the cache_map is composed of the first
! 15 bits of the key. Therefore, it can be stored
! as integer*2 and is found by applying the map_mask
! to the initial key. The element are found in the
! cache_map using a binary search
!
! When using the map_update subroutine to build the map,
! the map_merge subroutine
! should be called before getting data from the map.
use omp_lib
integer, parameter :: integral_kind = 8
integer, parameter :: cache_key_kind = 2
integer, parameter :: cache_map_size_kind = 4
integer, parameter :: key_kind = 8
integer, parameter :: map_size_kind = 8
integer, parameter :: map_shift = 15
integer*8, parameter :: map_mask = ibset(0_8,15)-1_8
type cache_map_type
real(integral_kind), pointer :: value(:)
integer(cache_key_kind), pointer :: key(:)
logical :: sorted
integer(cache_map_size_kind) :: map_size
integer(cache_map_size_kind) :: n_elements
integer(omp_lock_kind) :: lock
end type cache_map_type
type map_type
type(cache_map_type), allocatable :: map(:)
real(integral_kind), pointer :: consolidated_value(:)
integer(cache_key_kind), pointer :: consolidated_key(:)
integer*8, pointer :: consolidated_idx(:)
logical :: sorted
logical :: consolidated
integer(map_size_kind) :: map_size
integer(map_size_kind) :: n_elements
integer(omp_lock_kind) :: lock
end type map_type
end module map_module
double precision function map_mb(map)
use map_module
use omp_lib
implicit none
type (map_type), intent(in) :: map
integer(map_size_kind) :: i
map_mb = dble(8+map_size_kind+map_size_kind+omp_lock_kind+4)
do i=0,map%map_size
map_mb = map_mb + dble(map%map(i)%map_size*(cache_key_kind+integral_kind) +&
8+8+4+cache_map_size_kind+cache_map_size_kind+omp_lock_kind)
enddo
map_mb = map_mb / (1024.d0*1024.d0)
end
subroutine cache_map_init(map,sze)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
integer(cache_map_size_kind) :: sze
call omp_set_lock(map%lock)
map%n_elements = 0_8
map%map_size = 0_8
map%sorted = .True.
NULLIFY(map%value, map%key)
call cache_map_reallocate(map,sze)
call omp_unset_lock(map%lock)
end
subroutine map_init(map,keymax)
use map_module
implicit none
integer*8, intent(in) :: keymax
type (map_type), intent(inout) :: map
integer(map_size_kind) :: i
integer(cache_map_size_kind) :: sze
integer :: err
call omp_init_lock(map%lock)
call omp_set_lock(map%lock)
map%n_elements = 0_8
map%map_size = shiftr(keymax,map_shift)
map%consolidated = .False.
allocate(map%map(0_8:map%map_size),stat=err)
if (err /= 0) then
print *, 'Unable to allocate map'
stop 5
endif
sze = 2
do i=0_8,map%map_size
call omp_init_lock(map%map(i)%lock)
enddo
!$OMP PARALLEL DEFAULT(NONE) SHARED(map,sze) PRIVATE(i)
!$OMP DO SCHEDULE(STATIC,512)
do i=0_8,map%map_size
call cache_map_init(map%map(i),sze)
enddo
!$OMP ENDDO
!$OMP END PARALLEL
map%sorted = .True.
call omp_unset_lock(map%lock)
end
subroutine cache_map_reallocate(map,sze)
use map_module
implicit none
integer(cache_map_size_kind), intent(in) :: sze
type (cache_map_type), intent(inout) :: map
integer(cache_key_kind), pointer :: key_new(:)
real(integral_kind), pointer :: value_new(:)
integer(map_size_kind) :: i
integer :: err
!DIR$ ATTRIBUTES ALIGN : 64 :: key_new, value_new
if (sze < map%n_elements) then
print *, 'Unable to resize map : map too large'
stop 3
endif
! Resize keys
allocate( key_new(sze), stat=err )
if (err /= 0) then
print *, 'Unable to allocate map', sze
stop 1
endif
if (associated(map%key)) then
do i=1_8,min(size(map%key),map%n_elements)
key_new(i) = map%key(i)
enddo
deallocate(map%key)
endif
! Resize values
allocate( value_new(sze), stat=err )
if (err /= 0) then
print *, 'Unable to allocate map', sze
stop 2
endif
if (associated(map%value)) then
do i=1_8,min(size(map%key),map%n_elements)
value_new(i) = map%value(i)
enddo
deallocate(map%value)
endif
! Set new pointers
map%key => key_new
map%value => value_new
map%map_size = sze
end
subroutine cache_map_deinit(map)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
integer :: err
if (associated( map % value )) then
deallocate( map % value, stat=err )
if (err /= 0) then
print *, 'Unable to deallocate map'
stop 2
endif
NULLIFY(map%value)
endif
if (associated( map % key )) then
deallocate( map % key, stat=err )
if (err /= 0) then
print *, 'Unable to deallocate map'
stop 4
endif
NULLIFY(map%key)
endif
map%n_elements = 0_8
map%map_size = 0_8
call omp_destroy_lock(map%lock)
end
subroutine map_deinit(map)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer :: err
integer(map_size_kind) :: i
if (allocated( map % map )) then
do i=0_8, map%map_size
call cache_map_deinit(map%map(i))
enddo
deallocate( map % map, stat=err )
if (err /= 0) then
print *, 'Unable to deallocate map'
stop 6
endif
endif
map%n_elements = 0_8
map%map_size = 0_8
call omp_destroy_lock(map%lock)
end
subroutine cache_map_sort(map)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
integer(cache_map_size_kind), allocatable :: iorder(:)
integer(cache_map_size_kind) :: i
!DIR$ ATTRIBUTES ALIGN : 64 :: iorder
if (.not.map%sorted) then
allocate(iorder(map%n_elements))
do i=1,map%n_elements
iorder(i) = i
enddo
if (cache_key_kind == 2) then
2023-02-16 10:45:53 +01:00
call i2sort(map%key,iorder,map%n_elements,-1)
2019-01-25 11:39:31 +01:00
else if (cache_key_kind == 4) then
2023-02-16 10:45:53 +01:00
call isort(map%key,iorder,map%n_elements,-1)
2019-01-25 11:39:31 +01:00
else if (cache_key_kind == 8) then
2023-02-16 10:45:53 +01:00
call i8sort(map%key,iorder,map%n_elements,-1)
2019-01-25 11:39:31 +01:00
endif
if (integral_kind == 4) then
call set_order(map%value,iorder,map%n_elements)
else if (integral_kind == 8) then
call dset_order(map%value,iorder,map%n_elements)
endif
deallocate(iorder)
map%sorted = .True.
endif
end
subroutine map_sort(map)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer(map_size_kind) :: i
if (.not.map%sorted) then
!$OMP PARALLEL DO SCHEDULE(static,1024) DEFAULT(SHARED) PRIVATE(i)
do i=0_8,map%map_size
call omp_set_lock(map%map(i)%lock)
call cache_map_sort(map%map(i))
call omp_unset_lock(map%map(i)%lock)
enddo
!$OMP END PARALLEL DO
map%sorted = .True.
endif
end
subroutine cache_map_merge(map)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
integer(cache_key_kind) :: prev_key
integer(cache_map_size_kind) :: i, j
call cache_map_sort(map)
prev_key = -1_8
j=0
do i=1,map%n_elements
if (map%key(i) /= prev_key) then
j = j+1
map%value(j) = map%value(i)
map%key(j) = map%key(i)
prev_key = map%key(i)
else
map%value(j) = map%value(j)+map%value(i)
endif
enddo
map%n_elements = j
end
subroutine cache_map_unique(map)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
integer(cache_key_kind) :: prev_key
integer(cache_map_size_kind) :: i, j
call cache_map_sort(map)
prev_key = -1_8
j=0
do i=1,map%n_elements
if (map%key(i) /= prev_key) then
j = j+1
map%value(j) = map%value(i)
map%key(j) = map%key(i)
prev_key = map%key(i)
endif
enddo
map%n_elements = j
end
subroutine cache_map_shrink(map,thr)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
real(integral_kind) , intent(in) :: thr
integer(cache_map_size_kind) :: i,j
j=0
do i=1,map%n_elements
if (abs(map%value(i)) > thr) then
j = j+1
map%value(j) = map%value(i)
map%key(j) = map%key(i)
endif
enddo
map%n_elements = j
end
subroutine map_unique(map)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer(map_size_kind) :: i
integer(map_size_kind) :: icount
icount = 0_8
!$OMP PARALLEL DO SCHEDULE(dynamic,1000) DEFAULT(SHARED) PRIVATE(i)&
!$OMP REDUCTION(+:icount)
do i=0_8,map%map_size
call omp_set_lock(map%map(i)%lock)
call cache_map_unique(map%map(i))
call omp_unset_lock(map%map(i)%lock)
icount = icount + map%map(i)%n_elements
enddo
!$OMP END PARALLEL DO
map%n_elements = icount
end
subroutine map_merge(map)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer(map_size_kind) :: i
integer(map_size_kind) :: icount
icount = 0_8
!$OMP PARALLEL DO SCHEDULE(dynamic,1000) DEFAULT(SHARED) PRIVATE(i)&
!$OMP REDUCTION(+:icount)
do i=0_8,map%map_size
call omp_set_lock(map%map(i)%lock)
call cache_map_merge(map%map(i))
call omp_unset_lock(map%map(i)%lock)
icount = icount + map%map(i)%n_elements
enddo
!$OMP END PARALLEL DO
map%n_elements = icount
end
subroutine map_shrink(map,thr)
use map_module
implicit none
type (map_type), intent(inout) :: map
real(integral_kind), intent(in) :: thr
integer(map_size_kind) :: i
integer(map_size_kind) :: icount
icount = 0_8
!$OMP PARALLEL DO SCHEDULE(dynamic,1000) DEFAULT(SHARED) PRIVATE(i)&
!$OMP REDUCTION(+:icount)
do i=0_8,map%map_size
call omp_set_lock(map%map(i)%lock)
call cache_map_shrink(map%map(i),thr)
call omp_unset_lock(map%map(i)%lock)
icount = icount + map%map(i)%n_elements
enddo
!$OMP END PARALLEL DO
map%n_elements = icount
end
subroutine map_update(map, key, value, sze, thr)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer, intent(in) :: sze
integer(key_kind), intent(inout) :: key(sze)
real(integral_kind), intent(inout) :: value(sze)
real(integral_kind), intent(in) :: thr
integer :: i
integer(map_size_kind) :: idx_cache, idx_cache_new
integer(cache_map_size_kind) :: idx
integer :: sze2
integer(cache_key_kind) :: cache_key
integer(map_size_kind) :: n_elements_temp
type (cache_map_type) :: local_map
logical :: map_sorted
sze2 = sze
map_sorted = .True.
n_elements_temp = 0_8
n_elements_temp = n_elements_temp + 1_8
do while (sze2>0)
i=1
do while (i<=sze)
if (key(i) /= 0_8) then
idx_cache = shiftr(key(i),map_shift)
if (omp_test_lock(map%map(idx_cache)%lock)) then
local_map%key => map%map(idx_cache)%key
local_map%value => map%map(idx_cache)%value
local_map%sorted = map%map(idx_cache)%sorted
local_map%map_size = map%map(idx_cache)%map_size
local_map%n_elements = map%map(idx_cache)%n_elements
do
!DIR$ FORCEINLINE
call search_key_big_interval(key(i),local_map%key, local_map%n_elements, idx, 1, local_map%n_elements)
if (idx > 0_8) then
local_map%value(idx) = local_map%value(idx) + value(i)
else
! Assert that the map has a proper size
if (local_map%n_elements == local_map%map_size) then
call cache_map_merge(local_map)
call cache_map_reallocate(local_map, local_map%n_elements + local_map%n_elements)
call cache_map_shrink(local_map,thr)
endif
cache_key = int(iand(key(i),map_mask),2)
local_map%n_elements = local_map%n_elements + 1
local_map%value(local_map%n_elements) = value(i)
local_map%key(local_map%n_elements) = cache_key
local_map%sorted = .False.
n_elements_temp = n_elements_temp + 1_8
endif ! idx > 0
key(i) = 0_8
i = i+1
sze2 = sze2-1
if (i>sze) then
i=1
endif
if ( (shiftr(key(i),map_shift) /= idx_cache).or.(key(i)==0_8)) then
exit
endif
enddo
map%map(idx_cache)%key => local_map%key
map%map(idx_cache)%value => local_map%value
map%map(idx_cache)%sorted = local_map%sorted
map%map(idx_cache)%n_elements = local_map%n_elements
map%map(idx_cache)%map_size = local_map%map_size
map_sorted = map_sorted .and. local_map%sorted
call omp_unset_lock(map%map(idx_cache)%lock)
endif ! omp_test_lock
else
i=i+1
endif ! key = 0
enddo ! i
enddo ! sze2 > 0
call omp_set_lock(map%lock)
map%n_elements = map%n_elements + n_elements_temp
map%sorted = map%sorted .and. map_sorted
call omp_unset_lock(map%lock)
end
subroutine map_append(map, key, value, sze)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer, intent(in) :: sze
integer(key_kind), intent(inout) :: key(sze)
real(integral_kind), intent(inout) :: value(sze)
integer :: i
integer(cache_map_size_kind) :: n_elements
integer(map_size_kind) :: idx_cache
integer(cache_key_kind) :: cache_key
do i=1,sze
idx_cache = shiftr(key(i),map_shift)
call omp_set_lock(map%map(idx_cache)%lock)
n_elements = map%map(idx_cache)%n_elements + 1
! Assert that the map has a proper size
if (n_elements == map%map(idx_cache)%map_size) then
call cache_map_reallocate(map%map(idx_cache), n_elements+ shiftr(n_elements,1))
endif
cache_key = int(iand(key(i),map_mask),2)
map%map(idx_cache)%value(n_elements) = value(i)
map%map(idx_cache)%key(n_elements) = cache_key
map%map(idx_cache)%n_elements = n_elements
if (map%map(idx_cache)%sorted.and.n_elements > 1) then
map%map(idx_cache)%sorted = (map%map(idx_cache)%key(n_elements-1) <= cache_key)
map%sorted = map%sorted .and. map%map(idx_cache)%sorted
endif
call omp_unset_lock(map%map(idx_cache)%lock)
enddo
call omp_set_lock(map%lock)
map%n_elements = map%n_elements + sze
call omp_unset_lock(map%lock)
end
subroutine map_get(map, key, value)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer(key_kind), intent(in) :: key
real(integral_kind), intent(out) :: value
integer(map_size_kind) :: idx_cache
integer(cache_map_size_kind) :: idx
! index in tha pointers array
idx_cache = shiftr(key,map_shift)
!DIR$ FORCEINLINE
call cache_map_get_interval(map%map(idx_cache), key, value, 1, map%map(idx_cache)%n_elements,idx)
end
subroutine cache_map_get_interval(map, key, value, ibegin, iend, idx)
use map_module
implicit none
type (cache_map_type), intent(inout) :: map
integer(key_kind), intent(in) :: key
integer(cache_map_size_kind), intent(in) :: ibegin, iend
real(integral_kind), intent(out) :: value
integer(cache_map_size_kind), intent(inout) :: idx
double precision, pointer :: v(:)
integer :: i
call search_key_big_interval(key,map%key, map%n_elements, idx, ibegin, iend)
if (idx > 0) then
value = map%value(idx)
else
value = 0._integral_kind
endif
! call search_key_value_big_interval(key, value, map%key, map%value, map%n_elements, idx, ibegin, iend)
end
subroutine map_get_many(map, key, value, sze)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer, intent(in) :: sze
integer(key_kind), intent(in) :: key(sze)
real(integral_kind), intent(out) :: value(sze)
integer :: i
integer(map_size_kind) :: idx_cache
integer(cache_map_size_kind) :: ibegin, iend
integer(cache_map_size_kind), allocatable :: idx(:)
!DIR$ ATTRIBUTES ALIGN : 64 :: idx
allocate(idx(sze))
do i=1,sze
idx_cache = shiftr(key(i),map_shift)
iend = map%map(idx_cache)%n_elements
!DIR$ FORCEINLINE
call search_key_big_interval(key(i),map%map(idx_cache)%key, iend, idx(i), 1, iend)
enddo
do i=1,sze
idx_cache = shiftr(key(i),map_shift)
if (idx(i) > 0) then
value(i) = map%map(idx_cache)%value(idx(i))
else
value(i) = 0.
endif
enddo
deallocate(idx)
end
subroutine map_exists_many(map, key, sze)
use map_module
implicit none
type (map_type), intent(inout) :: map
integer, intent(in) :: sze
integer(key_kind), intent(inout) :: key(sze)
integer :: i
integer(map_size_kind) :: idx_cache, idx_cache_prev
integer(cache_map_size_kind) :: ibegin, iend
integer(cache_map_size_kind), allocatable :: idx(:)
!DIR$ ATTRIBUTES ALIGN : 64 :: idx
idx_cache_prev = -1_map_size_kind
allocate(idx(sze))
do i=1,sze
idx_cache = shiftr(key(i),map_shift)
iend = map%map(idx_cache)%n_elements
if (idx_cache == idx_cache_prev) then
if ((idx(i-1) > 0_cache_map_size_kind).and.(idx(i-1) < iend)) then
if ((key(i) == key(i-1)+1).and.(map%map(idx_cache)%key(idx(i-1))+1) == key(i)) then
idx(i) = idx(i-1)+1
cycle
endif
endif
endif
!DIR$ FORCEINLINE
call search_key_big_interval(key(i),map%map(idx_cache)%key, iend, idx(i), 1, iend)
idx_cache_prev = idx_cache
enddo
do i=1,sze
idx_cache = shiftr(key(i),map_shift)
if (idx(i) <= 0) then
key(i) = 0_key_kind
endif
enddo
deallocate(idx)
end
subroutine search_key_big(key,X,sze,idx)
use map_module
implicit none
integer(cache_map_size_kind), intent(in) :: sze
integer(key_kind) , intent(in) :: key
integer(cache_key_kind) , intent(in) :: X(sze)
integer(cache_map_size_kind), intent(out) :: idx
call search_key_big_interval(key,X,sze,idx,1,sze)
end
subroutine search_key_big_interval(key,X,sze,idx,ibegin_in,iend_in)
use map_module
implicit none
integer(cache_map_size_kind), intent(in) :: sze
integer(key_kind) , intent(in) :: key
integer(cache_key_kind) , intent(in) :: X(sze)
integer(cache_map_size_kind), intent(in) :: ibegin_in, iend_in
integer(cache_map_size_kind), intent(out) :: idx
integer(cache_map_size_kind) :: istep, ibegin, iend, i
integer(cache_key_kind) :: cache_key
if (sze /= 0) then
continue
else
idx = -1
return
endif
cache_key = int(iand(key,map_mask),2)
ibegin = min(ibegin_in,sze)
iend = min(iend_in,sze)
if ((cache_key > X(ibegin)) .and. (cache_key < X(iend))) then
istep = shiftr(iend-ibegin,1)
idx = ibegin + istep
do while (istep > 4)
idx = ibegin + istep
! TODO : Cache misses
if (cache_key < X(idx)) then
iend = idx
istep = shiftr(idx-ibegin,1)
idx = ibegin + istep
if (cache_key < X(idx)) then
iend = idx
istep = shiftr(idx-ibegin,1)
cycle
else if (cache_key > X(idx)) then
ibegin = idx
istep = shiftr(iend-idx,1)
cycle
else
return
endif
else if (cache_key > X(idx)) then
ibegin = idx
istep = shiftr(iend-idx,1)
idx = idx + istep
if (cache_key < X(idx)) then
iend = idx
istep = shiftr(idx-ibegin,1)
cycle
else if (cache_key > X(idx)) then
ibegin = idx
istep = shiftr(iend-idx,1)
cycle
else
return
endif
else
return
endif
enddo
idx = ibegin
if (min(iend_in,sze) > ibegin+4) then
iend = ibegin+4
!DIR$ LOOP COUNT MAX(4)
do while (cache_key > X(idx))
idx = idx+1
end do
else
!DIR$ LOOP COUNT MAX(4)
do while (cache_key > X(idx))
idx = idx+1
if (idx == iend) then
exit
endif
end do
endif
if (cache_key /= X(idx)) then
idx = 1-idx
endif
return
else
if (cache_key < X(ibegin)) then
idx = -ibegin
return
endif
if (cache_key > X(iend)) then
idx = -iend
return
endif
if (cache_key == X(ibegin)) then
idx = ibegin
return
endif
if (cache_key == X(iend)) then
idx = iend
return
endif
endif
end
subroutine search_key_value_big_interval(key,value,X,Y,sze,idx,ibegin_in,iend_in)
use map_module
implicit none
integer(cache_map_size_kind), intent(in) :: sze
integer(key_kind) , intent(in) :: key
real(integral_kind) , intent(out) :: value
integer(cache_key_kind) , intent(in) :: X(sze)
real(integral_kind) , intent(in) :: Y(sze)
integer(cache_map_size_kind), intent(in) :: ibegin_in, iend_in
integer(cache_map_size_kind), intent(out) :: idx
integer(cache_map_size_kind) :: istep, ibegin, iend, i
integer(cache_key_kind) :: cache_key
if (sze /= 0) then
continue
else
idx = -1
value = 0.d0
return
endif
cache_key = int(iand(key,map_mask),2)
ibegin = min(ibegin_in,sze)
iend = min(iend_in,sze)
if ((cache_key > X(ibegin)) .and. (cache_key < X(iend))) then
istep = shiftr(iend+ibegin,1)
idx = ibegin + istep
do while (istep > 4)
idx = ibegin + istep
! TODO : Cache misses
if (cache_key < X(idx)) then
iend = idx
istep = shiftr(idx-ibegin,1)
idx = ibegin + istep
if (cache_key < X(idx)) then
iend = idx
istep = shiftr(idx-ibegin,1)
cycle
else if (cache_key > X(idx)) then
ibegin = idx
istep = shiftr(iend-idx,1)
cycle
else
value = Y(idx)
return
endif
else if (cache_key > X(idx)) then
ibegin = idx
istep = shiftr(iend-idx,1)
idx = idx + istep
if (cache_key < X(idx)) then
iend = idx
istep = shiftr(idx-ibegin,1)
cycle
else if (cache_key > X(idx)) then
ibegin = idx
istep = shiftr(iend-idx,1)
cycle
else
value = Y(idx)
return
endif
else
value = Y(idx)
return
endif
enddo
idx = ibegin
if (min(iend_in,sze) > ibegin+4) then
iend = ibegin+4
!DIR$ LOOP COUNT MAX(4)
do while (cache_key > X(idx))
idx = idx+1
end do
else
!DIR$ LOOP COUNT MAX(4)
do while (cache_key > X(idx))
idx = idx+1
if (idx == iend) then
exit
endif
end do
endif
if (cache_key /= X(idx)) then
idx = 1-idx
value = 0.d0
else
value = Y(idx)
endif
return
else
if (cache_key < X(ibegin)) then
idx = -ibegin
value = 0.d0
return
endif
if (cache_key > X(iend)) then
idx = -iend
value = 0.d0
return
endif
if (cache_key == X(ibegin)) then
idx = ibegin
value = Y(idx)
return
endif
if (cache_key == X(iend)) then
idx = iend
value = Y(idx)
return
endif
endif
end
subroutine get_cache_map_n_elements_max(map,n_elements_max)
use map_module
implicit none
! Returns the size of the largest cache_map
type (map_type), intent(in) :: map
integer(cache_map_size_kind), intent(out) :: n_elements_max
integer(map_size_kind) :: i
n_elements_max = 0_cache_map_size_kind
do i=0_8,map%map_size
n_elements_max = max(n_elements_max, map%map(i)%n_elements)
enddo
end
subroutine get_cache_map(map,map_idx,keys,values,n_elements)
use map_module
implicit none
type (map_type), intent(in) :: map
integer(map_size_kind), intent(in) :: map_idx
integer(cache_map_size_kind), intent(inout) :: n_elements
integer(key_kind), intent(out) :: keys(n_elements)
double precision, intent(out) :: values(n_elements)
integer(cache_map_size_kind) :: i
integer(key_kind) :: shift
shift = shiftl(map_idx,map_shift)
n_elements = map%map(map_idx)%n_elements
do i=1,n_elements
keys(i) = map%map(map_idx)%key(i) + shift
values(i) = map%map(map_idx)%value(i)
enddo
end