From 315ad54dc782d009d50cb0764bf621f79ef47a98 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Mon, 24 Feb 2020 13:28:29 -0600 Subject: [PATCH] separated providers for sorted wfn separate psi_coef_sorted and psi_coef_sorted_bit from linked providers reuse same det_sorted and order for complex --- src/determinants/determinants.irp.f | 75 ++++++++++--- src/determinants/determinants_complex.irp.f | 111 +++++++++++--------- src/determinants/prune_wf.irp.f | 4 - 3 files changed, 117 insertions(+), 73 deletions(-) diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index deb00e39..a159b48e 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -280,7 +280,6 @@ END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_sorted, (psi_det_size,N_states) ] &BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted, (psi_det_size) ] &BEGIN_PROVIDER [ integer, psi_det_sorted_order, (psi_det_size) ] implicit none @@ -302,9 +301,6 @@ END_PROVIDER psi_det_sorted(j,1,i) = psi_det(j,1,iorder(i)) psi_det_sorted(j,2,i) = psi_det(j,2,iorder(i)) enddo - do k=1,N_states - psi_coef_sorted(i,k) = psi_coef(iorder(i),k) - enddo psi_average_norm_contrib_sorted(i) = -psi_average_norm_contrib_sorted(i) enddo do i=1,N_det @@ -312,29 +308,74 @@ END_PROVIDER enddo psi_det_sorted(:,:,N_det+1:psi_det_size) = 0_bit_kind - psi_coef_sorted(N_det+1:psi_det_size,:) = 0.d0 psi_average_norm_contrib_sorted(N_det+1:psi_det_size) = 0.d0 psi_det_sorted_order(N_det+1:psi_det_size) = 0 deallocate(iorder) +END_PROVIDER +BEGIN_PROVIDER [ double precision, psi_coef_sorted, (psi_det_size,N_states) ] + implicit none + integer :: i,j,k + do i=1,N_det + j=psi_det_sorted_order(i) + do k=1,N_states + psi_coef_sorted(j,k) = psi_coef(i,k) + enddo + enddo + psi_coef_sorted(N_det+1:psi_det_size,:) = 0.d0 END_PROVIDER BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ] - implicit none - BEGIN_DOC - ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. - ! They are sorted by determinants interpreted as integers. Useful - ! to accelerate the search of a random determinant in the wave - ! function. - END_DOC +&BEGIN_PROVIDER [ integer, psi_det_sorted_bit_order, (psi_det_size) ] + implicit none + integer :: i,j + integer*8, allocatable :: bit_tmp(:) + integer*8, external :: det_search_key - call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), & - psi_det_sorted_bit, psi_coef_sorted_bit, N_states) + allocate(bit_tmp(N_det)) + do i=1,N_det + psi_det_sorted_bit_order(i) = i + !$DIR FORCEINLINE + bit_tmp(i) = det_search_key(psi_det(1,1,i),N_int) + enddo + call i8sort(bit_tmp,psi_det_sorted_bit_order,N_det) + do i=1,N_det + do j=1,N_int + psi_det_sorted_bit(j,1,i) = psi_det(j,1,psi_det_sorted_bit_order(i)) + psi_det_sorted_bit(j,2,i) = psi_det(j,2,psi_det_sorted_bit_order(i)) + enddo + enddo + deallocate(bit_tmp) END_PROVIDER +BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ] + implicit none + integer :: i,k + do i=1,N_det + do k=1,N_states + psi_coef_sorted_bit(i,k) = psi_coef(psi_det_sorted_bit_order(i),k) + enddo + enddo +END_PROVIDER + + +! BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ] +!&BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ] +! implicit none +! BEGIN_DOC +! ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. +! ! They are sorted by determinants interpreted as integers. Useful +! ! to accelerate the search of a random determinant in the wave +! ! function. +! END_DOC +! +! call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), & +! psi_det_sorted_bit, psi_coef_sorted_bit, N_states) +! +!END_PROVIDER + subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st) use bitmasks implicit none @@ -490,7 +531,7 @@ subroutine save_wavefunction_truncated(thr) if (mpi_master) then if (is_complex) then call save_wavefunction_general_complex(N_det_save,min(N_states,N_det_save),& - psi_det_sorted_complex,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) else call save_wavefunction_general(N_det_save,min(N_states,N_det_save),psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) endif @@ -513,7 +554,7 @@ subroutine save_wavefunction if (mpi_master) then if (is_complex) then call save_wavefunction_general_complex(N_det,N_states,& - psi_det_sorted_complex,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) + psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex) else call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) endif diff --git a/src/determinants/determinants_complex.irp.f b/src/determinants/determinants_complex.irp.f index 38e4126a..b7b13eff 100644 --- a/src/determinants/determinants_complex.irp.f +++ b/src/determinants/determinants_complex.irp.f @@ -70,62 +70,69 @@ END_PROVIDER ! ! !==============================================================================! -!TODO: implement for complex (new psi_det_sorted? reuse? combine complex provider with real?) - BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_complex, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] -&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_complex, (psi_det_size) ] -&BEGIN_PROVIDER [ integer, psi_det_sorted_order_complex, (psi_det_size) ] - implicit none - BEGIN_DOC - ! Wave function sorted by determinants contribution to the norm (state-averaged) - ! - ! psi_det_sorted_order(i) -> k : index in psi_det - END_DOC - integer :: i,j,k - integer, allocatable :: iorder(:) - allocate ( iorder(N_det) ) - do i=1,N_det - psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib(i) - iorder(i) = i - enddo - call dsort(psi_average_norm_contrib_sorted_complex,iorder,N_det) - do i=1,N_det - do j=1,N_int - psi_det_sorted_complex(j,1,i) = psi_det(j,1,iorder(i)) - psi_det_sorted_complex(j,2,i) = psi_det(j,2,iorder(i)) - enddo - do k=1,N_states - psi_coef_sorted_complex(i,k) = psi_coef_complex(iorder(i),k) - enddo - psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib_sorted_complex(i) - enddo - do i=1,N_det - psi_det_sorted_order_complex(iorder(i)) = i - enddo - - psi_det_sorted_complex(:,:,N_det+1:psi_det_size) = 0_bit_kind - psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) - psi_average_norm_contrib_sorted_complex(N_det+1:psi_det_size) = 0.d0 - psi_det_sorted_order_complex(N_det+1:psi_det_size) = 0 - - deallocate(iorder) - +BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] + implicit none + integer :: i,j,k + do i=1,N_det + j=psi_det_sorted_order(i) + do k=1,N_states + psi_coef_sorted_complex(j,k) = psi_coef_complex(i,k) + enddo + enddo + psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) END_PROVIDER - BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit_complex, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_bit_complex, (psi_det_size,N_states) ] - implicit none - BEGIN_DOC - ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation. - ! They are sorted by determinants interpreted as integers. Useful - ! to accelerate the search of a random determinant in the wave - ! function. - END_DOC +!!TODO: implement for complex (new psi_det_sorted? reuse? combine complex provider with real?) +! BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_complex, (N_int,2,psi_det_size) ] +!&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ] +!&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_complex, (psi_det_size) ] +!&BEGIN_PROVIDER [ integer, psi_det_sorted_order_complex, (psi_det_size) ] +! implicit none +! BEGIN_DOC +! ! Wave function sorted by determinants contribution to the norm (state-averaged) +! ! +! ! psi_det_sorted_order(i) -> k : index in psi_det +! END_DOC +! integer :: i,j,k +! integer, allocatable :: iorder(:) +! allocate ( iorder(N_det) ) +! do i=1,N_det +! psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib(i) +! iorder(i) = i +! enddo +! call dsort(psi_average_norm_contrib_sorted_complex,iorder,N_det) +! do i=1,N_det +! do j=1,N_int +! psi_det_sorted_complex(j,1,i) = psi_det(j,1,iorder(i)) +! psi_det_sorted_complex(j,2,i) = psi_det(j,2,iorder(i)) +! enddo +! do k=1,N_states +! psi_coef_sorted_complex(i,k) = psi_coef_complex(iorder(i),k) +! enddo +! psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib_sorted_complex(i) +! enddo +! do i=1,N_det +! psi_det_sorted_order_complex(iorder(i)) = i +! enddo +! +! psi_det_sorted_complex(:,:,N_det+1:psi_det_size) = 0_bit_kind +! psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0) +! psi_average_norm_contrib_sorted_complex(N_det+1:psi_det_size) = 0.d0 +! psi_det_sorted_order_complex(N_det+1:psi_det_size) = 0 +! +! deallocate(iorder) +! +!END_PROVIDER - call sort_dets_by_det_search_key_complex(N_det, psi_det, psi_coef_complex, & - size(psi_coef_complex,1), psi_det_sorted_bit_complex, & - psi_coef_sorted_bit_complex, N_states) +BEGIN_PROVIDER [ complex*16, psi_coef_sorted_bit_complex, (psi_det_size,N_states) ] + implicit none + integer :: i,k + do i=1,N_det + do k=1,N_states + psi_coef_sorted_bit_complex(i,k) = psi_coef_complex(psi_det_sorted_bit_order(i),k) + enddo + enddo END_PROVIDER subroutine sort_dets_by_det_search_key_complex(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st) diff --git a/src/determinants/prune_wf.irp.f b/src/determinants/prune_wf.irp.f index 136d4ec1..c3cd8d12 100644 --- a/src/determinants/prune_wf.irp.f +++ b/src/determinants/prune_wf.irp.f @@ -25,11 +25,7 @@ BEGIN_PROVIDER [ logical, pruned, (N_det) ] else ndet_new = max(1,int( dble(N_det) * (1.d0 - pruning) + 0.5d0 )) - if (is_complex) then - thr = psi_average_norm_contrib_sorted_complex(ndet_new) - else thr = psi_average_norm_contrib_sorted(ndet_new) - endif do i=1, N_det pruned(i) = psi_average_norm_contrib(i) < thr enddo