From 4feffb008fbc350284d65596ab0eb10a3207355f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 30 May 2014 22:48:09 +0200 Subject: [PATCH] Corrected filter_connected_davidson --- src/Dets/README.rst | 16 ++--- src/Dets/filter_connected.irp.f | 110 +++++++++++++++++--------------- src/Dets/slater_rules.irp.f | 8 ++- 3 files changed, 72 insertions(+), 62 deletions(-) diff --git a/src/Dets/README.rst b/src/Dets/README.rst index 5c731ff9..cc3e6597 100644 --- a/src/Dets/README.rst +++ b/src/Dets/README.rst @@ -77,6 +77,12 @@ Documentation `key_pattern_not_in_ref `_ Min and max values of the integers of the keys of the reference +`det_connections `_ + .br + +`n_con_int `_ + Number of integers to represent the connections between determinants + `davidson_converged `_ True if the Davidson algorithm is converged @@ -228,15 +234,7 @@ Documentation idx(0) is the number of determinants that interact with key1 `filter_connected_i_h_psi0_sc2 `_ - standard filter_connected_i_H_psi but returns in addition - .br - the array of the index of the non connected determinants to key1 - .br - in order to know what double excitation can be repeated on key1 - .br - idx_repeat(0) is the number of determinants that can be used - .br - to repeat the excitations + Undocumented `get_s2 `_ Returns diff --git a/src/Dets/filter_connected.irp.f b/src/Dets/filter_connected.irp.f index c859f20c..058c8689 100644 --- a/src/Dets/filter_connected.irp.f +++ b/src/Dets/filter_connected.irp.f @@ -111,7 +111,7 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx) integer(bit_kind), intent(in) :: key2(Nint,2) integer, intent(out) :: idx(0:sze) - integer :: i,j,l + integer :: i,j,k,l integer :: degree_x2 integer :: j_int, j_start integer*8 :: itmp @@ -140,70 +140,80 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx) itmp = iand(itmp-1_8,itmp) enddo enddo - - ! l=1 - ! !DIR$ LOOP COUNT (1000) - ! do i=1,sze - ! degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + & - ! popcnt(xor( key1(2,1,i), key2(2,1))) - ! if (degree_x2 < 5) then - ! if (idx(l) /= i) then - ! print *, l, idx(l), i - ! endif - ! idx(l) = i - ! l = l+1 - ! endif - ! enddo else if (Nint==2) then - !DIR$ LOOP COUNT (1000) - do i=1,sze - degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + & - 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 - idx(l) = i - l = l+1 - endif + + i = idx(0) + 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) + 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 + idx(l) = j + l = l+1 + endif + enddo + itmp = iand(itmp-1_8,itmp) + enddo enddo else if (Nint==3) then !DIR$ LOOP COUNT (1000) - do i=1,sze - degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + & - popcnt(xor( key1(1,2,i), key2(1,2))) + & - popcnt(xor( key1(2,1,i), key2(2,1))) + & - 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 - idx(l) = i - l = l+1 - endif + i = idx(0) + 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) + 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 + idx(l) = j + l = l+1 + endif + enddo + itmp = iand(itmp-1_8,itmp) + enddo enddo else !DIR$ LOOP COUNT (1000) - do i=1,sze - degree_x2 = 0 - !DEC$ LOOP COUNT MIN(4) - do j=1,Nint - degree_x2 = degree_x2+ popcnt(xor( key1(j,1,i), key2(j,1))) +& - popcnt(xor( key1(j,2,i), key2(j,2))) - if (degree_x2 > 4) then - exit - endif + i = idx(0) + 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) + degree_x2 = 0 + !DEC$ LOOP COUNT MIN(4) + do k=1,Nint + degree_x2 = degree_x2+ popcnt(xor( key1(k,1,j), key2(k,1))) +& + popcnt(xor( key1(k,2,j), key2(k,2))) + if (degree_x2 > 4) then + exit + endif + enddo + if (degree_x2 <= 5) then + idx(l) = j + l = l+1 + endif + enddo + itmp = iand(itmp-1_8,itmp) enddo - if (degree_x2 <= 5) then - idx(l) = i - l = l+1 - endif enddo - + endif idx(0) = l-1 end diff --git a/src/Dets/slater_rules.irp.f b/src/Dets/slater_rules.irp.f index 7c786f8b..0b0ceb08 100644 --- a/src/Dets/slater_rules.irp.f +++ b/src/Dets/slater_rules.irp.f @@ -868,9 +868,11 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint) call filter_connected_davidson(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx) do jj=1,idx(0) j = idx(jj) - call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij) - vt (i) = vt (i) + hij*u_0(j) - vt (j) = vt (j) + hij*u_0(i) + if ( (dabs(u_0(j)) > 1.d-7).or.((dabs(u_0(i)) > 1.d-7)) ) then + call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij) + vt (i) = vt (i) + hij*u_0(j) + vt (j) = vt (j) + hij*u_0(i) + endif enddo enddo !$OMP END DO