diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 89667fec..f27a42df 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -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 diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index d9481886..026921d0 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -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 diff --git a/src/Determinants/occ_pattern.irp.f b/src/Determinants/occ_pattern.irp.f index 707be0f2..1ff8cb73 100644 --- a/src/Determinants/occ_pattern.irp.f +++ b/src/Determinants/occ_pattern.irp.f @@ -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)