LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 20:35:19 +01:00
Code Issues Releases Wiki Activity

Fixed four-idx

Browse Source
This commit is contained in:
Anthony Scemama 2017-10-16 22:41:40 +02:00
parent 7db4bf509b
commit 8854eeb457
2 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/FourIdx/four_index_block.irp.f
View File

@ -145,7 +145,7 @@ subroutine four_index_transform_block(map_a,map_c,matrix_B,LDB, &
!$OMP i_min,i_max,j_min,j_max,k_min,k_max,l_min,l_max, & !$OMP i_min,i_max,j_min,j_max,k_min,k_max,l_min,l_max, &
!$OMP map_c,matrix_B,l_pointer) & !$OMP map_c,matrix_B,l_pointer) &
!$OMP PRIVATE(key,value,T,U,V,i,j,k,l,idx,ik,ll, & !$OMP PRIVATE(key,value,T,U,V,i,j,k,l,idx,ik,ll, &
!$OMP a,b,c,d,tmp,T2d,V2d,ii) !$OMP a,b,c,d,tmp,T2d,V2d,ii,p,q)
allocate( key(i_max*j_max*k_max), value(i_max*j_max*k_max) ) allocate( key(i_max*j_max*k_max), value(i_max*j_max*k_max) )
allocate( U(a_start:a_end, c_start:c_end, b_start:b_end) ) allocate( U(a_start:a_end, c_start:c_end, b_start:b_end) )
@ -240,31 +240,30 @@ subroutine four_index_transform_block(map_a,map_c,matrix_B,LDB, &
enddo enddo
idx = 0_8 idx = 0_8
integer :: p, q
do b=b_start,d do b=b_start,d
q = b+ishft(d*d-d,-1)
do c=c_start,c_end do c=c_start,c_end
p = a_start+ishft(c*c-c,-1)
do a=a_start,min(b,c) do a=a_start,min(b,c)
if (a==b) cycle
if (dabs(U(a,c,b)) < 1.d-15) then if (dabs(U(a,c,b)) < 1.d-15) then
cycle cycle
endif endif
if ((a==b).and.(p>q)) cycle
p = p+1
idx = idx+1_8 idx = idx+1_8
call bielec_integrals_index(a,b,c,d,key(idx)) call bielec_integrals_index(a,b,c,d,key(idx))
!print *, int(key(idx),4), int(a,2),int(b,2),int(c,2),int(d,2), p, q
value(idx) = U(a,c,b) value(idx) = U(a,c,b)
enddo enddo
enddo enddo
enddo enddo
do b=b_start,d
a=b
do c=c_start,d
if (dabs(U(a,c,b)) < 1.d-15) then
cycle
endif
idx = idx+1_8
call bielec_integrals_index(a,b,c,d,key(idx))
value(idx) = U(a,c,b)
enddo
enddo
!$OMP CRITICAL !$OMP CRITICAL
call map_update(map_c, key, value, idx,1.d-15) call map_update(map_c, key, value, idx,1.d-15)

2
tests/bats/fci.bats
View File

@ -42,7 +42,7 @@ function run_FCI_ZMQ() {
qp_set_mo_class h2o.ezfio -core "[1]" -act "[2-12]" -del "[13-24]" qp_set_mo_class h2o.ezfio -core "[1]" -act "[2-12]" -del "[13-24]"
} }
@test "FCI H2O cc-pVDZ" { @test "FCI H2O cc-pVDZ" {
run_FCI h2o.ezfio 2000 -76.125246738693903 -76.1258130146102 run_FCI h2o.ezfio 2000 -76.1253757275131 -76.1258128174355
} }