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

Fixed many bugs

Browse Source
This commit is contained in:
Anthony Scemama 2017-02-10 03:24:12 +01:00
parent 1bea2ef2d5
commit 9354d7f5f1
3 changed files with 18 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -287,7 +287,7 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
logical :: fullMatch, ok
integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2)
integer,allocatable :: preinteresting(:), prefullinteresting(:), prefullinteresting_det(:,:,:), interesting(:), fullinteresting(:)
integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:)
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
logical :: monoAdo, monoBdo;
@ -297,7 +297,7 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
monoBdo = .true.
allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det))
allocate(preinteresting(0:N_det_selectors), prefullinteresting(0:N_det), interesting(0:N_det_selectors), fullinteresting(0:N_det), prefullinteresting_det(N_int,2,N_det))
allocate(preinteresting(0:N_det_selectors), prefullinteresting(0:N_det), interesting(0:N_det_selectors), fullinteresting(0:N_det))
do k=1,N_int
hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1))
@ -360,20 +360,13 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
else if(nt <= 2) then
prefullinteresting(0) += 1
prefullinteresting(prefullinteresting(0)) = i
do j=1,N_int
prefullinteresting_det(j,1,prefullinteresting(0)) = psi_det_sorted(j,1,i)
prefullinteresting_det(j,2,prefullinteresting(0)) = psi_det_sorted(j,2,i)
enddo
end if
end if
end do
maskInd = -1
logical, allocatable :: banned(:,:,:)
logical, allocatable :: bannedOrb(:,:)
allocate(bannedOrb(mo_tot_num,2), banned(mo_tot_num,mo_tot_num,2))
integer :: nb_count
do s1=1,2
do i1=N_holes(s1),1,-1 ! Generate low excitations first
@ -421,23 +414,23 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
do ii=1,prefullinteresting(0)
i = prefullinteresting(ii)
nt = 0
mobMask(1,1) = iand(negMask(1,1), prefullinteresting_det(1,1,ii))
mobMask(1,2) = iand(negMask(1,2), prefullinteresting_det(1,2,ii))
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i))
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
do j=2,N_int
mobMask(j,1) = iand(negMask(j,1), prefullinteresting_det(j,1,ii))
mobMask(j,2) = iand(negMask(j,2), prefullinteresting_det(j,2,ii))
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i))
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i))
nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
end do
if(nt <= 2) then
fullinteresting(0) += 1
fullinteresting(fullinteresting(0)) = i
fullminilist(1,1,fullinteresting(0)) = prefullinteresting_det(1,1,ii)
fullminilist(1,2,fullinteresting(0)) = prefullinteresting_det(1,2,ii)
fullminilist(1,1,fullinteresting(0)) = psi_det_sorted(1,1,i)
fullminilist(1,2,fullinteresting(0)) = psi_det_sorted(1,2,i)
do j=2,N_int
fullminilist(j,1,fullinteresting(0)) = prefullinteresting_det(j,1,ii)
fullminilist(j,2,fullinteresting(0)) = prefullinteresting_det(j,2,ii)
fullminilist(j,1,fullinteresting(0)) = psi_det_sorted(j,1,i)
fullminilist(j,2,fullinteresting(0)) = psi_det_sorted(j,2,i)
enddo
end if
end do
@ -453,6 +446,9 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
if(s1 == s2) ib = i1+1
monoAdo = .true.
do i2=N_holes(s2),ib,-1 ! Generate low excitations first
logical :: banned(mo_tot_num, mo_tot_num,2)
logical :: bannedOrb(mo_tot_num, 2)
maskInd += 1
if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then
h2 = hole_list(i2,s2)
@ -492,9 +488,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
enddo
enddo
enddo
deallocate(bannedOrb, banned, prefullinteresting_det, preinteresting_det)
deallocate(minilist, fullminilist)
deallocate(preinteresting, prefullinteresting, interesting, fullinteresting)
end

15
src/Davidson/u0Hu0.irp.f
View File

@ -405,7 +405,6 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
double precision, allocatable :: vt(:,:), ut(:,:), st(:,:)
integer :: i,j,k,l, jj,ii
integer :: i0, j0
logical, allocatable :: utloop(:)
integer, allocatable :: shortcut(:,:), sort_idx(:,:)
integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:)
@ -428,7 +427,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
PROVIDE ref_bitmask_energy
allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2))
allocate( ut(N_st_8,n), utloop(n) )
allocate( ut(N_st_8,n))
v_0 = 0.d0
s_0 = 0.d0
@ -438,19 +437,16 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE(i,hij,s2,j,k,jj,vt,st,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)&
!$OMP SHARED(n,keys_tmp,ut,Nint,u_0,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8,utloop)
!$OMP SHARED(n,keys_tmp,ut,Nint,u_0,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8)
allocate(vt(N_st_8,n),st(N_st_8,n))
Vt = 0.d0
St = 0.d0
!$OMP DO
do i=1,n
utloop(i) = .False.
do istate=1,N_st
ut(istate,i) = u_0(sort_idx(i,2),istate)
utloop(i) = utloop(i) .or. (dabs(u_0(sort_idx(i,2),istate)) > 1.d-20)
enddo
utloop(i) = .not.utloop(i)
enddo
!$OMP END DO
@ -459,7 +455,6 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
do i=shortcut(sh,2),shortcut(sh+1,2)-1
org_i = sort_idx(i,2)
do j=shortcut(sh,2),shortcut(sh+1,2)-1
if (utloop(j)) cycle
org_j = sort_idx(j,2)
ext = popcnt(xor(sorted(1,i,2), sorted(1,j,2)))
if (ext > 4) cycle
@ -482,12 +477,9 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
!$OMP DO
do i=1,n
utloop(i) = .False.
do istate=1,N_st
ut(istate,i) = u_0(sort_idx(i,1),istate)
utloop(i) = utloop(i) .or. (dabs(u_0(sort_idx(i,2),istate)) > 1.d-20)
enddo
utloop(i) = .not.utloop(i)
enddo
!$OMP END DO
@ -511,7 +503,6 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
enddo
do j=shortcut(sh2,1),shortcut(sh2+1,1)-1
if (utloop(j)) cycle
ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1)))
if (ext > 4) cycle
do ni=2,Nint
@ -549,7 +540,6 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
enddo
do j=shortcut(sh,1),i-1
if (utloop(j)) cycle
ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1)))
if (ext > 4) cycle
do ni=2,Nint
@ -576,7 +566,6 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
enddo
do j=i+1,shortcut(sh+1,1)-1
if (utloop(j)) cycle
ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1)))
if (ext > 4) cycle
do ni=2,Nint

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

@ -259,7 +259,8 @@ subroutine make_s2_eigenfunction
call occ_pattern_to_dets_size(psi_occ_pattern(1,1,1),s,elec_alpha_num,N_int)
allocate (d(N_int,2,s), det_buffer(N_int,2,bufsze) )
smax = s
ithread = omp_get_thread_num()
ithread=0
!$ ithread = omp_get_thread_num()
!$OMP DO
do i=1,N_occ_pattern
call occ_pattern_to_dets_size(psi_occ_pattern(1,1,i),s,elec_alpha_num,N_int)