LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-09 12:44:07 +01:00
Code Issues Releases Wiki Activity

Acceleration of davidson

Browse Source
This commit is contained in:
Anthony Scemama 2014-05-30 23:01:56 +02:00
parent 4feffb008f
commit fbe4531125
3 changed files with 88 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Dets/connections.irp.f
View File

@ -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

76
src/Dets/filter_connected.irp.f
View File

@ -32,7 +32,9 @@ subroutine filter_connected(key1,key2,Nint,sze,idx)
do i=1,sze
degree_x2 = popcnt( xor( key1(1,1,i), key2(1,1))) &
+ popcnt( xor( key1(1,2,i), key2(1,2)))
if (degree_x2 < 5) then
if (degree_x2 > 4) then
cycle
else
idx(l) = i
l = l+1
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(1,2,i), key2(1,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
l = l+1
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(3,1,i), key2(3,1))) + &
popcnt(xor( key1(3,2,i), key2(3,2)))
if (degree_x2 < 5) then
if (degree_x2 > 4) then
cycle
else
idx(l) = i
l = l+1
endif
@ -128,11 +134,13 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
do j = j_start+1, min(j_start+32,i-1)
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
popcnt(xor( key1(1,2,j), key2(1,2)))
if (degree_x2 < 5) then
if (degree_x2 > 4) then
cycle
else
idx(l) = j
l = l+1
endif
@ -148,13 +156,15 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
do j = j_start+1, min(j_start+32,i-1)
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
popcnt(xor( key1(2,1,j), key2(2,1))) + &
popcnt(xor( key1(1,2,j), key2(1,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
l = l+1
endif
@ -170,15 +180,17 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
do j = j_start+1, min(j_start+32,i-1)
degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) + &
popcnt(xor( key1(1,2,j), key2(1,2))) + &
popcnt(xor( key1(2,1,j), key2(2,1))) + &
popcnt(xor( key1(2,2,j), key2(2,2))) + &
popcnt(xor( key1(3,1,j), key2(3,1))) + &
popcnt(xor( key1(3,2,j), key2(3,2)))
if (degree_x2 < 5) then
if (degree_x2 > 4) then
cycle
else
idx(l) = j
l = l+1
endif
@ -194,8 +206,8 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
do j_int=1,N_con_int
itmp = det_connections(j_int,i)
do while (itmp /= 0_8)
j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
do j = j_start+1, min(j_start+128,i-1)
j_start = ishft(j_int-1,11) + ishft(trailz(itmp),5)
do j = j_start+1, min(j_start+32,i-1)
degree_x2 = 0
!DEC$ LOOP COUNT MIN(4)
do k=1,Nint
@ -250,11 +262,11 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
do i=1,sze
degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2)))
if (degree_x2 < 5) then
if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
if (degree_x2 > 4) then
cycle
else if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
enddo
@ -266,11 +278,11 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
popcnt(xor( key1(2,1,i), key2(2,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,2,i), key2(2,2)))
if (degree_x2 < 5) then
if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
if (degree_x2 > 4) then
cycle
else if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
enddo
@ -284,11 +296,11 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
popcnt(xor( key1(2,2,i), key2(2,2))) + &
popcnt(xor( key1(3,1,i), key2(3,1))) + &
popcnt(xor( key1(3,2,i), key2(3,2)))
if (degree_x2 < 5) then
if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
if (degree_x2 > 4) then
cycle
else if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
enddo
@ -305,11 +317,11 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
exit
endif
enddo
if (degree_x2 <= 5) then
if(degree_x2 .ne. 0)then
if (degree_x2 > 4) then
cycle
else if(degree_x2 .ne. 0)then
idx(l) = i
l = l+1
endif
endif
enddo

44
src/Dets/slater_rules.irp.f
View File

@ -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