10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-25 22:52:15 +02:00

Merge eos:quantum_package

This commit is contained in:
Anthony Scemama 2017-07-15 01:23:21 +02:00
commit e7b61d6f7b
4 changed files with 17 additions and 14 deletions

View File

@ -21,6 +21,6 @@ program qmcpack
enddo enddo
call save_mos call save_mos
call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5') call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5')
call system('$QP_ROOT/src/qmcpack/qp_convert_qmcpack_to_ezfio.py '//trim(ezfio_filename)) call system('$QP_ROOT/src/QMC/qp_convert_qmcpack_to_ezfio.py '//trim(ezfio_filename))
end end

View File

@ -1,4 +1,10 @@
program e_curve program truncate
read_wf = .True.
SOFT_TOUCH read_wf
call run
end
subroutine run
use bitmasks use bitmasks
implicit none implicit none
integer :: i,j,k, kk, nab, m, l integer :: i,j,k, kk, nab, m, l
@ -6,9 +12,6 @@ program e_curve
integer, allocatable :: iorder(:) integer, allocatable :: iorder(:)
double precision , allocatable :: norm_sort(:) double precision , allocatable :: norm_sort(:)
double precision :: e_0(N_states) double precision :: e_0(N_states)
if (.not.read_wf) then
stop 'Please set read_wf to true'
endif
PROVIDE mo_bielec_integrals_in_map H_apply_buffer_allocated PROVIDE mo_bielec_integrals_in_map H_apply_buffer_allocated
@ -21,8 +24,6 @@ program e_curve
allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det)) allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det))
allocate(u_0(N_det,N_states),v_0(N_det,N_states)) allocate(u_0(N_det,N_states),v_0(N_det,N_states))
read(*,*) ci_threshold
norm_sort(0) = 0.d0 norm_sort(0) = 0.d0
iorder(0) = 0 iorder(0) = 0
do i=1,n_det_alpha_unique do i=1,n_det_alpha_unique
@ -100,7 +101,7 @@ program e_curve
print *, 'Energy', E print *, 'Energy', E
exit exit
enddo enddo
call wf_of_psi_bilinear_matrix() call wf_of_psi_bilinear_matrix(.True.)
call save_wavefunction call save_wavefunction
deallocate (iorder, norm_sort) deallocate (iorder, norm_sort)

View File

@ -1503,14 +1503,16 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
!DIR$ LOOP COUNT (1000) !DIR$ LOOP COUNT (1000)
do i=1,sze do i=1,sze
d = 0 d = 0
degree_alpha = 0
degree_beta = 0
!DIR$ LOOP COUNT MIN(4) !DIR$ LOOP COUNT MIN(4)
do m=1,Nint do m=1,Nint
d = d + popcnt(xor( key1(m,1,i), key2(m,1))) & d = d + popcnt(xor( key1(m,1,i), key2(m,1))) &
+ popcnt(xor( key1(m,2,i), key2(m,2))) + popcnt(xor( key1(m,2,i), key2(m,2)))
key_tmp(m,1) = xor(key1(m,1,i),key2(m,1)) key_tmp(m,1) = xor(key1(m,1,i),key2(m,1))
key_tmp(m,2) = xor(key1(m,2,i),key2(m,2)) key_tmp(m,2) = xor(key1(m,2,i),key2(m,2))
degree_alpha = popcnt(key_tmp(m,1)) degree_alpha += popcnt(key_tmp(m,1))
degree_beta = popcnt(key_tmp(m,2)) degree_beta += popcnt(key_tmp(m,2))
enddo enddo
if(degree_alpha .gt.3 .or. degree_beta .gt.3 )cycle !! no double excitations of same spin if(degree_alpha .gt.3 .or. degree_beta .gt.3 )cycle !! no double excitations of same spin
degree(l) = ishft(d,-1) degree(l) = ishft(d,-1)
@ -1661,12 +1663,13 @@ subroutine get_excitation_degree_vector_mono_or_exchange_verbose(key1,key2,degre
do i=1,sze do i=1,sze
d = 0 d = 0
exchange_1 = 0 exchange_1 = 0
exchange_2 = 0
!DIR$ LOOP COUNT MIN(4) !DIR$ LOOP COUNT MIN(4)
do m=1,Nint do m=1,Nint
d = d + popcnt(xor( key1(m,1,i), key2(m,1))) & d = d + popcnt(xor( key1(m,1,i), key2(m,1))) &
+ popcnt(xor( key1(m,2,i), key2(m,2))) + popcnt(xor( key1(m,2,i), key2(m,2)))
exchange_1 = popcnt(xor(iand(key1(m,1,i),key1(m,2,i)),iand(key2(m,1),key2(m,2)))) exchange_1 += popcnt(xor(iand(key1(m,1,i),key1(m,2,i)),iand(key2(m,1),key2(m,2))))
exchange_2 = popcnt(iand(xor(key1(m,1,i),key2(m,1)),xor(key1(m,2,i),key2(m,2)))) exchange_2 += popcnt(iand(xor(key1(m,1,i),key2(m,1)),xor(key1(m,2,i),key2(m,2))))
enddo enddo
if (d > 4)cycle if (d > 4)cycle
if (d ==4)then if (d ==4)then
@ -2225,7 +2228,7 @@ subroutine get_excitation_degree_spin(key1,key2,degree,Nint)
degree = sum(popcnt(xorvec(1:4))) degree = sum(popcnt(xorvec(1:4)))
case default case default
do l=1,N_int do l=1,Nint
xorvec(l) = xor( key1(l), key2(l)) xorvec(l) = xor( key1(l), key2(l))
enddo enddo
degree = sum(popcnt(xorvec(1:Nint))) degree = sum(popcnt(xorvec(1:Nint)))

View File

@ -1217,7 +1217,6 @@ subroutine wf_of_psi_bilinear_matrix(truncate)
integer :: idx integer :: idx
integer, external :: get_index_in_psi_det_sorted_bit integer, external :: get_index_in_psi_det_sorted_bit
double precision :: norm(N_states) double precision :: norm(N_states)
PROVIDE psi_bilinear_matrix
do k=1,N_det do k=1,N_det
i = psi_bilinear_matrix_rows(k) i = psi_bilinear_matrix_rows(k)