LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-30 15:15:38 +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))
norm = 0.d0
double precision :: norm
double precision :: norm2
norm2 = 0.d0
do i=N_det_generators,1,-1
tilde_w(i) = 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
f = 1.d0/norm
f = 1.d0/norm2
tilde_w(:) = tilde_w(:) * f
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 selection_types
@ -118,7 +118,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
! integer, intent(inout) :: N_in
double precision, intent(in) :: relative_error, E(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
@ -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
pt2=0.d0
variance=0.d0
norm=0.d0
call ZMQ_selection(N_in, pt2, variance, norm)
norm2=0.d0
call ZMQ_selection(N_in, pt2, variance, norm2)
error(:) = 0.d0
else
@ -264,7 +264,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
nproc_target * 8.d0 * & ! bytes
( 0.5d0*pt2_n_tasks_max & ! task_id
+ 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*(N_int*2.d0*ii+ ii) & ! 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)', ' Samples Energy Stat. Err Variance Norm Seconds '
print '(A)', ' Samples Energy Stat. Err Variance Norm^2 Seconds '
print '(A)', '========== ================= =========== =============== =============== ================='
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)
error(pt2_stoch_istate) = w(pt2_stoch_istate,2)
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
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
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
@ -352,7 +352,7 @@ subroutine pt2_slave_inproc(i)
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 selection_types
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
double precision, intent(in) :: relative_error, E
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
integer, intent(in) :: N_
@ -421,7 +421,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
pt2(:) = -huge(1.)
error(:) = huge(1.)
variance(:) = huge(1.)
norm(:) = 0.d0
norm2(:) = 0.d0
S(:) = 0d0
S2(:) = 0d0
T2(:) = 0d0
@ -497,7 +497,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
endif
pt2(pt2_stoch_istate) = avg
variance(pt2_stoch_istate) = avg2
norm(pt2_stoch_istate) = avg3
norm2(pt2_stoch_istate) = avg3
call wall_time(time)
! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969)
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
enddo
double precision :: norm
norm = 0.d0
double precision :: norm2
norm2 = 0.d0
do i=N_det_generators,1,-1
norm += tilde_w(i)
norm2 += tilde_w(i)
enddo
tilde_w(:) = tilde_w(:) / norm
tilde_w(:) = tilde_w(:) / norm2
tilde_cW(0) = -1.d0
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
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
BEGIN_DOC
! 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
double precision, intent(in) :: pt2(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
integer :: k
@ -50,7 +50,7 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
do k=1,N_st
! rPT2
rpt2(k) = pt2(k)/(1.d0 + norm(k))
rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo
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
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 selection_types
implicit none
@ -187,7 +187,7 @@ subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset)
type(selection_buffer), intent(inout) :: b
double precision, intent(inout) :: pt2(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
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,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) )
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)
end subroutine
@ -254,7 +254,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
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 selection_types
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(inout) :: pt2(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
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)
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
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
end if
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 selection_types
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(inout) :: pt2(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
logical :: ok
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
pt2(istate) = pt2(istate) + e_pert
variance(istate) = variance(istate) + alpha_h_psi * alpha_h_psi
norm(istate) = norm(istate) + coef * coef
norm2(istate) = norm2(istate) + coef * coef
!!!DEBUG
! 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.
END_DOC
integer :: i,j,k
double precision, allocatable :: pt2(:), variance(:), norm(:), rpt2(:), zeros(:)
double precision, allocatable :: pt2(:), variance(:), norm2(:), rpt2(:), zeros(:)
integer :: to_select
logical, external :: qp_stop
double precision :: rss
double precision, external :: memory_of_double
PROVIDE H_apply_buffer_allocated
PROVIDE H_apply_buffer_allocated
N_iter = 1
threshold_generators = 1.d0
@ -19,7 +19,7 @@ subroutine run_stochastic_cipsi
rss = memory_of_double(N_states)*4.d0
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
logical :: has
@ -30,7 +30,7 @@ subroutine run_stochastic_cipsi
zeros = 0.d0
pt2 = -huge(1.e0)
rpt2 = -huge(1.e0)
norm = 0.d0
norm2 = 0.d0
variance = huge(1.e0)
if (s2_eig) then
@ -77,12 +77,12 @@ subroutine run_stochastic_cipsi
pt2 = 0.d0
variance = 0.d0
norm = 0.d0
norm2 = 0.d0
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
rpt2(k) = pt2(k)/(1.d0 + norm(k))
rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo
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)
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)
@ -111,7 +111,7 @@ subroutine run_stochastic_cipsi
call diagonalize_CI
call save_wavefunction
call save_energy(psi_energy_with_nucl_rep, zeros)
if (qp_stop()) exit
if (qp_stop()) exit
enddo
if (.not.qp_stop()) then
@ -123,16 +123,16 @@ subroutine run_stochastic_cipsi
pt2(:) = 0.d0
variance(:) = 0.d0
norm(:) = 0.d0
norm2(:) = 0.d0
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
rpt2(k) = pt2(k)/(1.d0 + norm(k))
rpt2(k) = pt2(k)/(1.d0 + norm2(k))
enddo
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 print_extrapolated_energy()
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 selection_types
@ -11,7 +11,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
integer, external :: omp_get_thread_num
double precision, intent(out) :: pt2(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
@ -112,10 +112,10 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
enddo
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()
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
call selection_slave_inproc(i)
endif
@ -124,7 +124,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
do i=N_det+1,N_states
pt2(i) = 0.d0
variance(i) = 0.d0
norm(i) = 0.d0
norm2(i) = 0.d0
enddo
if (N_in > 0) then
if (s2_eig) then
@ -136,10 +136,10 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
do k=1,N_states
pt2(k) = pt2(k) * f(k)
variance(k) = variance(k) * f(k)
norm(k) = norm(k) * f(k)
norm2(k) = norm2(k) * f(k)
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
@ -151,7 +151,7 @@ subroutine selection_slave_inproc(i)
call run_selection_slave(1,i,pt2_e0_denominator)
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 selection_types
use bitmasks
@ -163,10 +163,10 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
integer, intent(in) :: N
double precision, intent(out) :: pt2(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 :: 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) :: zmq_to_qp_run_socket
@ -192,16 +192,16 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
more = 1
pt2(:) = 0d0
variance(:) = 0.d0
norm(:) = 0.d0
norm2(:) = 0.d0
pt2_mwen(:) = 0.d0
variance_mwen(:) = 0.d0
norm_mwen(:) = 0.d0
norm2_mwen(:) = 0.d0
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(:)
variance(:) += variance_mwen(:)
norm(:) += norm_mwen(:)
norm2(:) += norm2_mwen(:)
do i=1, b2%cur
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
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
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
@ -45,16 +45,16 @@ subroutine run
if (do_pt2) then
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
norm,0) ! Stochastic PT2
norm2,0) ! Stochastic PT2
else
call ZMQ_selection(0, pt2, variance, norm)
call ZMQ_selection(0, pt2, variance, norm2)
endif
do k=1,N_states
rpt2(k) = pt2(k)/(1.d0 + norm(k))
rpt2(k) = pt2(k)/(1.d0 + norm2(k))
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)
end