mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-31 00:23:42 +02:00
Acceleration of davidson
This commit is contained in:
parent
4feffb008f
commit
fbe4531125
@ -1,41 +0,0 @@
|
|||||||
use bitmasks
|
|
||||||
BEGIN_PROVIDER [ integer, N_con_int ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Number of integers to represent the connections between determinants
|
|
||||||
END_DOC
|
|
||||||
N_con_int = 1 + ishft(N_det-1,-13)
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer*8, det_connections, (N_con_int,N_det) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
!
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j
|
|
||||||
integer :: degree
|
|
||||||
integer :: j_int, j_k, j_l
|
|
||||||
!$OMP PARALLEL DEFAULT (NONE) &
|
|
||||||
!$OMP SHARED(N_det, N_con_int, psi_det,N_int, det_connections) &
|
|
||||||
!$OMP PRIVATE(i,j_int,j_k,j_l,j,degree)
|
|
||||||
!$OMP DO SCHEDULE(guided)
|
|
||||||
do i=1,N_det
|
|
||||||
do j_int=1,N_con_int
|
|
||||||
det_connections(j_int,i) = 0_8
|
|
||||||
j_k = ishft(j_int-1,13)
|
|
||||||
do j_l = j_k,min(j_k+8191,N_det), 128
|
|
||||||
do j = j_l+1,min(j_l+128,i)
|
|
||||||
call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int)
|
|
||||||
if (degree < 3) then
|
|
||||||
det_connections(j_int,i) = ibset( det_connections(j_int,i), iand(63,ishft(j_l,-7)) )
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!$OMP ENDDO
|
|
||||||
!$OMP ENDPARALLEL
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
@ -32,7 +32,9 @@ subroutine filter_connected(key1,key2,Nint,sze,idx)
|
|||||||
do i=1,sze
|
do i=1,sze
|
||||||
degree_x2 = popcnt( xor( key1(1,1,i), key2(1,1))) &
|
degree_x2 = popcnt( xor( key1(1,1,i), key2(1,1))) &
|
||||||
+ popcnt( xor( key1(1,2,i), key2(1,2)))
|
+ popcnt( xor( key1(1,2,i), key2(1,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
|
cycle
|
||||||
|
else
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
@ -46,7 +48,9 @@ subroutine filter_connected(key1,key2,Nint,sze,idx)
|
|||||||
popcnt(xor( key1(2,1,i), key2(2,1))) + &
|
popcnt(xor( key1(2,1,i), key2(2,1))) + &
|
||||||
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
||||||
popcnt(xor( key1(2,2,i), key2(2,2)))
|
popcnt(xor( key1(2,2,i), key2(2,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
|
cycle
|
||||||
|
else
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
@ -62,7 +66,9 @@ subroutine filter_connected(key1,key2,Nint,sze,idx)
|
|||||||
popcnt(xor( key1(2,2,i), key2(2,2))) + &
|
popcnt(xor( key1(2,2,i), key2(2,2))) + &
|
||||||
popcnt(xor( key1(3,1,i), key2(3,1))) + &
|
popcnt(xor( key1(3,1,i), key2(3,1))) + &
|
||||||
popcnt(xor( key1(3,2,i), key2(3,2)))
|
popcnt(xor( key1(3,2,i), key2(3,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
|
cycle
|
||||||
|
else
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
@ -128,11 +134,13 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
|
|||||||
do j_int=1,N_con_int
|
do j_int=1,N_con_int
|
||||||
itmp = det_connections(j_int,i)
|
itmp = det_connections(j_int,i)
|
||||||
do while (itmp /= 0_8)
|
do while (itmp /= 0_8)
|
||||||
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
|
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
|
||||||
do j = j_start+1, min(j_start+128,i-1)
|
do j = j_start+1, min(j_start+32,i-1)
|
||||||
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
|
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
|
||||||
popcnt(xor( key1(1,2,j), key2(1,2)))
|
popcnt(xor( key1(1,2,j), key2(1,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
|
cycle
|
||||||
|
else
|
||||||
idx(l) = j
|
idx(l) = j
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
@ -148,13 +156,15 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
|
|||||||
do j_int=1,N_con_int
|
do j_int=1,N_con_int
|
||||||
itmp = det_connections(j_int,i)
|
itmp = det_connections(j_int,i)
|
||||||
do while (itmp /= 0_8)
|
do while (itmp /= 0_8)
|
||||||
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
|
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
|
||||||
do j = j_start+1, min(j_start+128,i-1)
|
do j = j_start+1, min(j_start+32,i-1)
|
||||||
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
|
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
|
||||||
popcnt(xor( key1(2,1,j), key2(2,1))) + &
|
popcnt(xor( key1(2,1,j), key2(2,1))) + &
|
||||||
popcnt(xor( key1(1,2,j), key2(1,2))) + &
|
popcnt(xor( key1(1,2,j), key2(1,2))) + &
|
||||||
popcnt(xor( key1(2,2,j), key2(2,2)))
|
popcnt(xor( key1(2,2,j), key2(2,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
|
cycle
|
||||||
|
else
|
||||||
idx(l) = j
|
idx(l) = j
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
@ -170,15 +180,17 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
|
|||||||
do j_int=1,N_con_int
|
do j_int=1,N_con_int
|
||||||
itmp = det_connections(j_int,i)
|
itmp = det_connections(j_int,i)
|
||||||
do while (itmp /= 0_8)
|
do while (itmp /= 0_8)
|
||||||
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
|
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
|
||||||
do j = j_start+1, min(j_start+128,i-1)
|
do j = j_start+1, min(j_start+32,i-1)
|
||||||
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
|
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
|
||||||
popcnt(xor( key1(1,2,j), key2(1,2))) + &
|
popcnt(xor( key1(1,2,j), key2(1,2))) + &
|
||||||
popcnt(xor( key1(2,1,j), key2(2,1))) + &
|
popcnt(xor( key1(2,1,j), key2(2,1))) + &
|
||||||
popcnt(xor( key1(2,2,j), key2(2,2))) + &
|
popcnt(xor( key1(2,2,j), key2(2,2))) + &
|
||||||
popcnt(xor( key1(3,1,j), key2(3,1))) + &
|
popcnt(xor( key1(3,1,j), key2(3,1))) + &
|
||||||
popcnt(xor( key1(3,2,j), key2(3,2)))
|
popcnt(xor( key1(3,2,j), key2(3,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
|
cycle
|
||||||
|
else
|
||||||
idx(l) = j
|
idx(l) = j
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
@ -194,8 +206,8 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
|
|||||||
do j_int=1,N_con_int
|
do j_int=1,N_con_int
|
||||||
itmp = det_connections(j_int,i)
|
itmp = det_connections(j_int,i)
|
||||||
do while (itmp /= 0_8)
|
do while (itmp /= 0_8)
|
||||||
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
|
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
|
||||||
do j = j_start+1, min(j_start+128,i-1)
|
do j = j_start+1, min(j_start+32,i-1)
|
||||||
degree_x2 = 0
|
degree_x2 = 0
|
||||||
!DEC$ LOOP COUNT MIN(4)
|
!DEC$ LOOP COUNT MIN(4)
|
||||||
do k=1,Nint
|
do k=1,Nint
|
||||||
@ -250,12 +262,12 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
|||||||
do i=1,sze
|
do i=1,sze
|
||||||
degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||||
popcnt(xor( key1(1,2,i), key2(1,2)))
|
popcnt(xor( key1(1,2,i), key2(1,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
if(degree_x2 .ne. 0)then
|
cycle
|
||||||
|
else if(degree_x2 .ne. 0)then
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else if (Nint==2) then
|
else if (Nint==2) then
|
||||||
@ -266,12 +278,12 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
|||||||
popcnt(xor( key1(2,1,i), key2(2,1))) + &
|
popcnt(xor( key1(2,1,i), key2(2,1))) + &
|
||||||
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
||||||
popcnt(xor( key1(2,2,i), key2(2,2)))
|
popcnt(xor( key1(2,2,i), key2(2,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
if(degree_x2 .ne. 0)then
|
cycle
|
||||||
|
else if(degree_x2 .ne. 0)then
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else if (Nint==3) then
|
else if (Nint==3) then
|
||||||
@ -284,12 +296,12 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
|||||||
popcnt(xor( key1(2,2,i), key2(2,2))) + &
|
popcnt(xor( key1(2,2,i), key2(2,2))) + &
|
||||||
popcnt(xor( key1(3,1,i), key2(3,1))) + &
|
popcnt(xor( key1(3,1,i), key2(3,1))) + &
|
||||||
popcnt(xor( key1(3,2,i), key2(3,2)))
|
popcnt(xor( key1(3,2,i), key2(3,2)))
|
||||||
if (degree_x2 < 5) then
|
if (degree_x2 > 4) then
|
||||||
if(degree_x2 .ne. 0)then
|
cycle
|
||||||
|
else if(degree_x2 .ne. 0)then
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else
|
else
|
||||||
@ -305,12 +317,12 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
|||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
if (degree_x2 <= 5) then
|
if (degree_x2 > 4) then
|
||||||
if(degree_x2 .ne. 0)then
|
cycle
|
||||||
|
else if(degree_x2 .ne. 0)then
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
endif
|
endif
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
@ -887,3 +887,47 @@ end
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, N_con_int ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of integers to represent the connections between determinants
|
||||||
|
END_DOC
|
||||||
|
N_con_int = 1 + ishft(N_det-1,-11)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer*8, det_connections, (N_con_int,N_det) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
integer :: degree
|
||||||
|
integer :: j_int, j_k, j_l
|
||||||
|
integer, allocatable :: idx(:)
|
||||||
|
!$OMP PARALLEL DEFAULT (NONE) &
|
||||||
|
!$OMP SHARED(N_det, N_con_int, psi_det,N_int, det_connections) &
|
||||||
|
!$OMP PRIVATE(i,j_int,j_k,j_l,j,degree,idx)
|
||||||
|
allocate (idx(0:N_det))
|
||||||
|
!$OMP DO SCHEDULE(guided)
|
||||||
|
do i=1,N_det
|
||||||
|
do j_int=1,N_con_int
|
||||||
|
det_connections(j_int,i) = 0_8
|
||||||
|
j_k = ishft(j_int-1,11)
|
||||||
|
do j_l = j_k,min(j_k+2047,N_det), 32
|
||||||
|
do j = j_l+1,min(j_l+32,i)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int)
|
||||||
|
if (degree < 3) then
|
||||||
|
det_connections(j_int,i) = ibset( det_connections(j_int,i), iand(63,ishft(j_l,-5)) )
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP ENDDO
|
||||||
|
deallocate(idx)
|
||||||
|
!$OMP ENDPARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user