diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 2364c2e4..ff32d56b 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -93,19 +93,7 @@ subroutine select_connected(i_generator,E0,pt2,b) particle_mask(k,1) = iand(generators_bitmask(k,1,s_part,l), not(psi_det_generators(k,1,i_generator)) ) particle_mask(k,2) = iand(generators_bitmask(k,2,s_part,l), not(psi_det_generators(k,2,i_generator)) ) -! hole_mask(k,1) = ior(generators_bitmask(k,1,s_hole,l), generators_bitmask(k,1,s_part,l)) -! hole_mask(k,2) = ior(generators_bitmask(k,2,s_hole,l), generators_bitmask(k,2,s_part,l)) -! particle_mask(k,1) = hole_mask(k,1) -! particle_mask(k,2) = hole_mask(k,2) enddo - print *, 'det' - call debug_det(psi_det_generators(1,1,i_generator),N_int) - print *, 'hole' - call debug_det(hole_mask,N_int) - print *, 'particle_mask' - call debug_det(particle_mask,N_int) - print *, '' - pause call select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b) call select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b) enddo diff --git a/plugins/Full_CI_ZMQ/selection_double.irp.f b/plugins/Full_CI_ZMQ/selection_double.irp.f index d31f9a6a..83418307 100644 --- a/plugins/Full_CI_ZMQ/selection_double.irp.f +++ b/plugins/Full_CI_ZMQ/selection_double.irp.f @@ -4,15 +4,15 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p use selection_types implicit none - integer, intent(in) :: i_generator - integer(bit_kind), intent(in) :: hole_mask(N_int,2), particle_mask(N_int,2) - double precision, intent(in) :: fock_diag_tmp(mo_tot_num) - double precision, intent(in) :: E0(N_states) + integer, intent(in) :: i_generator + integer(bit_kind), intent(in) :: hole_mask(N_int,2), particle_mask(N_int,2) + double precision, intent(in) :: fock_diag_tmp(mo_tot_num) + double precision, intent(in) :: E0(N_states) double precision, intent(inout) :: pt2(N_states) type(selection_buffer), intent(inout) :: buf double precision :: mat(N_states, mo_tot_num, mo_tot_num) - integer :: h1,h2,s1,s2,i1,i2,ib,sp,k + integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2) logical :: fullMatch, ok @@ -30,40 +30,48 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p call bitstring_to_list_ab(hole , hole_list , N_holes , N_int) call bitstring_to_list_ab(particle, particle_list, N_particles, N_int) + !call assert(psi_det_generators(1,1,i_generator) == psi_det_sorted(1,1,i_generator), "sorted selex") do s1=1,2 - do s2=s1,2 - sp = s1 - if(s1 /= s2) sp = 3 - do i1=N_holes(s1),1,-1 ! Generate low excitations first - ib = 1 - if(s1 == s2) ib = i1+1 - do i2=N_holes(s2),ib,-1 ! Generate low excitations first - h1 = hole_list(i1,s1) - h2 = hole_list(i2,s2) - call apply_holes(psi_det_generators(1,1,i_generator), s1,h1,s2,h2, mask, ok, N_int) - !call assert(ok, irp_here) - - logical :: banned(mo_tot_num, mo_tot_num,2) - logical :: bannedOrb(mo_tot_num, 2) - - banned = .false. - bannedOrb = .false. - bannedOrb(h1, s1) = .true. - bannedOrb(h2, s2) = .true. - - call spot_isinwf(mask, psi_det_sorted, i_generator, N_det, banned, fullMatch) - if(fullMatch) cycle - if(sp /= 2) call spot_occupied(mask(1,1), bannedOrb(1,1)) - if(sp /= 1) call spot_occupied(mask(1,2), bannedOrb(1,2)) - - mat = 0d0 - call splash_pq(mask, sp, psi_det_sorted, i_generator, N_det_selectors, bannedOrb, banned, mat) - call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf) - end do - end do - end do - end do + do s2=s1,2 + sp = s1 + if(s1 /= s2) sp = 3 + do i1=N_holes(s1),1,-1 ! Generate low excitations first + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=N_holes(s2),ib,-1 ! Generate low excitations first + h1 = hole_list(i1,s1) + h2 = hole_list(i2,s2) + call apply_holes(psi_det_generators(1,1,i_generator), s1,h1,s2,h2, mask, ok, N_int) + !call assert(ok, irp_here) + + logical :: banned(mo_tot_num, mo_tot_num,2) + logical :: bannedOrb(mo_tot_num, 2) + + banned = .false. + bannedOrb(h1, s1) = .true. + bannedOrb(h2, s2) = .true. + + bannedOrb(1:mo_tot_num, 1:2) = .true. + do s3=1,2 + do i=1,N_particles(s3) + bannedOrb(particle_list(i,s3), s3) = .false. + enddo + enddo + + + call spot_isinwf(mask, psi_det_sorted, i_generator, N_det, banned, fullMatch) + if(fullMatch) cycle + if(sp /= 2) call spot_occupied(mask(1,1), bannedOrb(1,1)) + if(sp /= 1) call spot_occupied(mask(1,2), bannedOrb(1,2)) + + mat = 0d0 + call splash_pq(mask, sp, psi_det_sorted, i_generator, N_det_selectors, bannedOrb, banned, mat) + call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf) + enddo + enddo + enddo + enddo end subroutine diff --git a/plugins/Full_CI_ZMQ/selection_single.irp.f b/plugins/Full_CI_ZMQ/selection_single.irp.f index a49ae879..77d985af 100644 --- a/plugins/Full_CI_ZMQ/selection_single.irp.f +++ b/plugins/Full_CI_ZMQ/selection_single.irp.f @@ -16,7 +16,7 @@ subroutine select_singles(i_gen,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf double precision :: vect(N_states, mo_tot_num) logical :: bannedOrb(mo_tot_num) - integer :: i, k + integer :: i, j, k integer :: h1,h2,s1,s2,i1,i2,ib,sp integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2) logical :: fullMatch, ok @@ -44,8 +44,10 @@ subroutine select_singles(i_gen,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf h1 = hole_list(i,sp) call apply_hole(psi_det_generators(1,1,i_gen), sp, h1, mask, ok, N_int) !call assert(ok, irp_here) - bannedOrb = .false. - bannedOrb(h1) = .true. + bannedOrb = .true. + do j=1,N_particles(sp) + bannedOrb(particle_list(j, sp)) = .false. + end do call spot_hasBeen(mask, sp, psi_det_sorted, i_gen, N_det, bannedOrb, fullMatch) if(fullMatch) cycle call spot_occupied(mask(1,sp), bannedOrb) diff --git a/plugins/Selectors_full/selectors.irp.f b/plugins/Selectors_full/selectors.irp.f index 6fbad9ec..62f0aeaa 100644 --- a/plugins/Selectors_full/selectors.irp.f +++ b/plugins/Selectors_full/selectors.irp.f @@ -6,25 +6,27 @@ BEGIN_PROVIDER [ integer, psi_selectors_size ] END_PROVIDER BEGIN_PROVIDER [ integer, N_det_selectors] - implicit none - BEGIN_DOC - ! For Single reference wave functions, the number of selectors is 1 : the - ! Hartree-Fock determinant - END_DOC - integer :: i - double precision :: norm - call write_time(output_determinants) - norm = 0.d0 - N_det_selectors = N_det - do i=1,N_det - norm = norm + psi_average_norm_contrib_sorted(i) - if (norm > threshold_selectors) then - N_det_selectors = i-1 - exit - endif - enddo - N_det_selectors = max(N_det_selectors,1) - call write_int(output_determinants,N_det_selectors,'Number of selectors') + implicit none + BEGIN_DOC + ! For Single reference wave functions, the number of selectors is 1 : the + ! Hartree-Fock determinant + END_DOC + integer :: i + double precision :: norm, norm_max + call write_time(output_determinants) + N_det_selectors = N_det + if (threshold_generators < 1.d0) then + norm = 0.d0 + do i=1,N_det + norm = norm + psi_average_norm_contrib_sorted(i) + if (norm > threshold_selectors) then + N_det_selectors = i-1 + exit + endif + enddo + N_det_selectors = max(N_det_selectors,1) + endif + call write_int(output_determinants,N_det_selectors,'Number of selectors') END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), psi_selectors, (N_int,2,psi_selectors_size) ] diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 3850ab40..39b0f58e 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -306,6 +306,10 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib, (psi_det_size) ] psi_coef(i,k)*psi_coef(i,k)*f enddo enddo + f = 1.d0/sum(psi_average_norm_contrib(1:N_det)) + do i=1,N_det + psi_average_norm_contrib(i) = psi_average_norm_contrib(i)*f + enddo END_PROVIDER