LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-05 11:00:10 +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 logical :: fullMatch, ok
integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2) 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(:, :, :) integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
logical :: monoAdo, monoBdo; logical :: monoAdo, monoBdo;
@ -297,7 +297,7 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
monoBdo = .true. monoBdo = .true.
allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det)) 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 do k=1,N_int
hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1)) 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 else if(nt <= 2) then
prefullinteresting(0) += 1 prefullinteresting(0) += 1
prefullinteresting(prefullinteresting(0)) = i 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 if end if
end do end do
maskInd = -1 maskInd = -1
logical, allocatable :: banned(:,:,:) integer :: nb_count
logical, allocatable :: bannedOrb(:,:)
allocate(bannedOrb(mo_tot_num,2), banned(mo_tot_num,mo_tot_num,2))
do s1=1,2 do s1=1,2
do i1=N_holes(s1),1,-1 ! Generate low excitations first 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) do ii=1,prefullinteresting(0)
i = prefullinteresting(ii) i = prefullinteresting(ii)
nt = 0 nt = 0
mobMask(1,1) = iand(negMask(1,1), prefullinteresting_det(1,1,ii)) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i))
mobMask(1,2) = iand(negMask(1,2), prefullinteresting_det(1,2,ii)) mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
do j=2,N_int do j=2,N_int
mobMask(j,1) = iand(negMask(j,1), prefullinteresting_det(j,1,ii)) mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i))
mobMask(j,2) = iand(negMask(j,2), prefullinteresting_det(j,2,ii)) mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i))
nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
end do end do
if(nt <= 2) then if(nt <= 2) then
fullinteresting(0) += 1 fullinteresting(0) += 1
fullinteresting(fullinteresting(0)) = i fullinteresting(fullinteresting(0)) = i
fullminilist(1,1,fullinteresting(0)) = prefullinteresting_det(1,1,ii) fullminilist(1,1,fullinteresting(0)) = psi_det_sorted(1,1,i)
fullminilist(1,2,fullinteresting(0)) = prefullinteresting_det(1,2,ii) fullminilist(1,2,fullinteresting(0)) = psi_det_sorted(1,2,i)
do j=2,N_int do j=2,N_int
fullminilist(j,1,fullinteresting(0)) = prefullinteresting_det(j,1,ii) fullminilist(j,1,fullinteresting(0)) = psi_det_sorted(j,1,i)
fullminilist(j,2,fullinteresting(0)) = prefullinteresting_det(j,2,ii) fullminilist(j,2,fullinteresting(0)) = psi_det_sorted(j,2,i)
enddo enddo
end if end if
end do 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 if(s1 == s2) ib = i1+1
monoAdo = .true. monoAdo = .true.
do i2=N_holes(s2),ib,-1 ! Generate low excitations first 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 maskInd += 1
if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then
h2 = hole_list(i2,s2) 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 enddo
enddo enddo
deallocate(bannedOrb, banned, prefullinteresting_det, preinteresting_det)
deallocate(minilist, fullminilist)
deallocate(preinteresting, prefullinteresting, interesting, fullinteresting)
end 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(:,:) double precision, allocatable :: vt(:,:), ut(:,:), st(:,:)
integer :: i,j,k,l, jj,ii integer :: i,j,k,l, jj,ii
integer :: i0, j0 integer :: i0, j0
logical, allocatable :: utloop(:)
integer, allocatable :: shortcut(:,:), sort_idx(:,:) integer, allocatable :: shortcut(:,:), sort_idx(:,:)
integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) 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 PROVIDE ref_bitmask_energy
allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) 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 v_0 = 0.d0
s_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 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 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)) allocate(vt(N_st_8,n),st(N_st_8,n))
Vt = 0.d0 Vt = 0.d0
St = 0.d0 St = 0.d0
!$OMP DO !$OMP DO
do i=1,n do i=1,n
utloop(i) = .False.
do istate=1,N_st do istate=1,N_st
ut(istate,i) = u_0(sort_idx(i,2),istate) 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 enddo
utloop(i) = .not.utloop(i)
enddo enddo
!$OMP END DO !$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 do i=shortcut(sh,2),shortcut(sh+1,2)-1
org_i = sort_idx(i,2) org_i = sort_idx(i,2)
do j=shortcut(sh,2),shortcut(sh+1,2)-1 do j=shortcut(sh,2),shortcut(sh+1,2)-1
if (utloop(j)) cycle
org_j = sort_idx(j,2) org_j = sort_idx(j,2)
ext = popcnt(xor(sorted(1,i,2), sorted(1,j,2))) ext = popcnt(xor(sorted(1,i,2), sorted(1,j,2)))
if (ext > 4) cycle 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 !$OMP DO
do i=1,n do i=1,n
utloop(i) = .False.
do istate=1,N_st do istate=1,N_st
ut(istate,i) = u_0(sort_idx(i,1),istate) 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 enddo
utloop(i) = .not.utloop(i)
enddo enddo
!$OMP END DO !$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 enddo
do j=shortcut(sh2,1),shortcut(sh2+1,1)-1 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))) ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1)))
if (ext > 4) cycle if (ext > 4) cycle
do ni=2,Nint 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 enddo
do j=shortcut(sh,1),i-1 do j=shortcut(sh,1),i-1
if (utloop(j)) cycle
ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1))) ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1)))
if (ext > 4) cycle if (ext > 4) cycle
do ni=2,Nint 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 enddo
do j=i+1,shortcut(sh+1,1)-1 do j=i+1,shortcut(sh+1,1)-1
if (utloop(j)) cycle
ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1))) ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1)))
if (ext > 4) cycle if (ext > 4) cycle
do ni=2,Nint 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) 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) ) allocate (d(N_int,2,s), det_buffer(N_int,2,bufsze) )
smax = s smax = s
ithread = omp_get_thread_num() ithread=0
!$ ithread = omp_get_thread_num()
!$OMP DO !$OMP DO
do i=1,N_occ_pattern do i=1,N_occ_pattern
call occ_pattern_to_dets_size(psi_occ_pattern(1,1,i),s,elec_alpha_num,N_int) call occ_pattern_to_dets_size(psi_occ_pattern(1,1,i),s,elec_alpha_num,N_int)