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

Removed norm2

Browse Source
This commit is contained in:
Anthony Scemama 2020-08-31 22:39:40 +02:00
parent 47e7e8869a
commit 02a2695827
9 changed files with 45 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/cipsi/cipsi.irp.f
View File

@ -36,7 +36,7 @@ subroutine run_cipsi
zeros = 0.d0
pt2_data % pt2 = -huge(1.e0)
pt2_data % rpt2 = -huge(1.e0)
pt2_data % norm2 = 0.d0
pt2_data % overlap(:,:) = 0.d0
pt2_data % variance = huge(1.e0)
if (s2_eig) then

11
src/cipsi/pert_rdm_providers.irp.f
View File

@ -47,7 +47,7 @@ subroutine fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fo
type(pt2_type), intent(inout) :: pt2_data
type(selection_buffer), intent(inout) :: buf
logical :: ok
integer :: s1, s2, p1, p2, ib, j, istate
integer :: s1, s2, p1, p2, ib, j, istate, jstate
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
double precision :: e_pert, delta_E, val, Hii, sum_e_pert, tmp, alpha_h_psi, coef(N_states)
double precision, external :: diag_H_mat_elem_fock
@ -152,7 +152,14 @@ subroutine fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fo
print*,e_pert,coef,alpha_h_psi
pt2_data % pt2(istate) += e_pert
pt2_data % variance(istate) += alpha_h_psi * alpha_h_psi
pt2_data % norm2(istate) = coef(istate) * coef(istate)
enddo
do istate=1,N_states
alpha_h_psi = mat(istate, p1, p2)
e_pert = coef(istate) * alpha_h_psi
do jstate=1,N_states
pt2_data % overlap(jstate,jstate) = coef(istate) * coef(jstate)
enddo
if (weight_selection /= 5) then
! Energy selection

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

@ -242,8 +242,8 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
mem_collector = 8.d0 * & ! bytes
( 1.d0*pt2_n_tasks_max & ! task_id, index
+ 0.635d0*N_det_generators & ! f,d
+ pt2_n_tasks_max*pt2_type_size(N_states)/8 & ! pt2_data_task
+ N_det_generators*pt2_type_size(N_states)/8 & ! pt2_data_I
+ pt2_n_tasks_max*pt2_type_size(N_states) & ! pt2_data_task
+ N_det_generators*pt2_type_size(N_states) & ! pt2_data_I
+ 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3
+ 1.d0*(N_int*2.d0*N + N) & ! selection buffer
+ 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer
@ -258,7 +258,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, 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, norm2
+ pt2_type_size(N_states)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap
+ 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
@ -300,11 +300,11 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, pt2_data, pt2_data_err, b, N)
pt2_data % rpt2(pt2_stoch_istate) = &
pt2_data % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % norm2(pt2_stoch_istate))
pt2_data % pt2(pt2_stoch_istate)/(1.d0+pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate))
!TODO : We should use here the correct formula for the error of X/Y
pt2_data_err % rpt2(pt2_stoch_istate) = &
pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % norm2(pt2_stoch_istate))
pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate))
else
call pt2_slave_inproc(i)
@ -377,7 +377,8 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
integer, allocatable :: task_id(:)
integer, allocatable :: index(:)
double precision :: v, x, x2, x3, avg, avg2, avg3, eqt, E0, v0, n0
double precision :: v, x, x2, x3, avg, avg2, avg3(N_states), eqt, E0, v0, n0(N_states)
double precision :: eqta(N_states)
double precision :: time, time1, time0
integer, allocatable :: f(:)
@ -417,8 +418,8 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
pt2_data_err % pt2(pt2_stoch_istate) = huge(1.)
pt2_data % variance(pt2_stoch_istate) = huge(1.)
pt2_data_err % variance(pt2_stoch_istate) = huge(1.)
pt2_data % norm2(pt2_stoch_istate) = 0.d0
pt2_data_err % norm2(pt2_stoch_istate) = huge(1.)
pt2_data % overlap(:,pt2_stoch_istate) = 0.d0
pt2_data_err % overlap(:,pt2_stoch_istate) = huge(1.)
n = 1
t = 0
U = 0
@ -437,7 +438,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
n_tasks = 0
E0 = E
v0 = 0.d0
n0 = 0.d0
n0(:) = 0.d0
more = 1
call wall_time(time0)
time1 = time0
@ -457,11 +458,11 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
t=t+1
E0 = 0.d0
v0 = 0.d0
n0 = 0.d0
n0(:) = 0.d0
do i=pt2_n_0(t),1,-1
E0 += pt2_data_I(i) % pt2(pt2_stoch_istate)
v0 += pt2_data_I(i) % variance(pt2_stoch_istate)
n0 += pt2_data_I(i) % norm2(pt2_stoch_istate)
n0(:) += pt2_data_I(i) % overlap(:,pt2_stoch_istate)
end do
else
exit
@ -485,7 +486,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c)
avg2 = v0 + pt2_data_S(t) % variance(pt2_stoch_istate) / dble(c)
avg3 = n0 + pt2_data_S(t) % norm2(pt2_stoch_istate) / dble(c)
avg3(:) = n0(:) + pt2_data_S(t) % overlap(:,pt2_stoch_istate) / dble(c)
if ((avg /= 0.d0) .or. (n == N_det_generators) ) then
do_exit = .true.
endif
@ -494,7 +495,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
endif
pt2_data % pt2(pt2_stoch_istate) = avg
pt2_data % variance(pt2_stoch_istate) = avg2
pt2_data % norm2(pt2_stoch_istate) = avg3
pt2_data % overlap(:,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
@ -506,14 +507,14 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_
eqt = sqrt(eqt / (dble(c) - 1.5d0))
pt2_data_err % variance(pt2_stoch_istate) = eqt
eqt = dabs((pt2_data_S2(t) % norm2(pt2_stoch_istate) / c) - (pt2_data_S(t) % norm2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
eqt = sqrt(eqt / (dble(c) - 1.5d0))
pt2_data_err % norm2(pt2_stoch_istate) = eqt
eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability
eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0))
pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:)
if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then
time1 = time
print '(G10.3, 2X, F16.10, 2X, G10.3, 2X, F14.10, 2X, F14.10, 2X, F10.4, A10)', c, avg+E, eqt, avg2, avg3, time-time0, ''
print '(G10.3, 2X, F16.10, 2X, G10.3, 2X, G14.6, 2X, G14.6, 2X, F10.4, A10)', c, avg+E, eqt, avg2, avg3(pt2_stoch_istate), time-time0, ''
if (stop_now .or. ( &
(do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / &
(1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then

14
src/cipsi/pt2_type.irp.f
View File

@ -7,20 +7,15 @@ subroutine pt2_alloc(pt2_data,N)
allocate(pt2_data % pt2(N) &
,pt2_data % variance(N) &
,pt2_data % norm2(N) &
,pt2_data % rpt2(N) &
,pt2_data % overlap(N,N) &
)
pt2_data % pt2(:) = 0.d0
pt2_data % variance(:) = 0.d0
pt2_data % norm2(:) = 0.d0
pt2_data % rpt2(:) = 0.d0
pt2_data % overlap(:,:) = 0.d0
do k=1,N
pt2_data % overlap(k,k) = 1.d0
enddo
end subroutine
subroutine pt2_dealloc(pt2_data)
@ -29,7 +24,6 @@ subroutine pt2_dealloc(pt2_data)
type(pt2_type), intent(inout) :: pt2_data
deallocate(pt2_data % pt2 &
,pt2_data % variance &
,pt2_data % norm2 &
,pt2_data % rpt2 &
,pt2_data % overlap &
)
@ -50,7 +44,6 @@ subroutine pt2_add(p1, w, p2)
p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:)
p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:)
p1 % variance(:) = p1 % variance(:) + p2 % variance(:)
p1 % norm2(:) = p1 % norm2(:) + p2 % norm2(:)
p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:)
else
@ -58,7 +51,6 @@ subroutine pt2_add(p1, w, p2)
p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:)
p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:)
p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:)
p1 % norm2(:) = p1 % norm2(:) + w * p2 % norm2(:)
p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:)
endif
@ -81,7 +73,6 @@ subroutine pt2_add2(p1, w, p2)
p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:) * p2 % pt2(:)
p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:) * p2 % rpt2(:)
p1 % variance(:) = p1 % variance(:) + p2 % variance(:) * p2 % variance(:)
p1 % norm2(:) = p1 % norm2(:) + p2 % norm2(:) * p2 % norm2(:)
p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:) * p2 % overlap(:,:)
else
@ -89,7 +80,6 @@ subroutine pt2_add2(p1, w, p2)
p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:) * p2 % pt2(:)
p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:) * p2 % rpt2(:)
p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:) * p2 % variance(:)
p1 % norm2(:) = p1 % norm2(:) + w * p2 % norm2(:) * p2 % norm2(:)
p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:) * p2 % overlap(:,:)
endif
@ -113,8 +103,6 @@ subroutine pt2_serialize(pt2_data, n, x)
k=k+n
x(k+1:k+n) = pt2_data % variance(1:n)
k=k+n
x(k+1:k+n) = pt2_data % norm2(1:n)
k=k+n
x(k+1:k+n2) = reshape(pt2_data % overlap(1:n,1:n), (/ n2 /))
end
@ -135,8 +123,6 @@ subroutine pt2_deserialize(pt2_data, n, x)
k=k+n
pt2_data % variance(1:n) = x(k+1:k+n)
k=k+n
pt2_data % norm2(1:n) = x(k+1:k+n)
k=k+n
pt2_data % overlap(1:n,1:n) = reshape(x(k+1:k+n2), (/ n, n /))
end

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

@ -29,7 +29,6 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st)
type(pt2_type), intent(in) :: pt2_data
double precision :: pt2(N_st)
double precision :: variance(N_st)
double precision :: norm2(N_st)
double precision :: avg, element, dt, x
integer :: k
@ -39,7 +38,6 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st)
pt2(:) = pt2_data % pt2(:)
variance(:) = pt2_data % variance(:)
norm2(:) = pt2_data % norm2(:)
if (i_iter == 0) then
allocate(memo_variance(N_st,i_itermax), memo_pt2(N_st,i_itermax))
@ -800,7 +798,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
e_pert = coef(istate) * alpha_h_psi
pt2_data % variance(istate) += alpha_h_psi * alpha_h_psi
pt2_data % norm2(istate) += coef(istate) * coef(istate)
pt2_data % pt2(istate) += e_pert
!!!DEBUG

3
src/cipsi/selection_types.f90
View File

@ -10,7 +10,6 @@ module selection_types
double precision, allocatable :: pt2(:)
double precision, allocatable :: rpt2(:)
double precision, allocatable :: variance(:)
double precision, allocatable :: norm2(:)
double precision, allocatable :: overlap(:,:)
endtype
@ -19,7 +18,7 @@ module selection_types
integer function pt2_type_size(N)
implicit none
integer, intent(in) :: N
pt2_type_size = (4*n + n*n)
pt2_type_size = (3*n + n*n)
end function
end module

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

@ -35,7 +35,7 @@ subroutine run_stochastic_cipsi
zeros = 0.d0
pt2_data % pt2 = -huge(1.e0)
pt2_data % rpt2 = -huge(1.e0)
pt2_data % norm2 = 0.d0
pt2_data % overlap= 0.d0
pt2_data % variance = huge(1.e0)
if (s2_eig) then

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

@ -7,7 +7,7 @@ subroutine ZMQ_selection(N_in, pt2_data)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull
integer, intent(in) :: N_in
type(selection_buffer) :: b
integer :: i, N
integer :: i, l, N
integer, external :: omp_get_thread_num
type(pt2_type), intent(inout) :: pt2_data
@ -131,10 +131,13 @@ subroutine ZMQ_selection(N_in, pt2_data)
do k=1,N_states
pt2_data % pt2(k) = pt2_data % pt2(k) * f(k)
pt2_data % variance(k) = pt2_data % variance(k) * f(k)
pt2_data % norm2(k) = pt2_data % norm2(k) * f(k)
do l=1,N_states
pt2_data % overlap(k,l) = pt2_data % overlap(k,l) * dsqrt(f(k)*f(l))
pt2_data % overlap(l,k) = pt2_data % overlap(l,k) * dsqrt(f(k)*f(l))
enddo
pt2_data % rpt2(k) = &
pt2_data % pt2(k)/(1.d0 + pt2_data % norm2(k))
pt2_data % pt2(k)/(1.d0 + pt2_data % overlap(k,k))
enddo
call update_pt2_and_variance_weights(pt2_data, N_states)
@ -182,6 +185,7 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2_data)
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
call create_selection_buffer(N, N*2, b2)
integer :: k
double precision :: rss
double precision, external :: memory_of_int
rss = memory_of_int(N_det_generators)
@ -190,7 +194,7 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2_data)
more = 1
pt2_data % pt2(:) = 0d0
pt2_data % variance(:) = 0.d0
pt2_data % norm2(:) = 0.d0
pt2_data % overlap(:,:) = 0.d0
call pt2_alloc(pt2_data_tmp,N_states)
do while (more == 1)
call pull_selection_results(zmq_socket_pull, pt2_data_tmp, b2%val(1), b2%det(1,1,1), b2%cur, task_id, ntask)

19
src/iterations/print_summary.irp.f
View File

@ -12,7 +12,6 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_occ_pattern_,n_st,s2_
integer :: N_states_p
character*(9) :: pt2_string
character*(512) :: fmt
double precision :: f(n_st)
if (do_pt2) then
pt2_string = ' '
@ -22,10 +21,6 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_occ_pattern_,n_st,s2_
N_states_p = min(N_det_,n_st)
do i=1,N_states_p
f(i) = 1.d0/(1.d0+pt2_data % norm2(i))
enddo
print *, ''
print '(A,I12)', 'Summary at N_det = ', N_det_
print '(A)', '-----------------------------------'
@ -45,10 +40,10 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_occ_pattern_,n_st,s2_
endif
write(fmt,*) '(A13,', 2*N_states_p, '(1X,F14.8))'
write(*,fmt) '# PT2 '//pt2_string, (pt2_data % pt2(k), pt2_data_err % pt2(k), k=1,N_states_p)
write(*,fmt) '# rPT2'//pt2_string, (pt2_data % pt2(k)*f(k), pt2_data_err % pt2(k)*f(k), k=1,N_states_p)
write(*,fmt) '# rPT2'//pt2_string, (pt2_data % rpt2(k), pt2_data_err % rpt2(k), k=1,N_states_p)
write(*,'(A)') '#'
write(*,fmt) '# E+PT2 ', (e_(k)+pt2_data % pt2(k),pt2_data_err % pt2(k), k=1,N_states_p)
write(*,fmt) '# E+rPT2 ', (e_(k)+pt2_data % pt2(k)*f(k),pt2_data_err % pt2(k)*f(k), k=1,N_states_p)
write(*,fmt) '# E+rPT2 ', (e_(k)+pt2_data % rpt2(k),pt2_data_err % rpt2(k), k=1,N_states_p)
if (N_states_p > 1) then
write(*,fmt) '# Excit. (au)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1)), &
dsqrt(pt2_data_err % pt2(k)*pt2_data_err % pt2(k)+pt2_data_err % pt2(1)*pt2_data_err % pt2(1)), k=1,N_states_p)
@ -71,11 +66,11 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_occ_pattern_,n_st,s2_
print *, '< S^2 > = ', s2_(k)
print *, 'E = ', e_(k)
print *, 'Variance = ', pt2_data % variance(k), ' +/- ', pt2_data_err % variance(k)
print *, 'PT norm = ', dsqrt(pt2_data % norm2(k)), ' +/- ', 0.5d0*dsqrt(pt2_data % norm2(k)) * pt2_data_err % norm2(k) / pt2_data % norm2(k)
print *, 'PT norm = ', dsqrt(pt2_data % overlap(k,k)), ' +/- ', 0.5d0*dsqrt(pt2_data % overlap(k,k)) * pt2_data_err % overlap(k,k) / (pt2_data % overlap(k,k))
print *, 'PT2 = ', pt2_data % pt2(k), ' +/- ', pt2_data_err % pt2(k)
print *, 'rPT2 = ', pt2_data % pt2(k)*f(k), ' +/- ', pt2_data_err % rpt2(k)
print *, 'rPT2 = ', pt2_data % rpt2(k), ' +/- ', pt2_data_err % rpt2(k)
print *, 'E+PT2 '//pt2_string//' = ', e_(k)+pt2_data % pt2(k), ' +/- ', pt2_data_err % pt2(k)
print *, 'E+rPT2'//pt2_string//' = ', e_(k)+pt2_data % pt2(k)*f(k), ' +/- ', pt2_data_err % pt2(k)*f(k)
print *, 'E+rPT2'//pt2_string//' = ', e_(k)+pt2_data % rpt2(k), ' +/- ', pt2_data_err % rpt2(k)
print *, ''
enddo
@ -95,8 +90,8 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_occ_pattern_,n_st,s2_
print *, '-----'
print*, 'Variational + renormalized perturbative Energy difference (au | eV)'
do i=2, N_states_p
print*,'Delta E = ', (e_(i)+ pt2_data % pt2(i)*f(i) - (e_(1) + pt2_data % pt2(1)*f(1))), &
(e_(i)+ pt2_data % pt2(i)*f(i) - (e_(1) + pt2_data % pt2(1)*f(1))) * 27.211396641308d0
print*,'Delta E = ', (e_(i)+ pt2_data % rpt2(i) - (e_(1) + pt2_data % rpt2(1))), &
(e_(i)+ pt2_data % rpt2(i) - (e_(1) + pt2_data % rpt2(1))) * 27.211396641308d0
enddo
endif