LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-06 21:43:39 +01:00
Code Releases Activity

Norm -> Norm^2

Browse Source
This commit is contained in:
Anthony Scemama 2020-08-23 02:07:20 +02:00
parent 253ec57ae0
commit 7cb492ef3c
5 changed files with 65 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/cipsi/pt2_stoch_routines.irp.f
View File

@ -61,15 +61,15 @@ logical function testTeethBuilding(minF, N)
allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators))
norm = 0.d0 double precision :: norm2
double precision :: norm norm2 = 0.d0
do i=N_det_generators,1,-1 do i=N_det_generators,1,-1
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * & tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * &
psi_coef_sorted_gen(i,pt2_stoch_istate) psi_coef_sorted_gen(i,pt2_stoch_istate)
norm = norm + tilde_w(i) norm2 = norm2 + tilde_w(i)
enddo enddo
f = 1.d0/norm f = 1.d0/norm2
tilde_w(:) = tilde_w(:) * f tilde_w(:) = tilde_w(:) * f
tilde_cW(0) = -1.d0 tilde_cW(0) = -1.d0
@ -107,7 +107,7 @@ end function
subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in) subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm2, N_in)
use f77_zmq use f77_zmq
use selection_types use selection_types
@ -118,7 +118,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
! integer, intent(inout) :: N_in ! integer, intent(inout) :: N_in
double precision, intent(in) :: relative_error, E(N_states) double precision, intent(in) :: relative_error, E(N_states)
double precision, intent(out) :: pt2(N_states),error(N_states) double precision, intent(out) :: pt2(N_states),error(N_states)
double precision, intent(out) :: variance(N_states),norm(N_states) double precision, intent(out) :: variance(N_states),norm2(N_states)
integer :: i, N integer :: i, N
@ -140,8 +140,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then
pt2=0.d0 pt2=0.d0
variance=0.d0 variance=0.d0
norm=0.d0 norm2=0.d0
call ZMQ_selection(N_in, pt2, variance, norm) call ZMQ_selection(N_in, pt2, variance, norm2)
error(:) = 0.d0 error(:) = 0.d0
else else
@ -264,7 +264,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
nproc_target * 8.d0 * & ! bytes nproc_target * 8.d0 * & ! bytes
( 0.5d0*pt2_n_tasks_max & ! task_id ( 0.5d0*pt2_n_tasks_max & ! task_id
+ 64.d0*pt2_n_tasks_max & ! task + 64.d0*pt2_n_tasks_max & ! task
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm2
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset + 1.d0*pt2_n_tasks_max & ! i_generator, subset
+ 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
@ -294,7 +294,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
print '(A)', '========== ================= =========== =============== =============== =================' print '(A)', '========== ================= =========== =============== =============== ================='
print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds ' print '(A)', ' Samples Energy Stat. Err Variance Norm^2 Seconds '
print '(A)', '========== ================= =========== =============== =============== =================' print '(A)', '========== ================= =========== =============== =============== ================='
PROVIDE global_selection_buffer PROVIDE global_selection_buffer
@ -307,7 +307,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1) pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1)
error(pt2_stoch_istate) = w(pt2_stoch_istate,2) error(pt2_stoch_istate) = w(pt2_stoch_istate,2)
variance(pt2_stoch_istate) = w(pt2_stoch_istate,3) variance(pt2_stoch_istate) = w(pt2_stoch_istate,3)
norm(pt2_stoch_istate) = w(pt2_stoch_istate,4) norm2(pt2_stoch_istate) = w(pt2_stoch_istate,4)
else else
call pt2_slave_inproc(i) call pt2_slave_inproc(i)
@ -338,7 +338,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
pt2(k) = 0.d0 pt2(k) = 0.d0
enddo enddo
call update_pt2_and_variance_weights(pt2, variance, norm, N_states) call update_pt2_and_variance_weights(pt2, variance, norm2, N_states)
end subroutine end subroutine
@ -352,7 +352,7 @@ subroutine pt2_slave_inproc(i)
end end
subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, variance, norm, b, N_) subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, variance, norm2, b, N_)
use f77_zmq use f77_zmq
use selection_types use selection_types
use bitmasks use bitmasks
@ -362,7 +362,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
double precision, intent(in) :: relative_error, E double precision, intent(in) :: relative_error, E
double precision, intent(out) :: pt2(N_states), error(N_states) double precision, intent(out) :: pt2(N_states), error(N_states)
double precision, intent(out) :: variance(N_states), norm(N_states) double precision, intent(out) :: variance(N_states), norm2(N_states)
type(selection_buffer), intent(inout) :: b type(selection_buffer), intent(inout) :: b
integer, intent(in) :: N_ integer, intent(in) :: N_
@ -421,7 +421,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
pt2(:) = -huge(1.) pt2(:) = -huge(1.)
error(:) = huge(1.) error(:) = huge(1.)
variance(:) = huge(1.) variance(:) = huge(1.)
norm(:) = 0.d0 norm2(:) = 0.d0
S(:) = 0d0 S(:) = 0d0
S2(:) = 0d0 S2(:) = 0d0
T2(:) = 0d0 T2(:) = 0d0
@ -497,7 +497,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
endif endif
pt2(pt2_stoch_istate) = avg pt2(pt2_stoch_istate) = avg
variance(pt2_stoch_istate) = avg2 variance(pt2_stoch_istate) = avg2
norm(pt2_stoch_istate) = avg3 norm2(pt2_stoch_istate) = avg3
call wall_time(time) call wall_time(time)
! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969)
if(c > 2) then if(c > 2) then
@ -757,13 +757,13 @@ END_PROVIDER
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20 tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20
enddo enddo
double precision :: norm double precision :: norm2
norm = 0.d0 norm2 = 0.d0
do i=N_det_generators,1,-1 do i=N_det_generators,1,-1
norm += tilde_w(i) norm2 += tilde_w(i)
enddo enddo
tilde_w(:) = tilde_w(:) / norm tilde_w(:) = tilde_w(:) / norm2
tilde_cW(0) = -1.d0 tilde_cW(0) = -1.d0
do i=1,N_det_generators do i=1,N_det_generators

26
src/cipsi/selection.irp.f
View File

@ -19,7 +19,7 @@ BEGIN_PROVIDER [ double precision, variance_match_weight, (N_states) ]
variance_match_weight(:) = 1.d0 variance_match_weight(:) = 1.d0
END_PROVIDER END_PROVIDER
subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st) subroutine update_pt2_and_variance_weights(pt2, variance, norm2, N_st)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Updates the PT2- and Variance- matching weights. ! Updates the PT2- and Variance- matching weights.
@ -27,7 +27,7 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
integer, intent(in) :: N_st integer, intent(in) :: N_st
double precision, intent(in) :: pt2(N_st) double precision, intent(in) :: pt2(N_st)
double precision, intent(in) :: variance(N_st) double precision, intent(in) :: variance(N_st)
double precision, intent(in) :: norm(N_st) double precision, intent(in) :: norm2(N_st)
double precision :: avg, rpt2(N_st), element, dt, x double precision :: avg, rpt2(N_st), element, dt, x
integer :: k integer :: k
@ -50,7 +50,7 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
do k=1,N_st do k=1,N_st
! rPT2 ! rPT2
rpt2(k) = pt2(k)/(1.d0 + norm(k)) rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo enddo
avg = sum(pt2(1:N_st)) / dble(N_st) - 1.d-32 ! Avoid future division by zero avg = sum(pt2(1:N_st)) / dble(N_st) - 1.d-32 ! Avoid future division by zero
@ -179,7 +179,7 @@ subroutine get_mask_phase(det1, pm, Nint)
end subroutine end subroutine
subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset) subroutine select_connected(i_generator,E0,pt2,variance,norm2,b,subset,csubset)
use bitmasks use bitmasks
use selection_types use selection_types
implicit none implicit none
@ -187,7 +187,7 @@ subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset)
type(selection_buffer), intent(inout) :: b type(selection_buffer), intent(inout) :: b
double precision, intent(inout) :: pt2(N_states) double precision, intent(inout) :: pt2(N_states)
double precision, intent(inout) :: variance(N_states) double precision, intent(inout) :: variance(N_states)
double precision, intent(inout) :: norm(N_states) double precision, intent(inout) :: norm2(N_states)
integer :: k,l integer :: k,l
double precision, intent(in) :: E0(N_states) double precision, intent(in) :: E0(N_states)
@ -205,7 +205,7 @@ subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset)
particle_mask(k,1) = iand(generators_bitmask(k,1,s_part), not(psi_det_generators(k,1,i_generator)) ) particle_mask(k,1) = iand(generators_bitmask(k,1,s_part), not(psi_det_generators(k,1,i_generator)) )
particle_mask(k,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) ) particle_mask(k,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) )
enddo enddo
call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,variance,norm,b,subset,csubset) call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,variance,norm2,b,subset,csubset)
deallocate(fock_diag_tmp) deallocate(fock_diag_tmp)
end subroutine end subroutine
@ -254,7 +254,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
end end
subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,variance,norm,buf,subset,csubset) subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,variance,norm2,buf,subset,csubset)
use bitmasks use bitmasks
use selection_types use selection_types
implicit none implicit none
@ -268,7 +268,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
double precision, intent(in) :: E0(N_states) double precision, intent(in) :: E0(N_states)
double precision, intent(inout) :: pt2(N_states) double precision, intent(inout) :: pt2(N_states)
double precision, intent(inout) :: variance(N_states) double precision, intent(inout) :: variance(N_states)
double precision, intent(inout) :: norm(N_states) double precision, intent(inout) :: norm2(N_states)
type(selection_buffer), intent(inout) :: buf type(selection_buffer), intent(inout) :: buf
integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,sze integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,sze
@ -644,9 +644,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
if(.not.pert_2rdm)then if(.not.pert_2rdm)then
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf) call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm2, mat, buf)
else else
call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0)) call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm2, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0))
endif endif
end if end if
enddo enddo
@ -664,7 +664,7 @@ end subroutine
subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf) subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm2, mat, buf)
use bitmasks use bitmasks
use selection_types use selection_types
implicit none implicit none
@ -676,7 +676,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
double precision, intent(in) :: E0(N_states) double precision, intent(in) :: E0(N_states)
double precision, intent(inout) :: pt2(N_states) double precision, intent(inout) :: pt2(N_states)
double precision, intent(inout) :: variance(N_states) double precision, intent(inout) :: variance(N_states)
double precision, intent(inout) :: norm(N_states) double precision, intent(inout) :: norm2(N_states)
type(selection_buffer), intent(inout) :: buf type(selection_buffer), intent(inout) :: buf
logical :: ok logical :: ok
integer :: s1, s2, p1, p2, ib, j, istate integer :: s1, s2, p1, p2, ib, j, istate
@ -787,7 +787,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
endif endif
pt2(istate) = pt2(istate) + e_pert pt2(istate) = pt2(istate) + e_pert
variance(istate) = variance(istate) + alpha_h_psi * alpha_h_psi variance(istate) = variance(istate) + alpha_h_psi * alpha_h_psi
norm(istate) = norm(istate) + coef * coef norm2(istate) = norm2(istate) + coef * coef
!!!DEBUG !!!DEBUG
! pt2(istate) = pt2(istate) - e_pert + alpha_h_psi**2/delta_E ! pt2(istate) = pt2(istate) - e_pert + alpha_h_psi**2/delta_E

26
src/cipsi/stochastic_cipsi.irp.f
View File

@ -4,13 +4,13 @@ subroutine run_stochastic_cipsi
! Selected Full Configuration Interaction with Stochastic selection and PT2. ! Selected Full Configuration Interaction with Stochastic selection and PT2.
END_DOC END_DOC
integer :: i,j,k integer :: i,j,k
double precision, allocatable :: pt2(:), variance(:), norm(:), rpt2(:), zeros(:) double precision, allocatable :: pt2(:), variance(:), norm2(:), rpt2(:), zeros(:)
integer :: to_select integer :: to_select
logical, external :: qp_stop logical, external :: qp_stop
double precision :: rss double precision :: rss
double precision, external :: memory_of_double double precision, external :: memory_of_double
PROVIDE H_apply_buffer_allocated PROVIDE H_apply_buffer_allocated
N_iter = 1 N_iter = 1
threshold_generators = 1.d0 threshold_generators = 1.d0
@ -19,7 +19,7 @@ subroutine run_stochastic_cipsi
rss = memory_of_double(N_states)*4.d0 rss = memory_of_double(N_states)*4.d0
call check_mem(rss,irp_here) call check_mem(rss,irp_here)
allocate (pt2(N_states), zeros(N_states), rpt2(N_states), norm(N_states), variance(N_states)) allocate (pt2(N_states), zeros(N_states), rpt2(N_states), norm2(N_states), variance(N_states))
double precision :: hf_energy_ref double precision :: hf_energy_ref
logical :: has logical :: has
@ -30,7 +30,7 @@ subroutine run_stochastic_cipsi
zeros = 0.d0 zeros = 0.d0
pt2 = -huge(1.e0) pt2 = -huge(1.e0)
rpt2 = -huge(1.e0) rpt2 = -huge(1.e0)
norm = 0.d0 norm2 = 0.d0
variance = huge(1.e0) variance = huge(1.e0)
if (s2_eig) then if (s2_eig) then
@ -77,12 +77,12 @@ subroutine run_stochastic_cipsi
pt2 = 0.d0 pt2 = 0.d0
variance = 0.d0 variance = 0.d0
norm = 0.d0 norm2 = 0.d0
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
norm, to_select) ! Stochastic PT2 and selection norm2, to_select) ! Stochastic PT2 and selection
do k=1,N_states do k=1,N_states
rpt2(k) = pt2(k)/(1.d0 + norm(k)) rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo enddo
correlation_energy_ratio = (psi_energy_with_nucl_rep(1) - hf_energy_ref) / & correlation_energy_ratio = (psi_energy_with_nucl_rep(1) - hf_energy_ref) / &
@ -90,7 +90,7 @@ subroutine run_stochastic_cipsi
correlation_energy_ratio = min(1.d0,correlation_energy_ratio) correlation_energy_ratio = min(1.d0,correlation_energy_ratio)
call write_double(6,correlation_energy_ratio, 'Correlation ratio') call write_double(6,correlation_energy_ratio, 'Correlation ratio')
call print_summary(psi_energy_with_nucl_rep,pt2,error,variance,norm,N_det,N_occ_pattern,N_states,psi_s2) call print_summary(psi_energy_with_nucl_rep,pt2,error,variance,norm2,N_det,N_occ_pattern,N_states,psi_s2)
call save_energy(psi_energy_with_nucl_rep, rpt2) call save_energy(psi_energy_with_nucl_rep, rpt2)
@ -111,7 +111,7 @@ subroutine run_stochastic_cipsi
call diagonalize_CI call diagonalize_CI
call save_wavefunction call save_wavefunction
call save_energy(psi_energy_with_nucl_rep, zeros) call save_energy(psi_energy_with_nucl_rep, zeros)
if (qp_stop()) exit if (qp_stop()) exit
enddo enddo
if (.not.qp_stop()) then if (.not.qp_stop()) then
@ -123,16 +123,16 @@ subroutine run_stochastic_cipsi
pt2(:) = 0.d0 pt2(:) = 0.d0
variance(:) = 0.d0 variance(:) = 0.d0
norm(:) = 0.d0 norm2(:) = 0.d0
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, & call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
norm,0) ! Stochastic PT2 norm2,0) ! Stochastic PT2
do k=1,N_states do k=1,N_states
rpt2(k) = pt2(k)/(1.d0 + norm(k)) rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo enddo
call save_energy(psi_energy_with_nucl_rep, rpt2) call save_energy(psi_energy_with_nucl_rep, rpt2)
call print_summary(psi_energy_with_nucl_rep(1:N_states),pt2,error,variance,norm,N_det,N_occ_pattern,N_states,psi_s2) call print_summary(psi_energy_with_nucl_rep(1:N_states),pt2,error,variance,norm2,N_det,N_occ_pattern,N_states,psi_s2)
call save_iterations(psi_energy_with_nucl_rep(1:N_states),rpt2,N_det) call save_iterations(psi_energy_with_nucl_rep(1:N_states),rpt2,N_det)
call print_extrapolated_energy() call print_extrapolated_energy()
endif endif

28
src/cipsi/zmq_selection.irp.f
View File

@ -1,4 +1,4 @@
subroutine ZMQ_selection(N_in, pt2, variance, norm) subroutine ZMQ_selection(N_in, pt2, variance, norm2)
use f77_zmq use f77_zmq
use selection_types use selection_types
@ -11,7 +11,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
integer, external :: omp_get_thread_num integer, external :: omp_get_thread_num
double precision, intent(out) :: pt2(N_states) double precision, intent(out) :: pt2(N_states)
double precision, intent(out) :: variance(N_states) double precision, intent(out) :: variance(N_states)
double precision, intent(out) :: norm(N_states) double precision, intent(out) :: norm2(N_states)
! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators ! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators
@ -112,10 +112,10 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
enddo enddo
endif endif
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1) !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm2) PRIVATE(i) NUM_THREADS(nproc_target+1)
i = omp_get_thread_num() i = omp_get_thread_num()
if (i==0) then if (i==0) then
call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm2)
else else
call selection_slave_inproc(i) call selection_slave_inproc(i)
endif endif
@ -124,7 +124,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
do i=N_det+1,N_states do i=N_det+1,N_states
pt2(i) = 0.d0 pt2(i) = 0.d0
variance(i) = 0.d0 variance(i) = 0.d0
norm(i) = 0.d0 norm2(i) = 0.d0
enddo enddo
if (N_in > 0) then if (N_in > 0) then
if (s2_eig) then if (s2_eig) then
@ -136,10 +136,10 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
do k=1,N_states do k=1,N_states
pt2(k) = pt2(k) * f(k) pt2(k) = pt2(k) * f(k)
variance(k) = variance(k) * f(k) variance(k) = variance(k) * f(k)
norm(k) = norm(k) * f(k) norm2(k) = norm2(k) * f(k)
enddo enddo
call update_pt2_and_variance_weights(pt2, variance, norm, N_states) call update_pt2_and_variance_weights(pt2, variance, norm2, N_states)
end subroutine end subroutine
@ -151,7 +151,7 @@ subroutine selection_slave_inproc(i)
call run_selection_slave(1,i,pt2_e0_denominator) call run_selection_slave(1,i,pt2_e0_denominator)
end end
subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm) subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm2)
use f77_zmq use f77_zmq
use selection_types use selection_types
use bitmasks use bitmasks
@ -163,10 +163,10 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
integer, intent(in) :: N integer, intent(in) :: N
double precision, intent(out) :: pt2(N_states) double precision, intent(out) :: pt2(N_states)
double precision, intent(out) :: variance(N_states) double precision, intent(out) :: variance(N_states)
double precision, intent(out) :: norm(N_states) double precision, intent(out) :: norm2(N_states)
double precision :: pt2_mwen(N_states) double precision :: pt2_mwen(N_states)
double precision :: variance_mwen(N_states) double precision :: variance_mwen(N_states)
double precision :: norm_mwen(N_states) double precision :: norm2_mwen(N_states)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket
@ -192,16 +192,16 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
more = 1 more = 1
pt2(:) = 0d0 pt2(:) = 0d0
variance(:) = 0.d0 variance(:) = 0.d0
norm(:) = 0.d0 norm2(:) = 0.d0
pt2_mwen(:) = 0.d0 pt2_mwen(:) = 0.d0
variance_mwen(:) = 0.d0 variance_mwen(:) = 0.d0
norm_mwen(:) = 0.d0 norm2_mwen(:) = 0.d0
do while (more == 1) do while (more == 1)
call pull_selection_results(zmq_socket_pull, pt2_mwen, variance_mwen, norm_mwen, b2%val(1), b2%det(1,1,1), b2%cur, task_id, ntask) call pull_selection_results(zmq_socket_pull, pt2_mwen, variance_mwen, norm2_mwen, b2%val(1), b2%det(1,1,1), b2%cur, task_id, ntask)
pt2(:) += pt2_mwen(:) pt2(:) += pt2_mwen(:)
variance(:) += variance_mwen(:) variance(:) += variance_mwen(:)
norm(:) += norm_mwen(:) norm2(:) += norm2_mwen(:)
do i=1, b2%cur do i=1, b2%cur
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i)) call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
if (b2%val(i) > b%mini) exit if (b2%val(i) > b%mini) exit

10
src/fci/pt2.irp.f
View File

@ -36,7 +36,7 @@ subroutine run
integer :: n_det_before, to_select integer :: n_det_before, to_select
double precision :: threshold_davidson_in double precision :: threshold_davidson_in
double precision :: E_CI_before(N_states), relative_error, error(N_states), variance(N_states), norm(N_states), rpt2(N_states) double precision :: E_CI_before(N_states), relative_error, error(N_states), variance(N_states), norm2(N_states), rpt2(N_states)
pt2(:) = 0.d0 pt2(:) = 0.d0
@ -45,16 +45,16 @@ subroutine run
if (do_pt2) then if (do_pt2) then
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, & call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
norm,0) ! Stochastic PT2 norm2,0) ! Stochastic PT2
else else
call ZMQ_selection(0, pt2, variance, norm) call ZMQ_selection(0, pt2, variance, norm2)
endif endif
do k=1,N_states do k=1,N_states
rpt2(k) = pt2(k)/(1.d0 + norm(k)) rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo enddo
call print_summary(psi_energy_with_nucl_rep(1:N_states),pt2,error,variance,norm,N_det,N_occ_pattern,N_states,psi_s2) call print_summary(psi_energy_with_nucl_rep(1:N_states),pt2,error,variance,norm2,N_det,N_occ_pattern,N_states,psi_s2)
call save_energy(E_CI_before,pt2) call save_energy(E_CI_before,pt2)
end end