LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-03 01:45:59 +02:00
Code Issues Releases Wiki Activity

pedantic changes

Browse Source
This commit is contained in:
Anthony Scemama 2017-04-12 19:29:21 +02:00
parent 1f96871534
commit 1d6593a288
20 changed files with 99 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/gfortran_debug.cfg
View File

@ -51,7 +51,7 @@ FCFLAGS : -Ofast
# -g : Extra debugging information
#
[DEBUG]
FCFLAGS : -g -msse4.2
FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant
# OpenMP flags
#################

20
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -20,7 +20,7 @@ subroutine ZMQ_pt2(pt2,relative_error)
double precision, allocatable :: pt2_detail(:,:), comb(:)
logical, allocatable :: computed(:)
integer, allocatable :: tbc(:)
integer :: i, j, Ncomb, generator_per_task, i_generator_end
integer :: i, j, k, Ncomb, generator_per_task, i_generator_end
integer, external :: pt2_find
double precision :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth)
@ -69,18 +69,18 @@ subroutine ZMQ_pt2(pt2,relative_error)
do i=1,tbc(0)
if(tbc(i) > fragment_first) then
write(task(ipos:ipos+20),'(I9,X,I9,''|'')') 0, tbc(i)
write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, tbc(i)
ipos += 20
if (ipos > 64000) then
if (ipos > 63980) then
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20)))
ipos=1
tasks = .True.
endif
else
do j=1,fragment_count
write(task(ipos:ipos+20),'(I9,X,I9,''|'')') j, tbc(i)
write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, tbc(i)
ipos += 20
if (ipos > 64000) then
if (ipos > 63980) then
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20)))
ipos=1
tasks = .True.
@ -108,7 +108,12 @@ subroutine ZMQ_pt2(pt2,relative_error)
call end_parallel_job(zmq_to_qp_run_socket, 'pt2')
else
pt2(1) = sum(pt2_detail(1,:))
pt2 = 0.d0
do i=1,N_det_generators
do k=1,N_states
pt2(k) = pt2(k) + pt2_detail(k,i)
enddo
enddo
endif
tbc(0) = 0
@ -117,7 +122,6 @@ subroutine ZMQ_pt2(pt2,relative_error)
endif
end do
print *, 'OK'
deallocate(pt2_detail, comb, computed, tbc)
end subroutine
@ -380,9 +384,9 @@ END_PROVIDER
subroutine get_carlo_workbatch(computed, comb, Ncomb, tbc)
implicit none
integer, intent(inout) :: Ncomb
double precision, intent(out) :: comb(Ncomb)
integer, intent(inout) :: tbc(0:size_tbc)
integer, intent(inout) :: Ncomb
logical, intent(inout) :: computed(N_det_generators)
integer :: i, j, last_full, dets(comb_teeth), tbc_save
integer :: icount, n

11
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -564,11 +564,10 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
use bitmasks
implicit none
integer, intent(in) :: interesting(0:N_sel)
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel)
integer, intent(in) :: sp, i_gen, N_sel
logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
integer, intent(in) :: sp, i_gen, N_sel
integer, intent(in) :: interesting(0:N_sel)
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel)
logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt
@ -1043,9 +1042,9 @@ subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting)
use bitmasks
implicit none
integer, intent(in) :: i_gen, N
integer, intent(in) :: interesting(0:N)
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N)
integer, intent(in) :: i_gen, N
logical, intent(inout) :: banned(mo_tot_num, mo_tot_num)
logical, intent(out) :: fullMatch

2
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -32,7 +32,7 @@ subroutine ZMQ_selection(N_in, pt2)
k=0
do i= 1, N_det_generators
k = k+1
write(task(20*(k-1)+1:20*k),'(I9,X,I9,''|'')') i, N
write(task(20*(k-1)+1:20*k),'(I9,1X,I9,''|'')') i, N
k = k+20
if (k>20*maxtasks) then
k=0

24
plugins/MRPT_Utils/energies_cas.irp.f
View File

@ -898,7 +898,7 @@ END_PROVIDER
enddo
print*, '***'
do i = 1, N_det+1
write(*,'(100(F16.10,X))')H_matrix(i,:)
write(*,'(100(F16.10,1X))')H_matrix(i,:)
enddo
call lapack_diag(eigenvalues,eigenvectors,H_matrix,size(H_matrix,1),N_det+1)
corr_e_from_1h1p(state_target) += eigenvalues(1) - energy_cas_dyall(state_target)
@ -919,15 +919,15 @@ END_PROVIDER
norm += psi_in_out_coef(i,state_target) * psi_in_out_coef(i,state_target)
enddo
print*, 'Coef '
write(*,'(100(X,F16.10))')psi_coef(1:N_det,state_target)
write(*,'(100(X,F16.10))')psi_in_out_coef(:,state_target)
write(*,'(100(1X,F16.10))')psi_coef(1:N_det,state_target)
write(*,'(100(1X,F16.10))')psi_in_out_coef(:,state_target)
double precision :: coef_tmp(N_det)
do i = 1, N_det
coef_tmp(i) = psi_coef(i,1) * interact_psi0(i) / delta_e_alpha_beta(i,ispin)
enddo
write(*,'(100(X,F16.10))')coef_tmp(:)
write(*,'(100(1X,F16.10))')coef_tmp(:)
print*, 'naked interactions'
write(*,'(100(X,F16.10))')interact_psi0(:)
write(*,'(100(1X,F16.10))')interact_psi0(:)
print*, ''
print*, 'norm ',norm
@ -953,10 +953,10 @@ END_PROVIDER
enddo
enddo
print*, '***'
write(*,'(100(X,F16.10))')
write(*,'(100(X,F16.10))')delta_e_alpha_beta(:,2)
! write(*,'(100(X,F16.10))')one_anhil_one_creat_inact_virt_bis(iorb,vorb,:,1,:)
! write(*,'(100(X,F16.10))')one_anhil_one_creat_inact_virt_bis(iorb,vorb,:,2,:)
write(*,'(100(1X,F16.10))')
write(*,'(100(1X,F16.10))')delta_e_alpha_beta(:,2)
! write(*,'(100(1X,F16.10))')one_anhil_one_creat_inact_virt_bis(iorb,vorb,:,1,:)
! write(*,'(100(1X,F16.10))')one_anhil_one_creat_inact_virt_bis(iorb,vorb,:,2,:)
print*, '---------------------------------------------------------------------------'
enddo
enddo
@ -1089,11 +1089,11 @@ subroutine give_singles_and_partial_doubles_1h1p_contrib(matrix_1h1p,e_corr_from
print*, 'e corr perturb EN',accu(state_target)
print*, ''
print*, 'coef diagonalized'
write(*,'(100(F16.10,X))')psi_in_out_coef(:,state_target)
write(*,'(100(F16.10,1X))')psi_in_out_coef(:,state_target)
print*, 'coef_perturb'
write(*,'(100(F16.10,X))')coef_perturb(:)
write(*,'(100(F16.10,1X))')coef_perturb(:)
print*, 'coef_perturb EN'
write(*,'(100(F16.10,X))')coef_perturb_bis(:)
write(*,'(100(F16.10,1X))')coef_perturb_bis(:)
endif
integer :: k
do k = 1, N_det

2
plugins/MRPT_Utils/excitations_cas.irp.f
View File

@ -22,7 +22,7 @@ subroutine apply_exc_to_psi(orb,hole_particle,spin_exc, &
integer :: elec_num_tab_local(2)
integer :: i,j,accu_elec,k
integer :: det_tmp(N_int), det_tmp_bis(N_int)
integer(bit_kind) :: det_tmp(N_int), det_tmp_bis(N_int)
double precision :: phase
double precision :: norm_factor

2
plugins/Properties/delta_rho.irp.f
View File

@ -6,7 +6,7 @@
z_min = 0.d0
z_max = 10.d0
delta_z = 0.005d0
N_z_pts = (z_max - z_min)/delta_z
N_z_pts = int( (z_max - z_min)/delta_z )
print*,'N_z_pts = ',N_z_pts
END_PROVIDER

2
plugins/Properties/hyperfine_constants.irp.f
View File

@ -151,7 +151,7 @@ subroutine print_hcc
integer :: i,j
print*,'Z AU GAUSS MHZ cm^-1'
do i = 1, nucl_num
write(*,'(I2,X,F4.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i)
write(*,'(I2,1X,F4.1,1X,4(F16.6,1X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i)
enddo
end

4
plugins/Properties/mulliken.irp.f
View File

@ -126,7 +126,7 @@ subroutine print_mulliken_sd
accu = 0.d0
do i = 1, ao_num
accu += spin_gross_orbital_product(i)
write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i)
write(*,'(1X,I3,1X,A4,1X,I2,1X,A4,1X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i)
enddo
print*,'sum = ',accu
accu = 0.d0
@ -142,7 +142,7 @@ subroutine print_mulliken_sd
accu = 0.d0
do i = 0, ao_l_max
accu += spin_population_angular_momentum_per_atom(i,j)
write(*,'(XX,I3,XX,A4,X,A4,X,F10.7)')j,trim(element_name(int(nucl_charge(j)))),trim(l_to_charater(i)),spin_population_angular_momentum_per_atom(i,j)
write(*,'(1X,I3,1X,A4,1X,A4,1X,F10.7)')j,trim(element_name(int(nucl_charge(j)))),trim(l_to_charater(i)),spin_population_angular_momentum_per_atom(i,j)
print*,'sum = ',accu
enddo
enddo

4
src/Davidson/diagonalization.irp.f
View File

@ -355,7 +355,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia
write(iunit,'(A)') trim(write_buffer)
write_buffer = ' Iter'
do i=1,N_st
write_buffer = trim(write_buffer)//' Energy Residual'
write_buffer = trim(write_buffer)//' Energy Residual'
enddo
write(iunit,'(A)') trim(write_buffer)
write_buffer = '===== '
@ -502,7 +502,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia
endif
enddo
write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))') iter, to_print(:,1:N_st)
write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,E16.6))') iter, to_print(:,1:N_st)
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged)
if (converged) then
exit

4
src/Davidson/diagonalization_hs2.irp.f
View File

@ -413,7 +413,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
endif
enddo
write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,1:N_st)
write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter, to_print(1:3,1:N_st)
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged)
do k=1,N_st
if (residual_norm(k) > 1.e8) then
@ -838,7 +838,7 @@ subroutine davidson_diag_hjj_sjj_mmap(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
endif
enddo
write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,1:N_st)
write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter, to_print(1:3,1:N_st)
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged)
do k=1,N_st
if (residual_norm(k) > 1.e8) then

4
src/Davidson/u0Hu0.irp.f
View File

@ -342,7 +342,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_
! istep = 1+ int(workload*target_workload_inv)
istep = 1
do blockb2=0, istep-1
write(tmp_task,'(3(I9,X),''|'',X)') sh, blockb2, istep
write(tmp_task,'(3(I9,1X),''|'',1X)') sh, blockb2, istep
task = task//tmp_task
ipos += 32
if (ipos+32 > iposmax) then
@ -918,8 +918,8 @@ end
subroutine H_S2_u_0_nstates_test(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: keys_tmp(Nint,2,n)
integer, intent(in) :: N_st,n,Nint, sze_8
integer(bit_kind), intent(in) :: keys_tmp(Nint,2,n)
double precision, intent(out) :: v_0(sze_8,N_st), s_0(sze_8,N_st)
double precision, intent(in) :: u_0(sze_8,N_st)
double precision, intent(in) :: H_jj(n), S2_jj(n)

4
src/Determinants/determinants.irp.f
View File

@ -23,7 +23,7 @@ BEGIN_PROVIDER [ integer, N_det ]
! Number of determinants in the wave function
END_DOC
logical :: exists
character*64 :: label
character*(64) :: label
PROVIDE ezfio_filename
PROVIDE nproc
if (read_wf) then
@ -88,7 +88,7 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ]
END_DOC
integer :: i
logical :: exists
character*64 :: label
character*(64) :: label
psi_det = 0_bit_kind
if (read_wf) then

6
src/Determinants/s2.irp.f
View File

@ -252,8 +252,8 @@ end
subroutine get_uJ_s2_uI(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_keys,s2,nstates)
implicit none
use bitmasks
integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys)
integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates
integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys)
double precision, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates)
double precision, intent(out) :: s2(nstates,nstates)
double precision :: s2_tmp,accu
@ -344,7 +344,7 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,u_0,n,nmax_keys,nmax_coefs,nsta
print*,'S^2 matrix in the basis of the states considered'
do i = 1, nstates
write(*,'(100(F5.2,X))')s2(i,:)
write(*,'(100(F5.2,1X))')s2(i,:)
enddo
double precision :: accu_precision_diag,accu_precision_of_diag
@ -370,7 +370,7 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,u_0,n,nmax_keys,nmax_coefs,nsta
print*,'Modified S^2 matrix that will be diagonalized'
do i = 1, nstates
write(*,'(10(F5.2,X))')s2(i,:)
write(*,'(10(F5.2,1X))')s2(i,:)
s2(i,i) = s2(i,i)
enddo

74
src/Determinants/slater_rules.irp.f
View File

@ -184,50 +184,50 @@ subroutine decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2)
select case(degree)
case(2)
if (exc(0,1,1) == 2) then
h1 = exc(1,1,1)
h2 = exc(2,1,1)
p1 = exc(1,2,1)
p2 = exc(2,2,1)
s1 = 1
s2 = 1
h1 = int(exc(1,1,1),2)
h2 = int(exc(2,1,1),2)
p1 = int(exc(1,2,1),2)
p2 = int(exc(2,2,1),2)
s1 = 1_2
s2 = 1_2
else if (exc(0,1,2) == 2) then
h1 = exc(1,1,2)
h2 = exc(2,1,2)
p1 = exc(1,2,2)
p2 = exc(2,2,2)
s1 = 2
s2 = 2
h1 = int(exc(1,1,2),2)
h2 = int(exc(2,1,2),2)
p1 = int(exc(1,2,2),2)
p2 = int(exc(2,2,2),2)
s1 = 2_2
s2 = 2_2
else
h1 = exc(1,1,1)
h2 = exc(1,1,2)
p1 = exc(1,2,1)
p2 = exc(1,2,2)
s1 = 1
s2 = 2
h1 = int(exc(1,1,1),2)
h2 = int(exc(1,1,2),2)
p1 = int(exc(1,2,1),2)
p2 = int(exc(1,2,2),2)
s1 = 1_2
s2 = 2_2
endif
case(1)
if (exc(0,1,1) == 1) then
h1 = exc(1,1,1)
h2 = 0
p1 = exc(1,2,1)
p2 = 0
s1 = 1
s2 = 0
h1 = int(exc(1,1,1),2)
h2 = 0_2
p1 = int(exc(1,2,1),2)
p2 = 0_2
s1 = 1_2
s2 = 0_2
else
h1 = exc(1,1,2)
h2 = 0
p1 = exc(1,2,2)
p2 = 0
s1 = 2
s2 = 0
h1 = int(exc(1,1,2),2)
h2 = 0_2
p1 = int(exc(1,2,2),2)
p2 = 0_2
s1 = 2_2
s2 = 0_2
endif
case(0)
h1 = 0
p1 = 0
h2 = 0
p2 = 0
s1 = 0
s2 = 0
h1 = 0_2
p1 = 0_2
h2 = 0_2
p2 = 0_2
s1 = 0_2
s2 = 0_2
end select
end
@ -2181,8 +2181,8 @@ end
subroutine get_phase(key1,key2,phase,Nint)
use bitmasks
implicit none
integer(bit_kind), intent(in) :: key1(Nint,2), key2(Nint,2)
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key1(Nint,2), key2(Nint,2)
double precision, intent(out) :: phase
BEGIN_DOC
! Returns the phase between key1 and key2

9
src/Determinants/usefull_for_ovb.irp.f → src/Determinants/useful_for_ovb.irp.f
View File

@ -2,7 +2,8 @@
integer function n_open_shell(det_in,nint)
implicit none
use bitmasks
integer(bit_kind), intent(in) :: det_in(nint,2),nint
integer, intent(in) :: nint
integer(bit_kind), intent(in) :: det_in(nint,2)
integer :: i
n_open_shell = 0
do i=1,Nint
@ -13,7 +14,8 @@ end
integer function n_closed_shell(det_in,nint)
implicit none
use bitmasks
integer(bit_kind), intent(in) :: det_in(nint,2),nint
integer, intent(in) :: nint
integer(bit_kind), intent(in) :: det_in(nint,2)
integer :: i
n_closed_shell = 0
do i=1,Nint
@ -24,7 +26,8 @@ end
integer function n_closed_shell_cas(det_in,nint)
implicit none
use bitmasks
integer(bit_kind), intent(in) :: det_in(nint,2),nint
integer, intent(in) :: nint
integer(bit_kind), intent(in) :: det_in(nint,2)
integer(bit_kind) :: det_tmp(nint,2)
integer :: i
n_closed_shell_cas = 0

6
src/MO_Basis/utils.irp.f
View File

@ -88,7 +88,7 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign)
enddo
endif
do i=1,m
write (output_mo_basis,'(I8,X,F16.10)') i,eigvalues(i)
write (output_mo_basis,'(I8,1X,F16.10)') i,eigvalues(i)
enddo
write (output_mo_basis,'(A)') '======== ================'
write (output_mo_basis,'(A)') ''
@ -135,7 +135,7 @@ subroutine mo_as_svd_vectors_of_mo_matrix(matrix,lda,m,n,label)
write (output_mo_basis,'(A)') '======== ================'
do i=1,m
write (output_mo_basis,'(I8,X,F16.10)') i,D(i)
write (output_mo_basis,'(I8,1X,F16.10)') i,D(i)
enddo
write (output_mo_basis,'(A)') '======== ================'
write (output_mo_basis,'(A)') ''
@ -215,7 +215,7 @@ subroutine mo_as_eigvectors_of_mo_matrix_sort_by_observable(matrix,observable,n,
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') '======== ================'
do i = 1, m
write (output_mo_basis,'(I8,X,F16.10)') i,eigvalues(i)
write (output_mo_basis,'(I8,1X,F16.10)') i,eigvalues(i)
enddo
write (output_mo_basis,'(A)') '======== ================'
write (output_mo_basis,'(A)') ''

4
src/Nuclei/nuclei.irp.f
View File

@ -37,8 +37,8 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num_aligned,3) ]
enddo
deallocate(buffer)
character*(64), parameter :: f = '(A16, 4(X,F12.6))'
character*(64), parameter :: ft= '(A16, 4(X,A12 ))'
character*(64), parameter :: f = '(A16, 4(1X,F12.6))'
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
double precision, parameter :: a0= 0.529177249d0
call write_time(output_Nuclei)
write(output_Nuclei,'(A)') ''

6
src/Utils/map_functions.irp.f
View File

@ -76,8 +76,8 @@ subroutine map_load_from_disk(filename,map)
double precision :: x
type(c_ptr) :: c_pointer(3)
integer :: fd(3)
integer*8 :: i,k, l
integer :: n_elements, j
integer*8 :: i,k,l
integer*4 :: j,n_elements
@ -112,7 +112,7 @@ subroutine map_load_from_disk(filename,map)
! Load memory from disk
do j=1,n_elements
x = x + map % map(i) % value(j)
l = iand(l,map % map(i) % key(j))
l = iand(l,int(map % map(i) % key(j),8))
if (map % map(i) % value(j) > 1.e30) then
stop 'Error in integrals file'
endif

2
src/Utils/map_module.f90
View File

@ -407,7 +407,7 @@ subroutine map_update(map, key, value, sze, thr)
call cache_map_shrink(local_map,thr)
endif
cache_key = iand(key(i),map_mask)
local_map%n_elements = local_map%n_elements + 1_8
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.