LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-09-27 12:00:56 +02:00
Code Issues Releases Wiki Activity

Fixed SOP

Browse Source
This commit is contained in:
Anthony Scemama 2018-11-22 01:18:17 +01:00
parent c78fde9523
commit e251c2f147
1 changed files with 17 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
src/Determinants/occ_pattern.irp.f
View File

@ -327,62 +327,36 @@ BEGIN_PROVIDER [ integer, det_to_occ_pattern, (N_det) ]
key = occ_pattern_search_key(occ,N_int) key = occ_pattern_search_key(occ,N_int)
! Binary search ! TODO: Binary search
l = 1 l = 1
r = N_occ_pattern r = N_occ_pattern
do while(r-l > 1) ! do while(r-l > 32)
j = shiftr(r+l,1) ! j = shiftr(r+l,1)
if (bit_tmp(j) < key) then ! if (bit_tmp(j) < key) then
l = j ! l = j
else ! else
r = j ! r = j
endif ! endif
enddo ! enddo
do j=l,r
do while (bit_tmp(l) == key)
if (l == 0) then
print *, '1 bug in ', irp_here
stop -1
endif
found = .True. found = .True.
do k=1,N_int do k=1,N_int
if ( (occ(k,1) /= psi_occ_pattern(k,1,l)) & if ( (occ(k,1) /= psi_occ_pattern(k,1,j)) &
.or. (occ(k,2) /= psi_occ_pattern(k,2,l)) ) then .or. (occ(k,2) /= psi_occ_pattern(k,2,j)) ) then
found = .False. found = .False.
exit exit
endif endif
enddo enddo
if (found) then if (found) then
det_to_occ_pattern(i) = l det_to_occ_pattern(i) = j
r=1
exit exit
endif endif
l = l-1
enddo enddo
do while (bit_tmp(r) == key) if (.not.found) then
if (r > N_occ_pattern) then print *, '3 bug in ', irp_here
print *, '2 bug in ', irp_here stop -1
stop -1 endif
endif
found = .True.
do k=1,N_int
if ( (occ(k,1) /= psi_occ_pattern(k,1,r)) &
.or. (occ(k,2) /= psi_occ_pattern(k,2,r)) ) then
found = .False.
exit
endif
enddo
if (found) then
det_to_occ_pattern(i) = r
exit
endif
r = r+1
if (.not.found) then
print *, '3 bug in ', irp_here
stop -1
endif
enddo
enddo enddo
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
deallocate(bit_tmp) deallocate(bit_tmp)