From 38c10bd3906d270ed8dd6213cabfc227e8e1612a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 11 Apr 2015 13:13:44 +0200 Subject: [PATCH 1/5] psi_svd_matrix built in parallel --- src/Dets/determinants.irp.f | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/src/Dets/determinants.irp.f b/src/Dets/determinants.irp.f index 00e683fc..9267ee0f 100644 --- a/src/Dets/determinants.irp.f +++ b/src/Dets/determinants.irp.f @@ -718,7 +718,12 @@ BEGIN_PROVIDER [ double precision, psi_svd_matrix, (N_det_alpha_unique,N_det_bet integer, external :: get_index_in_psi_det_sorted_bit logical, external :: is_in_wavefunction + + PROVIDE psi_coef_sorted_bit + psi_svd_matrix = 0.d0 + !$OMP PARALLEL DO DEFAULT(SHARED) & + !$OMP PRIVATE(i,j,k,tmp_det,idx) do j=1,N_det_beta_unique do k=1,N_int tmp_det(k,2) = psi_det_beta_unique(k,j) @@ -735,6 +740,7 @@ BEGIN_PROVIDER [ double precision, psi_svd_matrix, (N_det_alpha_unique,N_det_bet endif enddo enddo + !$OMP END PARALLEL DO END_PROVIDER @@ -799,12 +805,19 @@ subroutine generate_all_alpha_beta_det_products ! Create a wave function from all possible alpha x beta determinants END_DOC integer :: i,j,k,l - integer :: idx + integer :: idx, iproc integer, external :: get_index_in_psi_det_sorted_bit - integer(bit_kind), allocatable :: tmp_det(:,:,:) + integer(bit_kind), allocatable :: tmp_det(:,:,:) logical, external :: is_in_wavefunction + integer, external :: omp_get_thread_num + !$OMP PARALLEL DEFAULT(NONE) SHARED(psi_coef_sorted_bit,N_det_beta_unique,& + !$OMP N_det_alpha_unique, N_int, psi_det_alpha_unique, psi_det_beta_unique,& + !$OMP N_det) & + !$OMP PRIVATE(i,j,k,l,tmp_det,idx,iproc) + !$ iproc = omp_get_thread_num() allocate (tmp_det(N_int,2,N_det_alpha_unique)) + !$OMP DO do j=1,N_det_beta_unique l = 1 do i=1,N_det_alpha_unique @@ -816,8 +829,11 @@ subroutine generate_all_alpha_beta_det_products l = l+1 endif enddo - call fill_H_apply_buffer_no_selection(l-1, tmp_det, N_int, 1) + call fill_H_apply_buffer_no_selection(l-1, tmp_det, N_int, iproc) enddo + !$OMP END DO NOWAIT + deallocate(tmp_det) + !$OMP END PARALLEL deallocate (tmp_det) call copy_H_apply_buffer_to_wf SOFT_TOUCH psi_det psi_coef N_det From 2b4f760e34e4609412d469093bb5feff79270af2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 14 Apr 2015 02:00:58 +0200 Subject: [PATCH 2/5] Accelerated spindeterminants --- src/Dets/README.rst | 134 ++++--- src/Dets/connected_to_ref.irp.f | 67 +--- src/Dets/determinants.irp.f | 313 --------------- src/Dets/spindeterminants.ezfio_config | 5 +- src/Dets/spindeterminants.irp.f | 528 ++++++++++++++++++++++++- src/FCIdump/README.rst | 3 - src/Makefile.config.ifort | 30 -- 7 files changed, 603 insertions(+), 477 deletions(-) delete mode 100644 src/Makefile.config.ifort diff --git a/src/Dets/README.rst b/src/Dets/README.rst index f03df8da..e9077510 100644 --- a/src/Dets/README.rst +++ b/src/Dets/README.rst @@ -90,10 +90,6 @@ Documentation `connected_to_ref_by_mono `_ Undocumented -`det_is_not_or_may_be_in_ref `_ - If true, det is not in ref - If false, det may be in ref - `det_search_key `_ Return an integer*8 corresponding to a determinant index for searching @@ -103,9 +99,6 @@ Documentation `is_in_wavefunction `_ True if the determinant ``det`` is in the wave function -`key_pattern_not_in_ref `_ - Min and max values of the integers of the keys of the reference - `occ_pattern_search_key `_ Return an integer*8 corresponding to a determinant index for searching @@ -200,16 +193,10 @@ Documentation `det_svd `_ Computes the SVD of the Alpha x Beta determinant coefficient matrix -`create_wf_of_psi_svd_matrix `_ - Matrix of wf coefficients. Outer product of alpha and beta determinants - -`filter_3_highest_electrons `_ +`filter_3_highest_electrons `_ Returns a determinant with only the 3 highest electrons -`generate_all_alpha_beta_det_products `_ - Create a wave function from all possible alpha x beta determinants - -`int_of_3_highest_electrons `_ +`int_of_3_highest_electrons `_ Returns an integer*8 as : .br |_<--- 21 bits ---><--- 21 bits ---><--- 21 bits --->| @@ -226,32 +213,26 @@ Documentation `n_det `_ Number of determinants in the wave function -`n_det_alpha_unique `_ - Unique alpha determinants - -`n_det_beta_unique `_ - Unique beta determinants - `psi_average_norm_contrib `_ Contribution of determinants to the state-averaged density -`psi_average_norm_contrib_sorted `_ +`psi_average_norm_contrib_sorted `_ Wave function sorted by determinants contribution to the norm (state-averaged) `psi_coef `_ The wave function coefficients. Initialized with Hartree-Fock if the EZFIO file is empty -`psi_coef_sorted `_ +`psi_coef_sorted `_ Wave function sorted by determinants contribution to the norm (state-averaged) -`psi_coef_sorted_ab `_ +`psi_coef_sorted_ab `_ Determinants on which we apply . They are sorted by the 3 highest electrons in the alpha part, then by the 3 highest electrons in the beta part to accelerate the research of connected determinants. -`psi_coef_sorted_bit `_ +`psi_coef_sorted_bit `_ Determinants on which we apply for perturbation. They are sorted by determinants interpreted as integers. Useful to accelerate the search of a random determinant in the wave @@ -261,80 +242,53 @@ Documentation The wave function determinants. Initialized with Hartree-Fock if the EZFIO file is empty -`psi_det_alpha `_ - List of alpha determinants of psi_det - -`psi_det_alpha_unique `_ - Unique alpha determinants - -`psi_det_beta `_ - List of beta determinants of psi_det - -`psi_det_beta_unique `_ - Unique beta determinants - `psi_det_size `_ Size of the psi_det/psi_coef arrays -`psi_det_sorted `_ +`psi_det_sorted `_ Wave function sorted by determinants contribution to the norm (state-averaged) -`psi_det_sorted_ab `_ +`psi_det_sorted_ab `_ Determinants on which we apply . They are sorted by the 3 highest electrons in the alpha part, then by the 3 highest electrons in the beta part to accelerate the research of connected determinants. -`psi_det_sorted_bit `_ +`psi_det_sorted_bit `_ Determinants on which we apply for perturbation. They are sorted by determinants interpreted as integers. Useful to accelerate the search of a random determinant in the wave function. -`psi_det_sorted_next_ab `_ +`psi_det_sorted_next_ab `_ Determinants on which we apply . They are sorted by the 3 highest electrons in the alpha part, then by the 3 highest electrons in the beta part to accelerate the research of connected determinants. -`psi_svd_alpha `_ - SVD wave function - -`psi_svd_beta `_ - SVD wave function - -`psi_svd_coefs `_ - SVD wave function - -`psi_svd_matrix `_ - Matrix of wf coefficients. Outer product of alpha and beta determinants - -`read_dets `_ +`read_dets `_ Reads the determinants from the EZFIO file -`save_wavefunction `_ +`save_wavefunction `_ Save the wave function into the EZFIO file -`save_wavefunction_general `_ +`save_wavefunction_general `_ Save the wave function into the EZFIO file -`save_wavefunction_unsorted `_ +`save_wavefunction_unsorted `_ Save the wave function into the EZFIO file -`sort_dets_by_3_highest_electrons `_ +`sort_dets_by_3_highest_electrons `_ Determinants on which we apply . They are sorted by the 3 highest electrons in the alpha part, then by the 3 highest electrons in the beta part to accelerate the research of connected determinants. -`sort_dets_by_det_search_key `_ +`sort_dets_by_det_search_key `_ Determinants are sorted are sorted according to their det_search_key. Useful to accelerate the search of a random determinant in the wave function. -`spin_det_search_key `_ - Return an integer*8 corresponding to a determinant index for searching - `double_exc_bitmask `_ double_exc_bitmask(:,1,i) is the bitmask for holes of excitation 1 double_exc_bitmask(:,2,i) is the bitmask for particles of excitation 1 @@ -675,7 +629,61 @@ Documentation `n_con_int `_ Number of integers to represent the connections between determinants -`write_spindeterminants `_ +`create_wf_of_psi_svd_matrix `_ + Matrix of wf coefficients. Outer product of alpha and beta determinants + +`generate_all_alpha_beta_det_products `_ + Create a wave function from all possible alpha x beta determinants + +`get_index_in_psi_det_alpha_unique `_ + Returns the index of the determinant in the ``psi_det_alpha_unique`` array + +`get_index_in_psi_det_beta_unique `_ + Returns the index of the determinant in the ``psi_det_beta_unique`` array + +`n_det_alpha_unique `_ + Unique alpha determinants + +`n_det_beta_unique `_ + Unique beta determinants + +`psi_det_alpha `_ + List of alpha determinants of psi_det + +`psi_det_alpha_unique `_ + Unique alpha determinants + +`psi_det_beta `_ + List of beta determinants of psi_det + +`psi_det_beta_unique `_ + Unique beta determinants + +`psi_svd_alpha `_ + SVD wave function + +`psi_svd_beta `_ + SVD wave function + +`psi_svd_coefs `_ + SVD wave function + +`psi_svd_matrix `_ + Matrix of wf coefficients. Outer product of alpha and beta determinants + +`psi_svd_matrix_columns `_ + Matrix of wf coefficients. Outer product of alpha and beta determinants + +`psi_svd_matrix_rows `_ + Matrix of wf coefficients. Outer product of alpha and beta determinants + +`psi_svd_matrix_values `_ + Matrix of wf coefficients. Outer product of alpha and beta determinants + +`spin_det_search_key `_ + Return an integer*8 corresponding to a determinant index for searching + +`write_spindeterminants `_ Undocumented `cisd `_ diff --git a/src/Dets/connected_to_ref.irp.f b/src/Dets/connected_to_ref.irp.f index 3c7eb581..2d40b621 100644 --- a/src/Dets/connected_to_ref.irp.f +++ b/src/Dets/connected_to_ref.irp.f @@ -162,7 +162,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet) integer :: N_past integer :: i, l integer :: degree_x2 - logical :: det_is_not_or_may_be_in_ref, t + logical :: t double precision :: hij_elec ! output : 0 : not connected @@ -260,7 +260,7 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet) integer :: N_past integer :: i, l integer :: degree_x2 - logical :: det_is_not_or_may_be_in_ref, t + logical :: t double precision :: hij_elec ! output : 0 : not connected @@ -355,66 +355,3 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet) end - -logical function det_is_not_or_may_be_in_ref(key,Nint) - use bitmasks - implicit none - BEGIN_DOC - ! If true, det is not in ref - ! If false, det may be in ref - END_DOC - integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: key(Nint,2) - integer(bit_kind) :: key_int - integer*1 :: key_short(bit_kind) - !DIR$ ATTRIBUTES ALIGN : 32 :: key_short - equivalence (key_int,key_short) - - integer :: i, ispin, k - - det_is_not_or_may_be_in_ref = .False. - do ispin=1,2 - do i=1,Nint - key_int = key(i,ispin) - do k=1,bit_kind - det_is_not_or_may_be_in_ref = & - det_is_not_or_may_be_in_ref .or. & - key_pattern_not_in_ref(key_short(k), i, ispin) - enddo - if(det_is_not_or_may_be_in_ref) then - return - endif - enddo - enddo - -end - - -BEGIN_PROVIDER [ logical, key_pattern_not_in_ref, (-128:127,N_int,2) ] - use bitmasks - implicit none - BEGIN_DOC - ! Min and max values of the integers of the keys of the reference - END_DOC - - integer :: i, j, ispin - integer(bit_kind) :: key - integer*1 :: key_short(bit_kind) - equivalence (key,key_short) - integer :: idx, k - - key_pattern_not_in_ref = .True. - - do j=1,N_det - do ispin=1,2 - do i=1,N_int - key = psi_det(i,ispin,j) - do k=1,bit_kind - key_pattern_not_in_ref( key_short(k), i, ispin ) = .False. - enddo - enddo - enddo - enddo - -END_PROVIDER - diff --git a/src/Dets/determinants.irp.f b/src/Dets/determinants.irp.f index 9267ee0f..104b868e 100644 --- a/src/Dets/determinants.irp.f +++ b/src/Dets/determinants.irp.f @@ -294,132 +294,6 @@ END_PROVIDER -!==============================================================================! -! ! -! Independent alpha/beta parts ! -! ! -!==============================================================================! - -integer*8 function spin_det_search_key(det,Nint) - use bitmasks - implicit none - BEGIN_DOC -! Return an integer*8 corresponding to a determinant index for searching - END_DOC - integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: det(Nint) - integer :: i - spin_det_search_key = det(1) - do i=2,Nint - spin_det_search_key = ieor(spin_det_search_key,det(i)) - enddo -end - - -BEGIN_PROVIDER [ integer(bit_kind), psi_det_alpha, (N_int,psi_det_size) ] - implicit none - BEGIN_DOC -! List of alpha determinants of psi_det - END_DOC - integer :: i,k - - do i=1,N_det - do k=1,N_int - psi_det_alpha(k,i) = psi_det(k,1,i) - enddo - enddo -END_PROVIDER - -BEGIN_PROVIDER [ integer(bit_kind), psi_det_beta, (N_int,psi_det_size) ] - implicit none - BEGIN_DOC -! List of beta determinants of psi_det - END_DOC - integer :: i,k - - do i=1,N_det - do k=1,N_int - psi_det_beta(k,i) = psi_det(k,2,i) - enddo - enddo -END_PROVIDER - - BEGIN_PROVIDER [ integer(bit_kind), psi_det_alpha_unique, (N_int,psi_det_size) ] -&BEGIN_PROVIDER [ integer, N_det_alpha_unique ] - implicit none - BEGIN_DOC - ! Unique alpha determinants - END_DOC - - integer :: i,k - integer, allocatable :: iorder(:) - integer*8, allocatable :: bit_tmp(:) - integer*8 :: last_key - integer*8, external :: spin_det_search_key - - allocate ( iorder(N_det), bit_tmp(N_det)) - - do i=1,N_det - iorder(i) = i - bit_tmp(i) = spin_det_search_key(psi_det_alpha(1,i),N_int) - enddo - - call i8sort(bit_tmp,iorder,N_det) - - N_det_alpha_unique = 0 - last_key = 0_8 - do i=1,N_det - if (bit_tmp(i) /= last_key) then - last_key = bit_tmp(i) - N_det_alpha_unique += 1 - do k=1,N_int - psi_det_alpha_unique(k,N_det_alpha_unique) = psi_det_alpha(k,iorder(i)) - enddo - endif - enddo - - deallocate (iorder, bit_tmp) -END_PROVIDER - - BEGIN_PROVIDER [ integer(bit_kind), psi_det_beta_unique, (N_int,psi_det_size) ] -&BEGIN_PROVIDER [ integer, N_det_beta_unique ] - implicit none - BEGIN_DOC - ! Unique beta determinants - END_DOC - - integer :: i,k - integer, allocatable :: iorder(:) - integer*8, allocatable :: bit_tmp(:) - integer*8 :: last_key - integer*8, external :: spin_det_search_key - - allocate ( iorder(N_det), bit_tmp(N_det)) - - do i=1,N_det - iorder(i) = i - bit_tmp(i) = spin_det_search_key(psi_det_beta(1,i),N_int) - enddo - - call i8sort(bit_tmp,iorder,N_det) - - N_det_beta_unique = 0 - last_key = 0_8 - do i=1,N_det - if (bit_tmp(i) /= last_key) then - last_key = bit_tmp(i) - N_det_beta_unique += 1 - do k=1,N_int - psi_det_beta_unique(k,N_det_beta_unique) = psi_det_beta(k,iorder(i)) - enddo - endif - enddo - - deallocate (iorder, bit_tmp) -END_PROVIDER - - - !==============================================================================! ! ! ! Sorting providers ! @@ -700,193 +574,6 @@ subroutine sort_dets_by_3_highest_electrons(det_in,coef_in,det_out,coef_out, & end -!==============================================================================! -! ! -! Alpha x Beta Matrix ! -! ! -!==============================================================================! - -BEGIN_PROVIDER [ double precision, psi_svd_matrix, (N_det_alpha_unique,N_det_beta_unique,N_states) ] - use bitmasks - implicit none - BEGIN_DOC -! Matrix of wf coefficients. Outer product of alpha and beta determinants - END_DOC - integer :: i,j,k - integer(bit_kind) :: tmp_det(N_int,2) - integer :: idx - integer, external :: get_index_in_psi_det_sorted_bit - logical, external :: is_in_wavefunction - - - PROVIDE psi_coef_sorted_bit - - psi_svd_matrix = 0.d0 - !$OMP PARALLEL DO DEFAULT(SHARED) & - !$OMP PRIVATE(i,j,k,tmp_det,idx) - do j=1,N_det_beta_unique - do k=1,N_int - tmp_det(k,2) = psi_det_beta_unique(k,j) - enddo - do i=1,N_det_alpha_unique - do k=1,N_int - tmp_det(k,1) = psi_det_alpha_unique(k,i) - enddo - idx = get_index_in_psi_det_sorted_bit(tmp_det,N_int) - if (idx > 0) then - do k=1,N_states - psi_svd_matrix(i,j,k) = psi_coef_sorted_bit(idx,k) - enddo - endif - enddo - enddo - !$OMP END PARALLEL DO - -END_PROVIDER - -subroutine create_wf_of_psi_svd_matrix - use bitmasks - implicit none - BEGIN_DOC -! Matrix of wf coefficients. Outer product of alpha and beta determinants - END_DOC - integer :: i,j,k - integer(bit_kind) :: tmp_det(N_int,2) - integer :: idx - integer, external :: get_index_in_psi_det_sorted_bit - logical, external :: is_in_wavefunction - double precision :: norm(N_states) - - call generate_all_alpha_beta_det_products - norm = 0.d0 - do j=1,N_det_beta_unique - do k=1,N_int - tmp_det(k,2) = psi_det_beta_unique(k,j) - enddo - do i=1,N_det_alpha_unique - do k=1,N_int - tmp_det(k,1) = psi_det_alpha_unique(k,i) - enddo - idx = get_index_in_psi_det_sorted_bit(tmp_det,N_int) - if (idx > 0) then - do k=1,N_states - psi_coef_sorted_bit(idx,k) = psi_svd_matrix(i,j,k) - norm(k) += psi_svd_matrix(i,j,k) - enddo - endif - enddo - enddo - do k=1,N_states - norm(k) = 1.d0/dsqrt(norm(k)) - do i=1,N_det - psi_coef_sorted_bit(i,k) = psi_coef_sorted_bit(i,k)*norm(k) - enddo - enddo - psi_det = psi_det_sorted_bit - psi_coef = psi_coef_sorted_bit - TOUCH psi_det psi_coef - psi_det = psi_det_sorted - psi_coef = psi_coef_sorted - norm(1) = 0.d0 - do i=1,N_det - norm(1) += psi_average_norm_contrib_sorted(i) - if (norm(1) >= 0.999999d0) then - exit - endif - enddo - N_det = min(i,N_det) - SOFT_TOUCH psi_det psi_coef N_det - -end - -subroutine generate_all_alpha_beta_det_products - implicit none - BEGIN_DOC -! Create a wave function from all possible alpha x beta determinants - END_DOC - integer :: i,j,k,l - integer :: idx, iproc - integer, external :: get_index_in_psi_det_sorted_bit - integer(bit_kind), allocatable :: tmp_det(:,:,:) - logical, external :: is_in_wavefunction - integer, external :: omp_get_thread_num - - !$OMP PARALLEL DEFAULT(NONE) SHARED(psi_coef_sorted_bit,N_det_beta_unique,& - !$OMP N_det_alpha_unique, N_int, psi_det_alpha_unique, psi_det_beta_unique,& - !$OMP N_det) & - !$OMP PRIVATE(i,j,k,l,tmp_det,idx,iproc) - !$ iproc = omp_get_thread_num() - allocate (tmp_det(N_int,2,N_det_alpha_unique)) - !$OMP DO - do j=1,N_det_beta_unique - l = 1 - do i=1,N_det_alpha_unique - do k=1,N_int - tmp_det(k,1,l) = psi_det_alpha_unique(k,i) - tmp_det(k,2,l) = psi_det_beta_unique (k,j) - enddo - if (.not.is_in_wavefunction(tmp_det(1,1,l),N_int,N_det)) then - l = l+1 - endif - enddo - call fill_H_apply_buffer_no_selection(l-1, tmp_det, N_int, iproc) - enddo - !$OMP END DO NOWAIT - deallocate(tmp_det) - !$OMP END PARALLEL - deallocate (tmp_det) - call copy_H_apply_buffer_to_wf - SOFT_TOUCH psi_det psi_coef N_det -end - - BEGIN_PROVIDER [ double precision, psi_svd_alpha, (N_det_alpha_unique,N_det_alpha_unique,N_states) ] -&BEGIN_PROVIDER [ double precision, psi_svd_beta , (N_det_beta_unique,N_det_beta_unique,N_states) ] -&BEGIN_PROVIDER [ double precision, psi_svd_coefs, (N_det_beta_unique,N_states) ] - implicit none - BEGIN_DOC - ! SVD wave function - END_DOC - - integer :: lwork, info, istate - double precision, allocatable :: work(:), tmp(:,:), copy(:,:) - allocate (work(1),tmp(N_det_beta_unique,N_det_beta_unique), & - copy(size(psi_svd_matrix,1),size(psi_svd_matrix,2))) - - do istate = 1,N_states - copy(:,:) = psi_svd_matrix(:,:,istate) - lwork=-1 - call dgesvd('A','A', N_det_alpha_unique, N_det_beta_unique, & - copy, size(copy,1), & - psi_svd_coefs(1,istate), psi_svd_alpha(1,1,istate), & - size(psi_svd_alpha,1), & - tmp, size(psi_svd_beta,2), & - work, lwork, info) - lwork = work(1) - deallocate(work) - allocate(work(lwork)) - call dgesvd('A','A', N_det_alpha_unique, N_det_beta_unique, & - copy, size(copy,1), & - psi_svd_coefs(1,istate), psi_svd_alpha(1,1,istate), & - size(psi_svd_alpha,1), & - tmp, size(psi_svd_beta,2), & - work, lwork, info) - deallocate(work) - if (info /= 0) then - print *, irp_here//': error in det SVD' - stop 1 - endif - integer :: i,j - do j=1,N_det_beta_unique - do i=1,N_det_beta_unique - psi_svd_beta(i,j,istate) = tmp(j,i) - enddo - enddo - deallocate(tmp,copy) - enddo - -END_PROVIDER - - !==============================================================================! ! ! ! Read/write routines ! diff --git a/src/Dets/spindeterminants.ezfio_config b/src/Dets/spindeterminants.ezfio_config index 1c7d81e3..39ccb82b 100644 --- a/src/Dets/spindeterminants.ezfio_config +++ b/src/Dets/spindeterminants.ezfio_config @@ -1,12 +1,15 @@ spindeterminants n_det_alpha integer n_det_beta integer + n_det integer n_int integer bit_kind integer n_states integer psi_det_alpha integer*8 (spindeterminants_n_int*spindeterminants_bit_kind/8,spindeterminants_n_det_alpha) psi_det_beta integer*8 (spindeterminants_n_int*spindeterminants_bit_kind/8,spindeterminants_n_det_beta) - psi_coef_matrix double precision (spindeterminants_n_det_alpha,spindeterminants_n_det_beta,spindeterminants_n_states) + psi_coef_matrix_rows integer (spindeterminants_n_det) + psi_coef_matrix_columns integer (spindeterminants_n_det) + psi_coef_matrix_values double precision (spindeterminants_n_det,spindeterminants_n_states) n_svd_coefs integer psi_svd_alpha double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states) psi_svd_beta double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states) diff --git a/src/Dets/spindeterminants.irp.f b/src/Dets/spindeterminants.irp.f index 4b426faa..ffd28f85 100644 --- a/src/Dets/spindeterminants.irp.f +++ b/src/Dets/spindeterminants.irp.f @@ -1,3 +1,296 @@ +!==============================================================================! +! ! +! Independent alpha/beta parts ! +! ! +!==============================================================================! + +use bitmasks + +integer*8 function spin_det_search_key(det,Nint) + use bitmasks + implicit none + BEGIN_DOC +! Return an integer*8 corresponding to a determinant index for searching + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: det(Nint) + integer :: i + spin_det_search_key = det(1) + do i=2,Nint + spin_det_search_key = ieor(spin_det_search_key,det(i)) + enddo +end + + +BEGIN_PROVIDER [ integer(bit_kind), psi_det_alpha, (N_int,psi_det_size) ] + implicit none + BEGIN_DOC +! List of alpha determinants of psi_det + END_DOC + integer :: i,k + + do i=1,N_det + do k=1,N_int + psi_det_alpha(k,i) = psi_det(k,1,i) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), psi_det_beta, (N_int,psi_det_size) ] + implicit none + BEGIN_DOC +! List of beta determinants of psi_det + END_DOC + integer :: i,k + + do i=1,N_det + do k=1,N_int + psi_det_beta(k,i) = psi_det(k,2,i) + enddo + enddo +END_PROVIDER + + BEGIN_PROVIDER [ integer(bit_kind), psi_det_alpha_unique, (N_int,psi_det_size) ] +&BEGIN_PROVIDER [ integer, N_det_alpha_unique ] + implicit none + BEGIN_DOC + ! Unique alpha determinants + END_DOC + + integer :: i,k + integer, allocatable :: iorder(:) + integer*8, allocatable :: bit_tmp(:) + integer*8 :: last_key + integer*8, external :: spin_det_search_key + + allocate ( iorder(N_det), bit_tmp(N_det)) + + do i=1,N_det + iorder(i) = i + bit_tmp(i) = spin_det_search_key(psi_det_alpha(1,i),N_int) + enddo + + call i8sort(bit_tmp,iorder,N_det) + + N_det_alpha_unique = 0 + last_key = 0_8 + do i=1,N_det + if (bit_tmp(i) /= last_key) then + last_key = bit_tmp(i) + N_det_alpha_unique += 1 + do k=1,N_int + psi_det_alpha_unique(k,N_det_alpha_unique) = psi_det_alpha(k,iorder(i)) + enddo + endif + enddo + + deallocate (iorder, bit_tmp) +END_PROVIDER + + BEGIN_PROVIDER [ integer(bit_kind), psi_det_beta_unique, (N_int,psi_det_size) ] +&BEGIN_PROVIDER [ integer, N_det_beta_unique ] + implicit none + BEGIN_DOC + ! Unique beta determinants + END_DOC + + integer :: i,k + integer, allocatable :: iorder(:) + integer*8, allocatable :: bit_tmp(:) + integer*8 :: last_key + integer*8, external :: spin_det_search_key + + allocate ( iorder(N_det), bit_tmp(N_det)) + + do i=1,N_det + iorder(i) = i + bit_tmp(i) = spin_det_search_key(psi_det_beta(1,i),N_int) + enddo + + call i8sort(bit_tmp,iorder,N_det) + + N_det_beta_unique = 0 + last_key = 0_8 + do i=1,N_det + if (bit_tmp(i) /= last_key) then + last_key = bit_tmp(i) + N_det_beta_unique += 1 + do k=1,N_int + psi_det_beta_unique(k,N_det_beta_unique) = psi_det_beta(k,iorder(i)) + enddo + endif + enddo + + deallocate (iorder, bit_tmp) +END_PROVIDER + + + + + +integer function get_index_in_psi_det_alpha_unique(key,Nint) + use bitmasks + BEGIN_DOC +! Returns the index of the determinant in the ``psi_det_alpha_unique`` array + END_DOC + implicit none + + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key(Nint) + + integer :: i, ibegin, iend, istep, l + integer*8 :: det_ref, det_search + integer*8, external :: spin_det_search_key + logical :: is_in_wavefunction + + is_in_wavefunction = .False. + get_index_in_psi_det_alpha_unique = 0 + ibegin = 1 + iend = N_det_alpha_unique + 1 + + !DIR$ FORCEINLINE + det_ref = spin_det_search_key(key,Nint) + !DIR$ FORCEINLINE + det_search = spin_det_search_key(psi_det_alpha_unique(1,1),Nint) + + istep = ishft(iend-ibegin,-1) + i=ibegin+istep + do while (istep > 0) + !DIR$ FORCEINLINE + det_search = spin_det_search_key(psi_det_alpha_unique(1,i),Nint) + if ( det_search > det_ref ) then + iend = i + else if ( det_search == det_ref ) then + exit + else + ibegin = i + endif + istep = ishft(iend-ibegin,-1) + i = ibegin + istep + end do + + !DIR$ FORCEINLINE + do while (spin_det_search_key(psi_det_alpha_unique(1,i),Nint) == det_ref) + i = i-1 + if (i == 0) then + exit + endif + enddo + i += 1 + + if (i > N_det_alpha_unique) then + return + endif + + !DIR$ FORCEINLINE + do while (spin_det_search_key(psi_det_alpha_unique(1,i),Nint) == det_ref) + if (key(1) /= psi_det_alpha_unique(1,i)) then + continue + else + is_in_wavefunction = .True. + !DIR$ IVDEP + !DIR$ LOOP COUNT MIN(3) + do l=2,Nint + if (key(l) /= psi_det_alpha_unique(l,i)) then + is_in_wavefunction = .False. + endif + enddo + if (is_in_wavefunction) then + get_index_in_psi_det_alpha_unique = i + return + endif + endif + i += 1 + if (i > N_det_alpha_unique) then + return + endif + + enddo + +end + +integer function get_index_in_psi_det_beta_unique(key,Nint) + use bitmasks + BEGIN_DOC +! Returns the index of the determinant in the ``psi_det_beta_unique`` array + END_DOC + implicit none + + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key(Nint) + + integer :: i, ibegin, iend, istep, l + integer*8 :: det_ref, det_search + integer*8, external :: spin_det_search_key + logical :: is_in_wavefunction + + is_in_wavefunction = .False. + get_index_in_psi_det_beta_unique = 0 + ibegin = 1 + iend = N_det_beta_unique + 1 + + !DIR$ FORCEINLINE + det_ref = spin_det_search_key(key,Nint) + !DIR$ FORCEINLINE + det_search = spin_det_search_key(psi_det_beta_unique(1,1),Nint) + + istep = ishft(iend-ibegin,-1) + i=ibegin+istep + do while (istep > 0) + !DIR$ FORCEINLINE + det_search = spin_det_search_key(psi_det_beta_unique(1,i),Nint) + if ( det_search > det_ref ) then + iend = i + else if ( det_search == det_ref ) then + exit + else + ibegin = i + endif + istep = ishft(iend-ibegin,-1) + i = ibegin + istep + end do + + !DIR$ FORCEINLINE + do while (spin_det_search_key(psi_det_beta_unique(1,i),Nint) == det_ref) + i = i-1 + if (i == 0) then + exit + endif + enddo + i += 1 + + if (i > N_det_beta_unique) then + return + endif + + !DIR$ FORCEINLINE + do while (spin_det_search_key(psi_det_beta_unique(1,i),Nint) == det_ref) + if (key(1) /= psi_det_beta_unique(1,i)) then + continue + else + is_in_wavefunction = .True. + !DIR$ IVDEP + !DIR$ LOOP COUNT MIN(3) + do l=2,Nint + if (key(l) /= psi_det_beta_unique(l,i)) then + is_in_wavefunction = .False. + endif + enddo + if (is_in_wavefunction) then + get_index_in_psi_det_beta_unique = i + return + endif + endif + i += 1 + if (i > N_det_beta_unique) then + return + endif + + enddo + +end + + subroutine write_spindeterminants use bitmasks implicit none @@ -11,6 +304,7 @@ subroutine write_spindeterminants N_int2 = (N_int*bit_kind)/8 call ezfio_set_spindeterminants_n_det_alpha(N_det_alpha_unique) call ezfio_set_spindeterminants_n_det_beta(N_det_beta_unique) + call ezfio_set_spindeterminants_n_det(N_det) call ezfio_set_spindeterminants_n_int(N_int) call ezfio_set_spindeterminants_bit_kind(bit_kind) call ezfio_set_spindeterminants_n_states(N_states) @@ -39,7 +333,9 @@ subroutine write_spindeterminants call ezfio_set_spindeterminants_psi_det_beta(psi_det_beta_unique) deallocate(tmpdet) - call ezfio_set_spindeterminants_psi_coef_matrix(psi_svd_matrix) + call ezfio_set_spindeterminants_psi_coef_matrix_values(psi_svd_matrix_values) + call ezfio_set_spindeterminants_psi_coef_matrix_rows(psi_svd_matrix_rows) + call ezfio_set_spindeterminants_psi_coef_matrix_columns(psi_svd_matrix_columns) integer :: n_svd_coefs double precision :: norm, f @@ -49,7 +345,7 @@ subroutine write_spindeterminants do k=1,N_states norm -= psi_svd_coefs(n_svd_coefs,k)*psi_svd_coefs(n_svd_coefs,k) enddo - if (norm < 1.d-6) then + if (norm < 1.d-4) then exit endif enddo @@ -89,3 +385,231 @@ subroutine write_spindeterminants deallocate(dtmp) end + + +!==============================================================================! +! ! +! Alpha x Beta Matrix ! +! ! +!==============================================================================! + +BEGIN_PROVIDER [ double precision, psi_svd_matrix_values, (N_det,N_states) ] +&BEGIN_PROVIDER [ integer, psi_svd_matrix_rows, (N_det) ] +&BEGIN_PROVIDER [ integer, psi_svd_matrix_columns, (N_det) ] + use bitmasks + implicit none + BEGIN_DOC +! Matrix of wf coefficients. Outer product of alpha and beta determinants + END_DOC + integer :: i,j,k, l + integer(bit_kind) :: tmp_det(N_int,2) + integer :: idx + integer, external :: get_index_in_psi_det_sorted_bit + logical, external :: is_in_wavefunction + + + PROVIDE psi_coef_sorted_bit + +! l=0 +! do j=1,N_det_beta_unique +! do k=1,N_int +! tmp_det(k,2) = psi_det_beta_unique(k,j) +! enddo +! do i=1,N_det_alpha_unique +! do k=1,N_int +! tmp_det(k,1) = psi_det_alpha_unique(k,i) +! enddo +! idx = get_index_in_psi_det_sorted_bit(tmp_det,N_int) +! if (idx > 0) then +! l += 1 +! psi_svd_matrix_rows(l) = i +! psi_svd_matrix_columns(l) = j +! do k=1,N_states +! psi_svd_matrix_values(l,k) = psi_coef_sorted_bit(idx,k) +! enddo +! endif +! enddo +! enddo +! ASSERT (l == N_det) + + integer, allocatable :: iorder(:), to_sort(:) + integer, external :: get_index_in_psi_det_alpha_unique + integer, external :: get_index_in_psi_det_beta_unique + allocate(iorder(N_det), to_sort(N_det)) + do k=1,N_det + i = get_index_in_psi_det_alpha_unique(psi_det(1,1,k),N_int) + j = get_index_in_psi_det_beta_unique (psi_det(1,2,k),N_int) + do l=1,N_states + psi_svd_matrix_values(k,l) = psi_coef(k,l) + enddo + psi_svd_matrix_rows(k) = i + psi_svd_matrix_columns(k) = j + to_sort(k) = N_det_alpha_unique * (j-1) + i + iorder(k) = k + enddo + call isort(to_sort, iorder, N_det) + call iset_order(psi_svd_matrix_rows,iorder,N_det) + call iset_order(psi_svd_matrix_columns,iorder,N_det) + call dset_order(psi_svd_matrix_values,iorder,N_det) + deallocate(iorder,to_sort) +END_PROVIDER + +BEGIN_PROVIDER [ double precision, psi_svd_matrix, (N_det_alpha_unique,N_det_beta_unique,N_states) ] + implicit none + BEGIN_DOC +! Matrix of wf coefficients. Outer product of alpha and beta determinants + END_DOC + integer :: i,j,k,istate + psi_svd_matrix = 0.d0 + do k=1,N_det + i = psi_svd_matrix_rows(k) + j = psi_svd_matrix_columns(k) + do istate=1,N_states + psi_svd_matrix(i,j,istate) = psi_svd_matrix_values(k,istate) + enddo + enddo +END_PROVIDER + +subroutine create_wf_of_psi_svd_matrix + use bitmasks + implicit none + BEGIN_DOC +! Matrix of wf coefficients. Outer product of alpha and beta determinants + END_DOC + integer :: i,j,k + integer(bit_kind) :: tmp_det(N_int,2) + integer :: idx + integer, external :: get_index_in_psi_det_sorted_bit + logical, external :: is_in_wavefunction + double precision :: norm(N_states) + + call generate_all_alpha_beta_det_products + norm = 0.d0 + do j=1,N_det_beta_unique + do k=1,N_int + tmp_det(k,2) = psi_det_beta_unique(k,j) + enddo + do i=1,N_det_alpha_unique + do k=1,N_int + tmp_det(k,1) = psi_det_alpha_unique(k,i) + enddo + idx = get_index_in_psi_det_sorted_bit(tmp_det,N_int) + if (idx > 0) then + do k=1,N_states + psi_coef_sorted_bit(idx,k) = psi_svd_matrix(i,j,k) + norm(k) += psi_svd_matrix(i,j,k) + enddo + endif + enddo + enddo + do k=1,N_states + norm(k) = 1.d0/dsqrt(norm(k)) + do i=1,N_det + psi_coef_sorted_bit(i,k) = psi_coef_sorted_bit(i,k)*norm(k) + enddo + enddo + psi_det = psi_det_sorted_bit + psi_coef = psi_coef_sorted_bit + TOUCH psi_det psi_coef + psi_det = psi_det_sorted + psi_coef = psi_coef_sorted + norm(1) = 0.d0 + do i=1,N_det + norm(1) += psi_average_norm_contrib_sorted(i) + if (norm(1) >= 0.999999d0) then + exit + endif + enddo + N_det = min(i,N_det) + SOFT_TOUCH psi_det psi_coef N_det + +end + +subroutine generate_all_alpha_beta_det_products + implicit none + BEGIN_DOC +! Create a wave function from all possible alpha x beta determinants + END_DOC + integer :: i,j,k,l + integer :: idx, iproc + integer, external :: get_index_in_psi_det_sorted_bit + integer(bit_kind), allocatable :: tmp_det(:,:,:) + logical, external :: is_in_wavefunction + integer, external :: omp_get_thread_num + + !$OMP PARALLEL DEFAULT(NONE) SHARED(psi_coef_sorted_bit,N_det_beta_unique,& + !$OMP N_det_alpha_unique, N_int, psi_det_alpha_unique, psi_det_beta_unique,& + !$OMP N_det) & + !$OMP PRIVATE(i,j,k,l,tmp_det,idx,iproc) + !$ iproc = omp_get_thread_num() + allocate (tmp_det(N_int,2,N_det_alpha_unique)) + !$OMP DO + do j=1,N_det_beta_unique + l = 1 + do i=1,N_det_alpha_unique + do k=1,N_int + tmp_det(k,1,l) = psi_det_alpha_unique(k,i) + tmp_det(k,2,l) = psi_det_beta_unique (k,j) + enddo + if (.not.is_in_wavefunction(tmp_det(1,1,l),N_int,N_det)) then + l = l+1 + endif + enddo + call fill_H_apply_buffer_no_selection(l-1, tmp_det, N_int, iproc) + enddo + !$OMP END DO NOWAIT + deallocate(tmp_det) + !$OMP END PARALLEL + deallocate (tmp_det) + call copy_H_apply_buffer_to_wf + SOFT_TOUCH psi_det psi_coef N_det +end + + BEGIN_PROVIDER [ double precision, psi_svd_alpha, (N_det_alpha_unique,N_det_alpha_unique,N_states) ] +&BEGIN_PROVIDER [ double precision, psi_svd_beta , (N_det_beta_unique,N_det_beta_unique,N_states) ] +&BEGIN_PROVIDER [ double precision, psi_svd_coefs, (N_det_beta_unique,N_states) ] + implicit none + BEGIN_DOC + ! SVD wave function + END_DOC + + integer :: lwork, info, istate + double precision, allocatable :: work(:), tmp(:,:), copy(:,:) + allocate (work(1),tmp(N_det_beta_unique,N_det_beta_unique), & + copy(size(psi_svd_matrix,1),size(psi_svd_matrix,2))) + + do istate = 1,N_states + copy(:,:) = psi_svd_matrix(:,:,istate) + lwork=-1 + call dgesvd('A','A', N_det_alpha_unique, N_det_beta_unique, & + copy, size(copy,1), & + psi_svd_coefs(1,istate), psi_svd_alpha(1,1,istate), & + size(psi_svd_alpha,1), & + tmp, size(psi_svd_beta,2), & + work, lwork, info) + lwork = work(1) + deallocate(work) + allocate(work(lwork)) + call dgesvd('A','A', N_det_alpha_unique, N_det_beta_unique, & + copy, size(copy,1), & + psi_svd_coefs(1,istate), psi_svd_alpha(1,1,istate), & + size(psi_svd_alpha,1), & + tmp, size(psi_svd_beta,2), & + work, lwork, info) + deallocate(work) + if (info /= 0) then + print *, irp_here//': error in det SVD' + stop 1 + endif + integer :: i,j + do j=1,N_det_beta_unique + do i=1,N_det_beta_unique + psi_svd_beta(i,j,istate) = tmp(j,i) + enddo + enddo + deallocate(tmp,copy) + enddo + +END_PROVIDER + + diff --git a/src/FCIdump/README.rst b/src/FCIdump/README.rst index 1fdd9660..580d0016 100644 --- a/src/FCIdump/README.rst +++ b/src/FCIdump/README.rst @@ -10,9 +10,6 @@ Documentation .. Do not edit this section. It was auto-generated from the .. NEEDED_MODULES file. -`fcidump `_ - Undocumented - Needed Modules diff --git a/src/Makefile.config.ifort b/src/Makefile.config.ifort deleted file mode 100644 index 164d348e..00000000 --- a/src/Makefile.config.ifort +++ /dev/null @@ -1,30 +0,0 @@ -OPENMP =1 -PROFILE =0 -DEBUG = 0 - -IRPF90_FLAGS+= --align=32 -FC = ifort -g -FCFLAGS= -FCFLAGS+= -axAVX,SSE4.2 -FCFLAGS+= -O2 -FCFLAGS+= -ip -FCFLAGS+= -opt-prefetch -FCFLAGS+= -ftz -MKL=-mkl=parallel - -ifeq ($(PROFILE),1) -FC += -p -g -CXX += -pg -endif - -ifeq ($(OPENMP),1) -FC += -openmp -IRPF90_FLAGS += --openmp -CXX += -fopenmp -endif - -ifeq ($(DEBUG),1) -FC += -C -traceback -fpe0 -IRPF90_FLAGS += -a -#FCFLAGS =-O0 -endif From 654b190506bf35a7a2bc32569412c19d80fe8ac2 Mon Sep 17 00:00:00 2001 From: Thomas Applencourt Date: Thu, 16 Apr 2015 13:57:00 +0200 Subject: [PATCH 3/5] stirp to strip() --- scripts/ezfio_interface/ei_handler.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/ezfio_interface/ei_handler.py b/scripts/ezfio_interface/ei_handler.py index a940c584..220d368c 100755 --- a/scripts/ezfio_interface/ei_handler.py +++ b/scripts/ezfio_interface/ei_handler.py @@ -70,9 +70,9 @@ def is_bool(str_): Take a string, if is a bool return the conversion into fortran and ocaml. """ - if "true" in str_.stirp().lower(): + if "true" in str_.strip().lower(): return Type(None, "true", ".True.") - elif "false" in str_.stirp().lower(): + elif "false" in str_.strip().lower(): return Type(None, "false", ".False") else: raise TypeError From d45e611dadf92da9c7bba12c9145d8776bef5f3f Mon Sep 17 00:00:00 2001 From: Thomas Applencourt Date: Thu, 16 Apr 2015 14:31:28 +0200 Subject: [PATCH 4/5] Print is_bool() to debug in travis ci, canot see the bug in my machine --- scripts/ezfio_interface/ei_handler.py | 1 + 1 file changed, 1 insertion(+) diff --git a/scripts/ezfio_interface/ei_handler.py b/scripts/ezfio_interface/ei_handler.py index 220d368c..54b41197 100755 --- a/scripts/ezfio_interface/ei_handler.py +++ b/scripts/ezfio_interface/ei_handler.py @@ -278,6 +278,7 @@ def get_dict_config_file(config_file_path, module_lower): try: d[pvd]["default"] = is_bool(default_raw) + print is_bool(default_raw) except TypeError: d[pvd]["default"] = Type(None, default_raw, default_raw) From 030c89b957fa4d9df3fa3365ed5dec01577af198 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 19 Apr 2015 16:45:31 +0200 Subject: [PATCH 5/5] Solved True/true problem --- .../WILL_BE_DELETED.ezfio_default | 30 +++++++++---------- src/FCIdump/README.rst | 3 ++ 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/data/ezfio_defaults/WILL_BE_DELETED.ezfio_default b/data/ezfio_defaults/WILL_BE_DELETED.ezfio_default index cf54a1dd..0d9489d5 100644 --- a/data/ezfio_defaults/WILL_BE_DELETED.ezfio_default +++ b/data/ezfio_defaults/WILL_BE_DELETED.ezfio_default @@ -1,19 +1,19 @@ bielec_integrals - read_ao_integrals False - read_mo_integrals False - write_ao_integrals False - write_mo_integrals False + read_ao_integrals false + read_mo_integrals false + write_ao_integrals false + write_mo_integrals false threshold_ao 1.e-15 threshold_mo 1.e-15 - direct False + direct false cis_dressed n_state_cis 10 n_core_cis 0 n_act_cis mo_basis_mo_tot_num - mp2_dressing False - standard_doubles True - en_2_2 False + mp2_dressing false + standard_doubles true + en_2_2 false determinants n_states 1 @@ -21,27 +21,27 @@ determinants n_det_max_jacobi 1000 threshold_generators 0.99 threshold_selectors 0.999 - read_wf False - s2_eig False - only_single_double_dm False + read_wf false + s2_eig false + only_single_double_dm false full_ci n_det_max_fci 10000 n_det_max_fci_property 50000 pt2_max 1.e-4 - do_pt2_end True + do_pt2_end true var_pt2_ratio 0.75 cas_sd n_det_max_cas_sd 100000 pt2_max 1.e-4 - do_pt2_end True + do_pt2_end true var_pt2_ratio 0.75 all_singles n_det_max_fci 50000 pt2_max 1.e-8 - do_pt2_end False + do_pt2_end false hartree_fock n_it_scf_max 200 @@ -55,7 +55,7 @@ cisd_selected cisd_sc2_selected n_det_max_cisd_sc2 10000 pt2_max 1.e-4 - do_pt2_end True + do_pt2_end true properties z_one_point 3.9 diff --git a/src/FCIdump/README.rst b/src/FCIdump/README.rst index 580d0016..1fdd9660 100644 --- a/src/FCIdump/README.rst +++ b/src/FCIdump/README.rst @@ -10,6 +10,9 @@ Documentation .. Do not edit this section. It was auto-generated from the .. NEEDED_MODULES file. +`fcidump `_ + Undocumented + Needed Modules