LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-08 23:23:57 +01:00
Code Issues Releases Wiki Activity
47ac033293
quantum_package/src/Determinants/determinants.irp.f

841 lines
22 KiB
Fortran
Raw Blame History

use bitmasks
BEGIN_PROVIDER [ integer, N_det ]
implicit none
BEGIN_DOC
! Number of determinants in the wave function
END_DOC
logical :: exists
character*64 :: label
PROVIDE ezfio_filename
PROVIDE nproc
if (read_wf) then
call ezfio_has_determinants_n_det(exists)
if (exists) then
call ezfio_has_determinants_mo_label(exists)
if (exists) then
call ezfio_get_determinants_mo_label(label)
exists = (label == mo_label)
endif
endif
if (exists) then
call ezfio_get_determinants_n_det(N_det)
else
N_det = 1
endif
else
N_det = 1
endif
call write_int(output_determinants,N_det,'Number of determinants')
ASSERT (N_det > 0)
END_PROVIDER
BEGIN_PROVIDER [integer, max_degree_exc]
implicit none
integer :: i,degree
max_degree_exc = 0
BEGIN_DOC
! Maximum degree of excitation in the wf
END_DOC
do i = 1, N_det
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
if(degree.gt.max_degree_exc)then
max_degree_exc= degree
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, psi_det_size ]
implicit none
BEGIN_DOC
! Size of the psi_det/psi_coef arrays
END_DOC
PROVIDE ezfio_filename
logical :: exists
call ezfio_has_determinants_n_det(exists)
if (exists) then
call ezfio_get_determinants_n_det(psi_det_size)
else
psi_det_size = 1
endif
psi_det_size = max(psi_det_size,10000)
call write_int(output_determinants,psi_det_size,'Dimension of the psi arrays')
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ]
implicit none
BEGIN_DOC
! The wave function determinants. Initialized with Hartree-Fock if the EZFIO file
! is empty
END_DOC
integer :: i
logical :: exists
character*64 :: label
if (read_wf) then
call ezfio_has_determinants_N_int(exists)
if (exists) then
call ezfio_has_determinants_bit_kind(exists)
if (exists) then
call ezfio_has_determinants_N_det(exists)
if (exists) then
call ezfio_has_determinants_N_states(exists)
if (exists) then
call ezfio_has_determinants_psi_det(exists)
if (exists) then
call ezfio_has_determinants_mo_label(exists)
if (exists) then
call ezfio_get_determinants_mo_label(label)
exists = (label == mo_label)
endif
endif
endif
endif
endif
endif
if (exists) then
call read_dets(psi_det,N_int,N_det)
else
psi_det = 0_bit_kind
do i=1,N_int
psi_det(i,1,1) = HF_bitmask(i,1)
psi_det(i,2,1) = HF_bitmask(i,2)
enddo
endif
else
psi_det = 0_bit_kind
do i=1,N_int
psi_det(i,1,1) = HF_bitmask(i,1)
psi_det(i,2,1) = HF_bitmask(i,2)
enddo
endif
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_occ_pattern, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ integer, N_occ_pattern ]
implicit none
BEGIN_DOC
! array of the occ_pattern present in the wf
! psi_occ_pattern(:,1,j) = jth occ_pattern of the wave function : represent all the single occupation
! psi_occ_pattern(:,2,j) = jth occ_pattern of the wave function : represent all the double occupation
END_DOC
integer :: i,j,k
! create
do i = 1, N_det
do k = 1, N_int
psi_occ_pattern(k,1,i) = ieor(psi_det(k,1,i),psi_det(k,2,i))
psi_occ_pattern(k,2,i) = iand(psi_det(k,1,i),psi_det(k,2,i))
enddo
enddo
! Sort
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: occ_pattern_search_key
integer(bit_kind), allocatable :: tmp_array(:,:,:)
logical,allocatable :: duplicate(:)
allocate ( iorder(N_det), duplicate(N_det), bit_tmp(N_det), tmp_array(N_int,2,psi_det_size) )
do i=1,N_det
iorder(i) = i
!$DIR FORCEINLINE
bit_tmp(i) = occ_pattern_search_key(psi_occ_pattern(1,1,i),N_int)
enddo
call i8sort(bit_tmp,iorder,N_det)
!DIR$ IVDEP
do i=1,N_det
do k=1,N_int
tmp_array(k,1,i) = psi_occ_pattern(k,1,iorder(i))
tmp_array(k,2,i) = psi_occ_pattern(k,2,iorder(i))
enddo
duplicate(i) = .False.
enddo
i=1
integer (bit_kind) :: occ_pattern_tmp
do i=1,N_det
duplicate(i) = .False.
enddo
do i=1,N_det-1
if (duplicate(i)) then
cycle
endif
j = i+1
do while (bit_tmp(j)==bit_tmp(i))
if (duplicate(j)) then
j+=1
cycle
endif
duplicate(j) = .True.
do k=1,N_int
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) &
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
duplicate(j) = .False.
exit
endif
enddo
j+=1
if (j>N_det) then
exit
endif
enddo
enddo
N_occ_pattern=0
do i=1,N_det
if (duplicate(i)) then
cycle
endif
N_occ_pattern += 1
do k=1,N_int
psi_occ_pattern(k,1,N_occ_pattern) = tmp_array(k,1,i)
psi_occ_pattern(k,2,N_occ_pattern) = tmp_array(k,2,i)
enddo
enddo
deallocate(iorder,duplicate,bit_tmp,tmp_array)
! !TODO DEBUG
! integer :: s
! do i=1,N_occ_pattern
! do j=i+1,N_occ_pattern
! s = 0
! do k=1,N_int
! if((psi_occ_pattern(k,1,j) /= psi_occ_pattern(k,1,i)).or. &
! (psi_occ_pattern(k,2,j) /= psi_occ_pattern(k,2,i))) then
! s=1
! exit
! endif
! enddo
! if ( s == 0 ) then
! print *, 'Error : occ ', j, 'already in wf'
! call debug_det(psi_occ_pattern(1,1,j),N_int)
! stop
! endif
! enddo
! enddo
! !TODO DEBUG
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_coef, (psi_det_size,N_states_diag) ]
implicit none
BEGIN_DOC
! The wave function coefficients. Initialized with Hartree-Fock if the EZFIO file
! is empty
END_DOC
integer :: i,k, N_int2
logical :: exists
double precision, allocatable :: psi_coef_read(:,:)
character*(64) :: label
psi_coef = 0.d0
do i=1,N_states_diag
psi_coef(i,i) = 1.d0
enddo
if (read_wf) then
call ezfio_has_determinants_psi_coef(exists)
if (exists) then
call ezfio_has_determinants_mo_label(exists)
if (exists) then
call ezfio_get_determinants_mo_label(label)
exists = (label == mo_label)
endif
endif
if (exists) then
allocate (psi_coef_read(N_det,N_states))
call ezfio_get_determinants_psi_coef(psi_coef_read)
do k=1,N_states
do i=1,N_det
psi_coef(i,k) = psi_coef_read(i,k)
enddo
enddo
deallocate(psi_coef_read)
endif
endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_average_norm_contrib, (psi_det_size) ]
implicit none
BEGIN_DOC
! Contribution of determinants to the state-averaged density
END_DOC
integer :: i,j,k
double precision :: f
f = 1.d0/dble(N_states)
do i=1,N_det
psi_average_norm_contrib(i) = psi_coef(i,1)*psi_coef(i,1)*f
enddo
do k=2,N_states
do i=1,N_det
psi_average_norm_contrib(i) = psi_average_norm_contrib(i) + &
psi_coef(i,k)*psi_coef(i,k)*f
enddo
enddo
END_PROVIDER
!==============================================================================!
! !
! Sorting providers !
! !
!==============================================================================!
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) ]
implicit none
BEGIN_DOC
! Wave function sorted by determinants contribution to the norm (state-averaged)
END_DOC
integer :: i,j,k
integer, allocatable :: iorder(:)
allocate ( iorder(N_det) )
do i=1,N_det
psi_average_norm_contrib_sorted(i) = -psi_average_norm_contrib(i)
iorder(i) = i
enddo
call dsort(psi_average_norm_contrib_sorted,iorder,N_det)
!DIR$ IVDEP
do i=1,N_det
do j=1,N_int
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
deallocate(iorder)
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 <i|H|psi> 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, &
psi_det_sorted_bit, psi_coef_sorted_bit)
END_PROVIDER
subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, det_out, coef_out)
use bitmasks
implicit none
integer, intent(in) :: Ndet
integer(bit_kind), intent(in) :: det_in (N_int,2,psi_det_size)
double precision , intent(in) :: coef_in(psi_det_size,N_states)
integer(bit_kind), intent(out) :: det_out (N_int,2,psi_det_size)
double precision , intent(out) :: coef_out(psi_det_size,N_states)
BEGIN_DOC
! Determinants are sorted are sorted according to their det_search_key.
! Useful to accelerate the search of a random determinant in the wave
! function.
END_DOC
integer :: i,j,k
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: det_search_key
allocate ( iorder(Ndet), bit_tmp(Ndet) )
do i=1,Ndet
iorder(i) = i
!$DIR FORCEINLINE
bit_tmp(i) = det_search_key(det_in(1,1,i),N_int)
enddo
call i8sort(bit_tmp,iorder,Ndet)
!DIR$ IVDEP
do i=1,Ndet
do j=1,N_int
det_out(j,1,i) = det_in(j,1,iorder(i))
det_out(j,2,i) = det_in(j,2,iorder(i))
enddo
do k=1,N_states
coef_out(i,k) = coef_in(iorder(i),k)
enddo
enddo
deallocate(iorder, bit_tmp)
end
subroutine int_of_3_highest_electrons( det_in, res, Nint )
implicit none
use bitmasks
integer,intent(in) :: Nint
integer(bit_kind) :: det_in(Nint)
integer*8 :: res
BEGIN_DOC
! Returns an integer*8 as :
!
! |_<--- 21 bits ---><--- 21 bits ---><--- 21 bits --->|
!
! |0<--- i1 ---><--- i2 ---><--- i3 --->|
!
! It encodes the value of the indices of the 3 highest MOs
! in descending order
!
END_DOC
integer :: i, k, icount
integer(bit_kind) :: ix
res = 0_8
icount = 3
do k=Nint,1,-1
ix = det_in(k)
do while (ix /= 0_bit_kind)
i = bit_kind_size-1-leadz(ix)
ix = ibclr(ix,i)
res = ior(ishft(res, 21), i+ishft(k-1,bit_kind_shift))
icount -= 1
if (icount == 0) then
return
endif
enddo
enddo
end
subroutine filter_3_highest_electrons( det_in, det_out, Nint )
implicit none
use bitmasks
integer,intent(in) :: Nint
integer(bit_kind) :: det_in(Nint), det_out(Nint)
BEGIN_DOC
! Returns a determinant with only the 3 highest electrons
END_DOC
integer :: i, k, icount
integer(bit_kind) :: ix
det_out = 0_8
icount = 3
do k=Nint,1,-1
ix = det_in(k)
do while (ix /= 0_bit_kind)
i = bit_kind_size-1-leadz(ix)
ix = ibclr(ix,i)
det_out(k) = ibset(det_out(k),i)
icount -= 1
if (icount == 0) then
return
endif
enddo
enddo
end
BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ]
&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ]
&BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ]
&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ]
implicit none
BEGIN_DOC
! Max and min values of the coefficients
END_DOC
integer:: i
do i=1,N_states
psi_coef_min(i) = minval(psi_coef(:,i))
psi_coef_max(i) = maxval(psi_coef(:,i))
abs_psi_coef_min(i) = dabs(psi_coef_min(i))
abs_psi_coef_max(i) = dabs(psi_coef_max(i))
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_ab, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_ab, (N_det,N_states) ]
&BEGIN_PROVIDER [ integer, psi_det_sorted_next_ab, (2,psi_det_size) ]
implicit none
BEGIN_DOC
! Determinants on which we apply <i|H|j>.
! 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.
END_DOC
call sort_dets_by_3_highest_electrons( &
psi_det, &
psi_coef, &
psi_det_sorted_ab, &
psi_coef_sorted_ab, &
psi_det_sorted_next_ab, &
N_det, N_states, N_int, &
psi_det_size )
END_PROVIDER
subroutine sort_dets_by_3_highest_electrons(det_in,coef_in,det_out,coef_out, &
det_next, Ndet, Nstates, Nint, LDA)
implicit none
integer, intent(in) :: Ndet, Nstates, Nint, LDA
integer(bit_kind), intent(in) :: det_in (Nint,2,Ndet)
integer(bit_kind), intent(out) :: det_out (Nint,2,Ndet)
integer, intent(out) :: det_next (2,Ndet)
double precision, intent(in) :: coef_in (LDA,Nstates)
double precision, intent(out) :: coef_out (LDA,Nstates)
BEGIN_DOC
! Determinants on which we apply <i|H|j>.
! 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.
END_DOC
integer :: i,j,k
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: det_search_key
allocate ( iorder(Ndet), bit_tmp(Ndet) )
! Sort alpha dets
! ---------------
integer(bit_kind) :: det_tmp(Nint)
do i=1,Ndet
iorder(i) = i
call int_of_3_highest_electrons(psi_det(1,1,i),bit_tmp(i),N_int)
enddo
call i8sort(bit_tmp,iorder,Ndet)
!DIR$ IVDEP
do i=1,Ndet
do j=1,N_int
det_out(j,1,i) = psi_det(j,1,iorder(i))
det_out(j,2,i) = psi_det(j,2,iorder(i))
enddo
do k=1,Nstates
coef_out(i,k) = psi_coef(iorder(i),k)
enddo
enddo
! Find next alpha
! ---------------
integer :: next
next = Ndet+1
det_next(1,Ndet) = next
do i=Ndet-1,1,-1
if (bit_tmp(i) /= bit_tmp(i+1)) then
next = i+1
endif
det_next(1,i) = next
enddo
! Sort beta dets
! --------------
integer :: istart, iend
integer(bit_kind), allocatable :: det_sorted_temp (:,:)
allocate ( det_sorted_temp (N_int,Ndet) )
do i=1,Ndet
do j=1,N_int
det_sorted_temp(j,i) = det_out(j,2,i)
enddo
iorder(i) = i
call int_of_3_highest_electrons(det_sorted_temp(1,i),bit_tmp(i),N_int)
enddo
istart=1
do while ( istart<Ndet )
iend = det_next(1,istart)
call i8sort(bit_tmp(istart),iorder(istart),iend-istart)
!DIR$ IVDEP
do i=istart,iend-1
do j=1,N_int
det_out(j,2,i) = det_sorted_temp(j,iorder(i))
enddo
do k=1,Nstates
coef_out(i,k) = psi_coef(iorder(i),k)
enddo
enddo
next = iend
det_next(2,iend-1) = next
do i=iend-2,1,-1
if (bit_tmp(i) /= bit_tmp(i+1)) then
next = i+1
endif
det_next(2,i) = next
enddo
istart = iend
enddo
deallocate(iorder, bit_tmp, det_sorted_temp)
end
!==============================================================================!
! !
! Read/write routines !
! !
!==============================================================================!
subroutine read_dets(det,Nint,Ndet)
use bitmasks
implicit none
BEGIN_DOC
! Reads the determinants from the EZFIO file
END_DOC
integer, intent(in) :: Nint,Ndet
integer(bit_kind), intent(out) :: det(Nint,2,Ndet)
integer*8, allocatable :: psi_det_read(:,:,:)
double precision, allocatable :: psi_coef_read(:,:)
integer*8 :: det_8(100)
integer(bit_kind) :: det_bk((100*8)/bit_kind)
integer :: N_int2
integer :: i,k
equivalence (det_8, det_bk)
call ezfio_get_determinants_N_int(N_int2)
ASSERT (N_int2 == Nint)
call ezfio_get_determinants_bit_kind(k)
ASSERT (k == bit_kind)
N_int2 = (Nint*bit_kind)/8
allocate (psi_det_read(N_int2,2,Ndet))
call ezfio_get_determinants_psi_det (psi_det_read)
! print*,'N_int2 = ',N_int2,N_int
! print*,'k',k,bit_kind
! print*,'psi_det_read = ',Ndet
do i=1,Ndet
do k=1,N_int2
det_8(k) = psi_det_read(k,1,i)
enddo
do k=1,Nint
det(k,1,i) = det_bk(k)
enddo
do k=1,N_int2
det_8(k) = psi_det_read(k,2,i)
enddo
do k=1,Nint
det(k,2,i) = det_bk(k)
enddo
enddo
deallocate(psi_det_read)
end
subroutine save_wavefunction
implicit none
use bitmasks
BEGIN_DOC
! Save the wave function into the EZFIO file
END_DOC
call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
end
subroutine save_wavefunction_unsorted
implicit none
use bitmasks
BEGIN_DOC
! Save the wave function into the EZFIO file
END_DOC
call save_wavefunction_general(N_det,N_states,psi_det,size(psi_coef,1),psi_coef)
end
subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
implicit none
BEGIN_DOC
! Save the wave function into the EZFIO file
END_DOC
use bitmasks
integer, intent(in) :: ndet,nstates,dim_psicoef
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
double precision, intent(in) :: psicoef(dim_psicoef,nstates)
integer*8, allocatable :: psi_det_save(:,:,:)
double precision, allocatable :: psi_coef_save(:,:)
integer*8 :: det_8(100)
integer(bit_kind) :: det_bk((100*8)/bit_kind)
integer :: N_int2
equivalence (det_8, det_bk)
integer :: i,k
PROVIDE progress_bar
call start_progress(7,'Saving wfunction',0.d0)
progress_bar(1) = 1
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_N_int(N_int)
progress_bar(1) = 2
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_bit_kind(bit_kind)
progress_bar(1) = 3
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_N_det(ndet)
progress_bar(1) = 4
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_n_states(nstates)
progress_bar(1) = 5
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_mo_label(mo_label)
progress_bar(1) = 6
progress_value = dble(progress_bar(1))
N_int2 = (N_int*bit_kind)/8
allocate (psi_det_save(N_int2,2,ndet))
do i=1,ndet
do k=1,N_int
det_bk(k) = psidet(k,1,i)
enddo
do k=1,N_int2
psi_det_save(k,1,i) = det_8(k)
enddo
do k=1,N_int
det_bk(k) = psidet(k,2,i)
enddo
do k=1,N_int2
psi_det_save(k,2,i) = det_8(k)
enddo
! print*,psi_det_save
enddo
call ezfio_set_determinants_psi_det(psi_det_save)
deallocate (psi_det_save)
progress_bar(1) = 7
progress_value = dble(progress_bar(1))
allocate (psi_coef_save(ndet,nstates))
double precision :: accu_norm(nstates)
accu_norm = 0.d0
do k=1,nstates
do i=1,ndet
accu_norm(k) = accu_norm(k) + psicoef(i,k) * psicoef(i,k)
psi_coef_save(i,k) = psicoef(i,k)
enddo
enddo
do k = 1, nstates
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
enddo
do k=1,nstates
do i=1,ndet
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
enddo
enddo
call ezfio_set_determinants_psi_coef(psi_coef_save)
call write_int(output_determinants,ndet,'Saved determinants')
call stop_progress
deallocate (psi_coef_save)
end
subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,index_det_save)
implicit none
BEGIN_DOC
! Save the wave function into the EZFIO file
END_DOC
use bitmasks
integer, intent(in) :: ndet,nstates
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
double precision, intent(in) :: psicoef(ndet,nstates)
integer, intent(in) :: index_det_save(ndet)
integer, intent(in) :: ndetsave
integer*8, allocatable :: psi_det_save(:,:,:)
double precision, allocatable :: psi_coef_save(:,:)
integer*8 :: det_8(100)
integer(bit_kind) :: det_bk((100*8)/bit_kind)
integer :: N_int2
equivalence (det_8, det_bk)
integer :: i,k
PROVIDE progress_bar
call start_progress(7,'Saving wfunction',0.d0)
progress_bar(1) = 1
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_N_int(N_int)
progress_bar(1) = 2
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_bit_kind(bit_kind)
progress_bar(1) = 3
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_N_det(ndetsave)
progress_bar(1) = 4
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_n_states(nstates)
progress_bar(1) = 5
progress_value = dble(progress_bar(1))
call ezfio_set_determinants_mo_label(mo_label)
progress_bar(1) = 6
progress_value = dble(progress_bar(1))
N_int2 = (N_int*bit_kind)/8
allocate (psi_det_save(N_int2,2,ndetsave))
do i=1,ndetsave
do k=1,N_int
det_bk(k) = psidet(k,1,index_det_save(i))
enddo
do k=1,N_int2
psi_det_save(k,1,i) = det_8(k)
enddo
do k=1,N_int
det_bk(k) = psidet(k,2,index_det_save(i))
enddo
do k=1,N_int2
psi_det_save(k,2,i) = det_8(k)
enddo
enddo
call ezfio_set_determinants_psi_det(psi_det_save)
deallocate (psi_det_save)
progress_bar(1) = 7
progress_value = dble(progress_bar(1))
allocate (psi_coef_save(ndetsave,nstates))
double precision :: accu_norm(nstates)
accu_norm = 0.d0
do k=1,nstates
do i=1,ndetsave
accu_norm(k) = accu_norm(k) + psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k)
psi_coef_save(i,k) = psicoef(index_det_save(i),k)
enddo
enddo
do k = 1, nstates
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
enddo
do k=1,nstates
do i=1,ndetsave
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
enddo
enddo
call ezfio_set_determinants_psi_coef(psi_coef_save)
call write_int(output_determinants,ndet,'Saved determinants')
call stop_progress
deallocate (psi_coef_save)
end
Reference in New Issue View Git Blame Copy Permalink