diff --git a/src/Dets/utils.irp.f b/src/Dets/utils.irp.f index 0ead6090..0b89f339 100644 --- a/src/Dets/utils.irp.f +++ b/src/Dets/utils.irp.f @@ -14,36 +14,3 @@ BEGIN_PROVIDER [ double precision, H_matrix_all_dets,(N_det,N_det) ] enddo END_PROVIDER -subroutine remove_small_contributions - implicit none - BEGIN_DOC -! Remove determinants with small contributions - END_DOC - integer :: i,j,k, N_removed - logical keep - N_removed = 0 - do i=N_det,1,-1 - keep = .False. - do j=1,N_states - keep = keep .or. (dabs(psi_coef(i,j)) > selection_criterion_min) - enddo - if (.not.keep) then - do k=i+1,N_det - do j=1,N_int - psi_det(j,1,k-1) = psi_det(j,1,k) - psi_det(j,2,k-1) = psi_det(j,2,k) - enddo - enddo - do j=1,N_states - do k=i+1,N_det - psi_coef(k-1,j) = psi_coef(k,j) - enddo - enddo - N_removed += 1 - endif - enddo - if (N_removed > 0) then - N_det -= N_removed - call write_int(output_dets,N_removed, 'Removed determinants') - endif -end diff --git a/src/Perturbation/README.rst b/src/Perturbation/README.rst index 0407fc2c..1b0f8697 100644 --- a/src/Perturbation/README.rst +++ b/src/Perturbation/README.rst @@ -188,6 +188,9 @@ Documentation `fill_h_apply_buffer_selection `_ Fill the H_apply buffer with determiants for the selection +`remove_small_contributions `_ + Remove determinants with small contributions + `selection_criterion `_ Threshold to select determinants. Set by selection routines. diff --git a/src/Perturbation/selection.irp.f b/src/Perturbation/selection.irp.f index 60e8a1ee..14d452cb 100644 --- a/src/Perturbation/selection.irp.f +++ b/src/Perturbation/selection.irp.f @@ -77,3 +77,36 @@ end END_PROVIDER +subroutine remove_small_contributions + implicit none + BEGIN_DOC +! Remove determinants with small contributions + END_DOC + integer :: i,j,k, N_removed + logical keep + N_removed = 0 + do i=N_det,1,-1 + keep = .False. + do j=1,N_states + keep = keep .or. (dabs(psi_coef(i,j)) > selection_criterion_min) + enddo + if (.not.keep) then + do k=i+1,N_det + do j=1,N_int + psi_det(j,1,k-1) = psi_det(j,1,k) + psi_det(j,2,k-1) = psi_det(j,2,k) + enddo + enddo + do j=1,N_states + do k=i+1,N_det + psi_coef(k-1,j) = psi_coef(k,j) + enddo + enddo + N_removed += 1 + endif + enddo + if (N_removed > 0) then + N_det -= N_removed + call write_int(output_dets,N_removed, 'Removed determinants') + endif +end