mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-12 02:38:31 +02:00
Removed error from type
This commit is contained in:
parent
93fc49000c
commit
e9f1d7576a
@ -6,7 +6,7 @@ subroutine run_cipsi
|
|||||||
! stochastic PT2.
|
! stochastic PT2.
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
type(pt2_type) :: pt2_data
|
type(pt2_type) :: pt2_data, pt2_data_err
|
||||||
double precision, allocatable :: zeros(:)
|
double precision, allocatable :: zeros(:)
|
||||||
integer :: to_select
|
integer :: to_select
|
||||||
logical, external :: qp_stop
|
logical, external :: qp_stop
|
||||||
@ -25,6 +25,7 @@ subroutine run_cipsi
|
|||||||
|
|
||||||
allocate (zeros(N_states))
|
allocate (zeros(N_states))
|
||||||
call pt2_alloc(pt2_data, N_states)
|
call pt2_alloc(pt2_data, N_states)
|
||||||
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
|
|
||||||
double precision :: hf_energy_ref
|
double precision :: hf_energy_ref
|
||||||
logical :: has
|
logical :: has
|
||||||
@ -79,16 +80,19 @@ subroutine run_cipsi
|
|||||||
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
|
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
|
||||||
to_select = max(N_states_diag, to_select)
|
to_select = max(N_states_diag, to_select)
|
||||||
if (do_pt2) then
|
if (do_pt2) then
|
||||||
pt2_data % pt2 = 0.d0
|
call pt2_dealloc(pt2_data)
|
||||||
pt2_data % variance = 0.d0
|
call pt2_dealloc(pt2_data_err)
|
||||||
pt2_data % norm2 = 0.d0
|
call pt2_alloc(pt2_data, N_states)
|
||||||
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
threshold_generators_save = threshold_generators
|
threshold_generators_save = threshold_generators
|
||||||
threshold_generators = 1.d0
|
threshold_generators = 1.d0
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2_data,relative_error, 0) ! Stochastic PT2
|
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2_data,pt2_data_err,relative_error, 0) ! Stochastic PT2
|
||||||
threshold_generators = threshold_generators_save
|
threshold_generators = threshold_generators_save
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
else
|
else
|
||||||
|
call pt2_dealloc(pt2_data)
|
||||||
|
call pt2_alloc(pt2_data, N_states)
|
||||||
call ZMQ_selection(to_select, pt2_data)
|
call ZMQ_selection(to_select, pt2_data)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -98,7 +102,7 @@ subroutine run_cipsi
|
|||||||
|
|
||||||
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, &
|
call print_summary(psi_energy_with_nucl_rep, &
|
||||||
pt2_data, N_det,N_occ_pattern,N_states,psi_s2)
|
pt2_data, pt2_data_err, N_det,N_occ_pattern,N_states,psi_s2)
|
||||||
|
|
||||||
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
||||||
|
|
||||||
@ -130,12 +134,13 @@ subroutine run_cipsi
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
if (do_pt2) then
|
if (do_pt2) then
|
||||||
pt2_data % pt2(:) = 0.d0
|
call pt2_dealloc(pt2_data)
|
||||||
pt2_data % variance(:) = 0.d0
|
call pt2_dealloc(pt2_data_err)
|
||||||
pt2_data % norm2(:) = 0.d0
|
call pt2_alloc(pt2_data, N_states)
|
||||||
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
threshold_generators = 1d0
|
threshold_generators = 1d0
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2_data, relative_error, 0) ! Stochastic PT2
|
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, relative_error, 0) ! Stochastic PT2
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
endif
|
endif
|
||||||
print *, 'N_det = ', N_det
|
print *, 'N_det = ', N_det
|
||||||
@ -145,9 +150,11 @@ subroutine run_cipsi
|
|||||||
|
|
||||||
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
||||||
call print_summary(psi_energy_with_nucl_rep(1:N_states), &
|
call print_summary(psi_energy_with_nucl_rep(1:N_states), &
|
||||||
pt2_data, N_det,N_occ_pattern,N_states,psi_s2)
|
pt2_data, pt2_data_err, N_det,N_occ_pattern,N_states,psi_s2)
|
||||||
call save_iterations(psi_energy_with_nucl_rep(1:N_states),pt2_data % rpt2,N_det)
|
call save_iterations(psi_energy_with_nucl_rep(1:N_states),pt2_data % rpt2,N_det)
|
||||||
call print_extrapolated_energy()
|
call print_extrapolated_energy()
|
||||||
endif
|
endif
|
||||||
|
call pt2_dealloc(pt2_data)
|
||||||
|
call pt2_dealloc(pt2_data_err)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -107,7 +107,7 @@ end function
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine ZMQ_pt2(E, pt2_data, relative_error, N_in)
|
subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
use selection_types
|
use selection_types
|
||||||
|
|
||||||
@ -117,7 +117,7 @@ subroutine ZMQ_pt2(E, pt2_data, relative_error, N_in)
|
|||||||
integer, intent(in) :: N_in
|
integer, intent(in) :: 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)
|
||||||
type(pt2_type), intent(inout) :: pt2_data
|
type(pt2_type), intent(inout) :: pt2_data, pt2_data_err
|
||||||
!
|
!
|
||||||
integer :: i, N
|
integer :: i, N
|
||||||
|
|
||||||
@ -298,13 +298,13 @@ subroutine ZMQ_pt2(E, pt2_data, relative_error, N_in)
|
|||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
if (i==0) then
|
if (i==0) then
|
||||||
|
|
||||||
call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, pt2_data, b, N)
|
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 % 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 % norm2(pt2_stoch_istate))
|
||||||
|
|
||||||
!TODO : We should use here the correct formula for the error of X/Y
|
!TODO : We should use here the correct formula for the error of X/Y
|
||||||
pt2_data % rpt2_err(pt2_stoch_istate) = &
|
pt2_data_err % rpt2(pt2_stoch_istate) = &
|
||||||
pt2_data % pt2_err(pt2_stoch_istate)/(1.d0 + pt2_data % norm2(pt2_stoch_istate))
|
pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % norm2(pt2_stoch_istate))
|
||||||
|
|
||||||
else
|
else
|
||||||
call pt2_slave_inproc(i)
|
call pt2_slave_inproc(i)
|
||||||
@ -346,7 +346,7 @@ subroutine pt2_slave_inproc(i)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, b, N_)
|
subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_err, b, N_)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
use selection_types
|
use selection_types
|
||||||
use bitmasks
|
use bitmasks
|
||||||
@ -355,7 +355,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, b, N_)
|
|||||||
|
|
||||||
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
|
||||||
type(pt2_type), intent(inout) :: pt2_data
|
type(pt2_type), intent(inout) :: pt2_data, pt2_data_err
|
||||||
type(selection_buffer), intent(inout) :: b
|
type(selection_buffer), intent(inout) :: b
|
||||||
integer, intent(in) :: N_
|
integer, intent(in) :: N_
|
||||||
|
|
||||||
@ -414,9 +414,11 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, b, N_)
|
|||||||
|
|
||||||
|
|
||||||
pt2_data % pt2(pt2_stoch_istate) = -huge(1.)
|
pt2_data % pt2(pt2_stoch_istate) = -huge(1.)
|
||||||
pt2_data % pt2_err(pt2_stoch_istate) = huge(1.)
|
pt2_data_err % pt2(pt2_stoch_istate) = huge(1.)
|
||||||
pt2_data % variance(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 % norm2(pt2_stoch_istate) = 0.d0
|
||||||
|
pt2_data_err % norm2(pt2_stoch_istate) = huge(1.)
|
||||||
n = 1
|
n = 1
|
||||||
t = 0
|
t = 0
|
||||||
U = 0
|
U = 0
|
||||||
@ -479,8 +481,8 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, b, N_)
|
|||||||
call pt2_add ( pt2_data_S(p), 1.d0, pt2_data_teeth )
|
call pt2_add ( pt2_data_S(p), 1.d0, pt2_data_teeth )
|
||||||
call pt2_add2( pt2_data_S2(p), 1.d0, pt2_data_teeth )
|
call pt2_add2( pt2_data_S2(p), 1.d0, pt2_data_teeth )
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call pt2_dealloc(pt2_data_teeth)
|
call pt2_dealloc(pt2_data_teeth)
|
||||||
|
|
||||||
avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c)
|
avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c)
|
||||||
avg2 = v0 + pt2_data_S(t) % variance(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) % norm2(pt2_stoch_istate) / dble(c)
|
||||||
@ -498,22 +500,22 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, b, N_)
|
|||||||
if(c > 2) then
|
if(c > 2) then
|
||||||
eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
|
eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
|
||||||
eqt = sqrt(eqt / (dble(c) - 1.5d0))
|
eqt = sqrt(eqt / (dble(c) - 1.5d0))
|
||||||
pt2_data % pt2_err(pt2_stoch_istate) = eqt
|
pt2_data_err % pt2(pt2_stoch_istate) = eqt
|
||||||
|
|
||||||
eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
|
eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability
|
||||||
eqt = sqrt(eqt / (dble(c) - 1.5d0))
|
eqt = sqrt(eqt / (dble(c) - 1.5d0))
|
||||||
pt2_data % variance_err(pt2_stoch_istate) = eqt
|
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 = 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))
|
eqt = sqrt(eqt / (dble(c) - 1.5d0))
|
||||||
pt2_data % norm2_err(pt2_stoch_istate) = eqt
|
pt2_data_err % norm2(pt2_stoch_istate) = eqt
|
||||||
|
|
||||||
|
|
||||||
if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then
|
if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then
|
||||||
time1 = time
|
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, F14.10, 2X, F14.10, 2X, F10.4, A10)', c, avg+E, eqt, avg2, avg3, time-time0, ''
|
||||||
if (stop_now .or. ( &
|
if (stop_now .or. ( &
|
||||||
(do_exit .and. (dabs(pt2_data % pt2_err(pt2_stoch_istate)) / &
|
(do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / &
|
||||||
(1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then
|
(1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then
|
||||||
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
|
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
|
||||||
call sleep(10)
|
call sleep(10)
|
||||||
|
@ -6,27 +6,17 @@ subroutine pt2_alloc(pt2_data,N)
|
|||||||
integer :: k
|
integer :: k
|
||||||
|
|
||||||
allocate(pt2_data % pt2(N) &
|
allocate(pt2_data % pt2(N) &
|
||||||
,pt2_data % pt2_err(N) &
|
|
||||||
,pt2_data % variance(N) &
|
,pt2_data % variance(N) &
|
||||||
,pt2_data % variance_err(N) &
|
|
||||||
,pt2_data % norm2(N) &
|
,pt2_data % norm2(N) &
|
||||||
,pt2_data % norm2_err(N) &
|
|
||||||
,pt2_data % rpt2(N) &
|
,pt2_data % rpt2(N) &
|
||||||
,pt2_data % rpt2_err(N) &
|
|
||||||
,pt2_data % overlap(N,N) &
|
,pt2_data % overlap(N,N) &
|
||||||
,pt2_data % overlap_err(N,N) &
|
|
||||||
)
|
)
|
||||||
|
|
||||||
pt2_data % pt2(:) = 0.d0
|
pt2_data % pt2(:) = 0.d0
|
||||||
pt2_data % pt2_err(:) = 0.d0
|
|
||||||
pt2_data % variance(:) = 0.d0
|
pt2_data % variance(:) = 0.d0
|
||||||
pt2_data % variance_err(:) = 0.d0
|
|
||||||
pt2_data % norm2(:) = 0.d0
|
pt2_data % norm2(:) = 0.d0
|
||||||
pt2_data % norm2_err(:) = 0.d0
|
|
||||||
pt2_data % rpt2(:) = 0.d0
|
pt2_data % rpt2(:) = 0.d0
|
||||||
pt2_data % rpt2_err(:) = 0.d0
|
|
||||||
pt2_data % overlap(:,:) = 0.d0
|
pt2_data % overlap(:,:) = 0.d0
|
||||||
pt2_data % overlap_err(:,:) = 0.d0
|
|
||||||
|
|
||||||
do k=1,N
|
do k=1,N
|
||||||
pt2_data % overlap(k,k) = 1.d0
|
pt2_data % overlap(k,k) = 1.d0
|
||||||
@ -38,15 +28,10 @@ subroutine pt2_dealloc(pt2_data)
|
|||||||
use selection_types
|
use selection_types
|
||||||
type(pt2_type), intent(inout) :: pt2_data
|
type(pt2_type), intent(inout) :: pt2_data
|
||||||
deallocate(pt2_data % pt2 &
|
deallocate(pt2_data % pt2 &
|
||||||
,pt2_data % pt2_err &
|
|
||||||
,pt2_data % variance &
|
,pt2_data % variance &
|
||||||
,pt2_data % variance_err&
|
|
||||||
,pt2_data % norm2 &
|
,pt2_data % norm2 &
|
||||||
,pt2_data % norm2_err &
|
|
||||||
,pt2_data % rpt2 &
|
,pt2_data % rpt2 &
|
||||||
,pt2_data % rpt2_err &
|
|
||||||
,pt2_data % overlap &
|
,pt2_data % overlap &
|
||||||
,pt2_data % overlap_err &
|
|
||||||
)
|
)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
@ -63,28 +48,18 @@ subroutine pt2_add(p1, w, p2)
|
|||||||
if (w == 1.d0) then
|
if (w == 1.d0) then
|
||||||
|
|
||||||
p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:)
|
p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:)
|
||||||
p1 % pt2_err(:) = p1 % pt2_err(:) + p2 % pt2_err(:)
|
|
||||||
p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:)
|
p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:)
|
||||||
p1 % rpt2_err(:) = p1 % rpt2_err(:) + p2 % rpt2_err(:)
|
|
||||||
p1 % variance(:) = p1 % variance(:) + p2 % variance(:)
|
p1 % variance(:) = p1 % variance(:) + p2 % variance(:)
|
||||||
p1 % variance_err(:) = p1 % variance_err(:) + p2 % variance_err(:)
|
|
||||||
p1 % norm2(:) = p1 % norm2(:) + p2 % norm2(:)
|
p1 % norm2(:) = p1 % norm2(:) + p2 % norm2(:)
|
||||||
p1 % norm2_err(:) = p1 % norm2_err(:) + p2 % norm2_err(:)
|
|
||||||
p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:)
|
p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:)
|
||||||
p1 % overlap_err(:,:) = p1 % overlap_err(:,:) + p2 % overlap_err(:,:)
|
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:)
|
p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:)
|
||||||
p1 % pt2_err(:) = p1 % pt2_err(:) + w * p2 % pt2_err(:)
|
|
||||||
p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:)
|
p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:)
|
||||||
p1 % rpt2_err(:) = p1 % rpt2_err(:) + w * p2 % rpt2_err(:)
|
|
||||||
p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:)
|
p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:)
|
||||||
p1 % variance_err(:) = p1 % variance_err(:) + w * p2 % variance_err(:)
|
|
||||||
p1 % norm2(:) = p1 % norm2(:) + w * p2 % norm2(:)
|
p1 % norm2(:) = p1 % norm2(:) + w * p2 % norm2(:)
|
||||||
p1 % norm2_err(:) = p1 % norm2_err(:) + w * p2 % norm2_err(:)
|
|
||||||
p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:)
|
p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:)
|
||||||
p1 % overlap_err(:,:) = p1 % overlap_err(:,:) + w * p2 % overlap_err(:,:)
|
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -104,28 +79,18 @@ subroutine pt2_add2(p1, w, p2)
|
|||||||
if (w == 1.d0) then
|
if (w == 1.d0) then
|
||||||
|
|
||||||
p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:) * p2 % pt2(:)
|
p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:) * p2 % pt2(:)
|
||||||
p1 % pt2_err(:) = p1 % pt2_err(:) + p2 % pt2_err(:) * p2 % pt2_err(:)
|
|
||||||
p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:) * p2 % rpt2(:)
|
p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:) * p2 % rpt2(:)
|
||||||
p1 % rpt2_err(:) = p1 % rpt2_err(:) + p2 % rpt2_err(:) * p2 % rpt2_err(:)
|
|
||||||
p1 % variance(:) = p1 % variance(:) + p2 % variance(:) * p2 % variance(:)
|
p1 % variance(:) = p1 % variance(:) + p2 % variance(:) * p2 % variance(:)
|
||||||
p1 % variance_err(:) = p1 % variance_err(:) + p2 % variance_err(:) * p2 % variance_err(:)
|
|
||||||
p1 % norm2(:) = p1 % norm2(:) + p2 % norm2(:) * p2 % norm2(:)
|
p1 % norm2(:) = p1 % norm2(:) + p2 % norm2(:) * p2 % norm2(:)
|
||||||
p1 % norm2_err(:) = p1 % norm2_err(:) + p2 % norm2_err(:) * p2 % norm2_err(:)
|
|
||||||
p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:) * p2 % overlap(:,:)
|
p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:) * p2 % overlap(:,:)
|
||||||
p1 % overlap_err(:,:) = p1 % overlap_err(:,:) + p2 % overlap_err(:,:) * p2 % overlap_err(:,:)
|
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:) * p2 % pt2(:)
|
p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:) * p2 % pt2(:)
|
||||||
p1 % pt2_err(:) = p1 % pt2_err(:) + w * p2 % pt2_err(:) * p2 % pt2_err(:)
|
|
||||||
p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:) * p2 % rpt2(:)
|
p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:) * p2 % rpt2(:)
|
||||||
p1 % rpt2_err(:) = p1 % rpt2_err(:) + w * p2 % rpt2_err(:) * p2 % rpt2_err(:)
|
|
||||||
p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:) * p2 % variance(:)
|
p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:) * p2 % variance(:)
|
||||||
p1 % variance_err(:) = p1 % variance_err(:) + w * p2 % variance_err(:) * p2 % variance_err(:)
|
|
||||||
p1 % norm2(:) = p1 % norm2(:) + w * p2 % norm2(:) * p2 % norm2(:)
|
p1 % norm2(:) = p1 % norm2(:) + w * p2 % norm2(:) * p2 % norm2(:)
|
||||||
p1 % norm2_err(:) = p1 % norm2_err(:) + w * p2 % norm2_err(:) * p2 % norm2_err(:)
|
|
||||||
p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:) * p2 % overlap(:,:)
|
p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:) * p2 % overlap(:,:)
|
||||||
p1 % overlap_err(:,:) = p1 % overlap_err(:,:) + w * p2 % overlap_err(:,:) * p2 % overlap_err(:,:)
|
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -143,17 +108,14 @@ subroutine pt2_serialize(pt2_data, n, x)
|
|||||||
|
|
||||||
n2 = n*n
|
n2 = n*n
|
||||||
x(1:n) = pt2_data % pt2(1:n)
|
x(1:n) = pt2_data % pt2(1:n)
|
||||||
x(n+1:2*n) = pt2_data % pt2_err(1:n)
|
k=n
|
||||||
x(2*n+1:3*n) = pt2_data % rpt2(1:n)
|
x(k+1:k+n) = pt2_data % rpt2(1:n)
|
||||||
x(3*n+1:4*n) = pt2_data % rpt2_err(1:n)
|
k=k+n
|
||||||
x(4*n+1:5*n) = pt2_data % variance(1:n)
|
x(k+1:k+n) = pt2_data % variance(1:n)
|
||||||
x(5*n+1:6*n) = pt2_data % variance_err(1:n)
|
k=k+n
|
||||||
x(6*n+1:7*n) = pt2_data % norm2(1:n)
|
x(k+1:k+n) = pt2_data % norm2(1:n)
|
||||||
x(7*n+1:8*n) = pt2_data % norm2_err(1:n)
|
k=k+n
|
||||||
k=8*n
|
|
||||||
x(k+1:k+n2) = reshape(pt2_data % overlap(1:n,1:n), (/ n2 /))
|
x(k+1:k+n2) = reshape(pt2_data % overlap(1:n,1:n), (/ n2 /))
|
||||||
k=8*n+n2
|
|
||||||
x(k+1:k+n2) = reshape(pt2_data % overlap_err(1:n,1:n), (/ n2 /))
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -168,16 +130,13 @@ subroutine pt2_deserialize(pt2_data, n, x)
|
|||||||
|
|
||||||
n2 = n*n
|
n2 = n*n
|
||||||
pt2_data % pt2(1:n) = x(1:n)
|
pt2_data % pt2(1:n) = x(1:n)
|
||||||
pt2_data % pt2_err(1:n) = x(n+1:2*n)
|
k=n
|
||||||
pt2_data % rpt2(1:n) = x(2*n+1:3*n)
|
pt2_data % rpt2(1:n) = x(k+1:k+n)
|
||||||
pt2_data % rpt2_err(1:n) = x(3*n+1:4*n)
|
k=k+n
|
||||||
pt2_data % variance(1:n) = x(4*n+1:5*n)
|
pt2_data % variance(1:n) = x(k+1:k+n)
|
||||||
pt2_data % variance_err(1:n) = x(5*n+1:6*n)
|
k=k+n
|
||||||
pt2_data % norm2(1:n) = x(6*n+1:7*n)
|
pt2_data % norm2(1:n) = x(k+1:k+n)
|
||||||
pt2_data % norm2_err(1:n) = x(7*n+1:8*n)
|
k=k+n
|
||||||
k=8*n
|
|
||||||
pt2_data % overlap(1:n,1:n) = reshape(x(k+1:k+n2), (/ n, n /))
|
pt2_data % overlap(1:n,1:n) = reshape(x(k+1:k+n2), (/ n, n /))
|
||||||
k=8*n+n2
|
|
||||||
pt2_data % overlap_err(1:n,1:n) = reshape(x(k+1:k+n2), (/ n, n /))
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -157,6 +157,7 @@ subroutine run_pt2_slave_small(thread,iproc,energy)
|
|||||||
if (buffer_ready) then
|
if (buffer_ready) then
|
||||||
call delete_selection_buffer(b)
|
call delete_selection_buffer(b)
|
||||||
endif
|
endif
|
||||||
|
deallocate(pt2_data)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
@ -171,7 +172,7 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
|
|||||||
|
|
||||||
integer :: worker_id, ctask, ltask
|
integer :: worker_id, ctask, ltask
|
||||||
character*(512) :: task
|
character*(512) :: task
|
||||||
integer :: task_id
|
integer :: task_id(1)
|
||||||
|
|
||||||
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
|
||||||
@ -182,9 +183,9 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
|
|||||||
type(selection_buffer) :: b
|
type(selection_buffer) :: b
|
||||||
logical :: done, buffer_ready
|
logical :: done, buffer_ready
|
||||||
|
|
||||||
type(pt2_type) :: pt2_data
|
type(pt2_type) :: pt2_data(1)
|
||||||
integer :: n_tasks, k, N
|
integer :: n_tasks, k, N
|
||||||
integer :: i_generator, subset
|
integer :: i_generator(1), subset
|
||||||
|
|
||||||
integer :: bsize ! Size of selection buffers
|
integer :: bsize ! Size of selection buffers
|
||||||
logical :: sending
|
logical :: sending
|
||||||
@ -213,13 +214,13 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
|
|||||||
if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then
|
if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
done = task_id == 0
|
done = task_id(1) == 0
|
||||||
if (done) then
|
if (done) then
|
||||||
n_tasks = n_tasks-1
|
n_tasks = n_tasks-1
|
||||||
endif
|
endif
|
||||||
if (n_tasks == 0) exit
|
if (n_tasks == 0) exit
|
||||||
|
|
||||||
read (task,*) subset, i_generator, N
|
read (task,*) subset, i_generator(1), N
|
||||||
if (b%N == 0) then
|
if (b%N == 0) then
|
||||||
! Only first time
|
! Only first time
|
||||||
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
|
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
|
||||||
@ -231,11 +232,11 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
|
|||||||
|
|
||||||
double precision :: time0, time1
|
double precision :: time0, time1
|
||||||
call wall_time(time0)
|
call wall_time(time0)
|
||||||
call pt2_alloc(pt2_data,N_states)
|
call pt2_alloc(pt2_data(1),N_states)
|
||||||
b%cur = 0
|
b%cur = 0
|
||||||
!double precision :: time2
|
!double precision :: time2
|
||||||
!call wall_time(time2)
|
!call wall_time(time2)
|
||||||
call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator))
|
call select_connected(i_generator(1),energy,pt2_data(1),b,subset,pt2_F(i_generator(1)))
|
||||||
!call wall_time(time1)
|
!call wall_time(time1)
|
||||||
!print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1))
|
!print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1))
|
||||||
call wall_time(time1)
|
call wall_time(time1)
|
||||||
@ -261,7 +262,7 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
|
|||||||
call push_pt2_results_async_send(zmq_socket_push, i_generator, pt2_data, b, task_id, n_tasks,sending)
|
call push_pt2_results_async_send(zmq_socket_push, i_generator, pt2_data, b, task_id, n_tasks,sending)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
call pt2_dealloc(pt2_data)
|
call pt2_dealloc(pt2_data(1))
|
||||||
end do
|
end do
|
||||||
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
||||||
|
|
||||||
|
@ -101,11 +101,11 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
call sort_selection_buffer(buf)
|
call sort_selection_buffer(buf)
|
||||||
! call merge_selection_buffers(buf,buf2)
|
! call merge_selection_buffers(buf,buf2)
|
||||||
call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask)
|
call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask)
|
||||||
call pt2_dealloc(pt2_data)
|
|
||||||
! buf%mini = buf2%mini
|
! buf%mini = buf2%mini
|
||||||
buf%cur = 0
|
buf%cur = 0
|
||||||
end if
|
end if
|
||||||
ctask = 0
|
ctask = 0
|
||||||
|
call pt2_dealloc(pt2_data)
|
||||||
|
|
||||||
integer, external :: disconnect_from_taskserver
|
integer, external :: disconnect_from_taskserver
|
||||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||||
@ -121,7 +121,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntask)
|
subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntasks)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
@ -129,9 +129,9 @@ subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntask)
|
|||||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
type(pt2_type), intent(in) :: pt2_data
|
type(pt2_type), intent(in) :: pt2_data
|
||||||
type(selection_buffer), intent(inout) :: b
|
type(selection_buffer), intent(inout) :: b
|
||||||
integer, intent(in) :: ntask, task_id(*)
|
integer, intent(in) :: ntasks, task_id(*)
|
||||||
integer :: rc
|
integer :: rc
|
||||||
double precision, allocatable :: pt2_serialized(:,:)
|
double precision, allocatable :: pt2_serialized(:)
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) then
|
if(rc /= 4) then
|
||||||
@ -139,13 +139,10 @@ subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntask)
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) )
|
allocate(pt2_serialized (pt2_type_size(N_states)) )
|
||||||
do i=1,n_tasks
|
call pt2_serialize(pt2_data,N_states,pt2_serialized)
|
||||||
call pt2_serialize(pt2_data(i),N_states,pt2_serialized(1,i))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE)
|
||||||
deallocate(pt2_serialized)
|
|
||||||
if (rc == -1) then
|
if (rc == -1) then
|
||||||
print *, irp_here, ': error sending result'
|
print *, irp_here, ': error sending result'
|
||||||
stop 3
|
stop 3
|
||||||
@ -153,6 +150,7 @@ subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntask)
|
|||||||
else if(rc /= size(pt2_serialized)*8) then
|
else if(rc /= size(pt2_serialized)*8) then
|
||||||
stop 'push'
|
stop 'push'
|
||||||
endif
|
endif
|
||||||
|
deallocate(pt2_serialized)
|
||||||
|
|
||||||
if (b%cur > 0) then
|
if (b%cur > 0) then
|
||||||
|
|
||||||
@ -168,14 +166,14 @@ subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntask)
|
|||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, ntask, 4, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) then
|
if(rc /= 4) then
|
||||||
print *, 'f77_zmq_send( zmq_socket_push, ntask, 4, ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, task_id(1), ntask*4, 0)
|
rc = f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)
|
||||||
if(rc /= 4*ntask) then
|
if(rc /= 4*ntasks) then
|
||||||
print *, 'f77_zmq_send( zmq_socket_push, task_id(1), ntask*4, 0)'
|
print *, 'f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
! Activate is zmq_socket_push is a REQ
|
! Activate is zmq_socket_push is a REQ
|
||||||
@ -192,7 +190,7 @@ IRP_ENDIF
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_id, ntask)
|
subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_id, ntasks)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
@ -200,27 +198,25 @@ subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_i
|
|||||||
type(pt2_type), intent(inout) :: pt2_data
|
type(pt2_type), intent(inout) :: pt2_data
|
||||||
double precision, intent(out) :: val(*)
|
double precision, intent(out) :: val(*)
|
||||||
integer(bit_kind), intent(out) :: det(N_int, 2, *)
|
integer(bit_kind), intent(out) :: det(N_int, 2, *)
|
||||||
integer, intent(out) :: N, ntask, task_id(*)
|
integer, intent(out) :: N, ntasks, task_id(*)
|
||||||
integer :: rc, rn, i
|
integer :: rc, rn, i
|
||||||
double precision, allocatable :: pt2_serialized(:,:)
|
double precision, allocatable :: pt2_serialized(:)
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
|
||||||
if(rc /= 4) then
|
if(rc /= 4) then
|
||||||
print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)'
|
print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) )
|
allocate(pt2_serialized (pt2_type_size(N_states)) )
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized)*n_tasks, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized)*ntasks, 0)
|
||||||
if (rc == -1) then
|
if (rc == -1) then
|
||||||
n_tasks = 1
|
ntasks = 1
|
||||||
task_id(1) = 0
|
task_id(1) = 0
|
||||||
else if(rc /= 8*size(pt2_serialized)) then
|
else if(rc /= 8*size(pt2_serialized)) then
|
||||||
stop 'pull'
|
stop 'pull'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
do i=1,n_tasks
|
call pt2_deserialize(pt2_data,N_states,pt2_serialized)
|
||||||
call pt2_deserialize(pt2_data(i),N_states,pt2_serialized(1,i))
|
|
||||||
enddo
|
|
||||||
deallocate(pt2_serialized)
|
deallocate(pt2_serialized)
|
||||||
|
|
||||||
if (N>0) then
|
if (N>0) then
|
||||||
@ -235,14 +231,14 @@ subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_i
|
|||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)
|
||||||
if(rc /= 4) then
|
if(rc /= 4) then
|
||||||
print *, 'f77_zmq_recv( zmq_socket_pull, ntask, 4, 0)'
|
print *, 'f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)
|
||||||
if(rc /= 4*ntask) then
|
if(rc /= 4*ntasks) then
|
||||||
print *, 'f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0)'
|
print *, 'f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
! Activate is zmq_socket_pull is a REP
|
! Activate is zmq_socket_pull is a REP
|
||||||
|
@ -8,15 +8,10 @@ module selection_types
|
|||||||
|
|
||||||
type pt2_type
|
type pt2_type
|
||||||
double precision, allocatable :: pt2(:)
|
double precision, allocatable :: pt2(:)
|
||||||
double precision, allocatable :: pt2_err(:)
|
|
||||||
double precision, allocatable :: rpt2(:)
|
double precision, allocatable :: rpt2(:)
|
||||||
double precision, allocatable :: rpt2_err(:)
|
|
||||||
double precision, allocatable :: variance(:)
|
double precision, allocatable :: variance(:)
|
||||||
double precision, allocatable :: variance_err(:)
|
|
||||||
double precision, allocatable :: norm2(:)
|
double precision, allocatable :: norm2(:)
|
||||||
double precision, allocatable :: norm2_err(:)
|
|
||||||
double precision, allocatable :: overlap(:,:)
|
double precision, allocatable :: overlap(:,:)
|
||||||
double precision, allocatable :: overlap_err(:,:)
|
|
||||||
endtype
|
endtype
|
||||||
|
|
||||||
contains
|
contains
|
||||||
@ -24,7 +19,7 @@ module selection_types
|
|||||||
integer function pt2_type_size(N)
|
integer function pt2_type_size(N)
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: N
|
integer, intent(in) :: N
|
||||||
pt2_type_size = (8*n + 2*n*n)
|
pt2_type_size = (4*n + n*n)
|
||||||
end function
|
end function
|
||||||
|
|
||||||
end module
|
end module
|
||||||
|
@ -7,7 +7,7 @@ subroutine run_stochastic_cipsi
|
|||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
double precision, allocatable :: zeros(:)
|
double precision, allocatable :: zeros(:)
|
||||||
integer :: to_select
|
integer :: to_select
|
||||||
type(pt2_type) :: pt2_data
|
type(pt2_type) :: pt2_data, pt2_data_err
|
||||||
logical, external :: qp_stop
|
logical, external :: qp_stop
|
||||||
|
|
||||||
|
|
||||||
@ -24,6 +24,7 @@ subroutine run_stochastic_cipsi
|
|||||||
|
|
||||||
allocate (zeros(N_states))
|
allocate (zeros(N_states))
|
||||||
call pt2_alloc(pt2_data, N_states)
|
call pt2_alloc(pt2_data, N_states)
|
||||||
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
|
|
||||||
double precision :: hf_energy_ref
|
double precision :: hf_energy_ref
|
||||||
logical :: has
|
logical :: has
|
||||||
@ -79,10 +80,11 @@ subroutine run_stochastic_cipsi
|
|||||||
to_select = max(N_states_diag, to_select)
|
to_select = max(N_states_diag, to_select)
|
||||||
|
|
||||||
|
|
||||||
pt2_data % pt2 = 0.d0
|
call pt2_dealloc(pt2_data)
|
||||||
pt2_data % variance = 0.d0
|
call pt2_dealloc(pt2_data_err)
|
||||||
pt2_data % norm2 = 0.d0
|
call pt2_alloc(pt2_data, N_states)
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2_data,relative_error,to_select) ! Stochastic PT2 and selection
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
|
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2_data,pt2_data_err,relative_error,to_select) ! Stochastic PT2 and selection
|
||||||
|
|
||||||
correlation_energy_ratio = (psi_energy_with_nucl_rep(1) - hf_energy_ref) / &
|
correlation_energy_ratio = (psi_energy_with_nucl_rep(1) - hf_energy_ref) / &
|
||||||
(psi_energy_with_nucl_rep(1) + pt2_data % rpt2(1) - hf_energy_ref)
|
(psi_energy_with_nucl_rep(1) + pt2_data % rpt2(1) - hf_energy_ref)
|
||||||
@ -90,7 +92,7 @@ subroutine run_stochastic_cipsi
|
|||||||
|
|
||||||
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, &
|
call print_summary(psi_energy_with_nucl_rep, &
|
||||||
pt2_data, N_det,N_occ_pattern,N_states,psi_s2)
|
pt2_data, pt2_data_err, N_det,N_occ_pattern,N_states,psi_s2)
|
||||||
|
|
||||||
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
||||||
|
|
||||||
@ -121,17 +123,19 @@ subroutine run_stochastic_cipsi
|
|||||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
pt2_data % pt2(:) = 0.d0
|
call pt2_dealloc(pt2_data)
|
||||||
pt2_data % variance(:) = 0.d0
|
call pt2_dealloc(pt2_data_err)
|
||||||
pt2_data % norm2(:) = 0.d0
|
call pt2_alloc(pt2_data, N_states)
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2_data, relative_error, 0) ! Stochastic PT2
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
|
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, relative_error, 0) ! Stochastic PT2
|
||||||
|
|
||||||
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
||||||
call print_summary(psi_energy_with_nucl_rep, &
|
call print_summary(psi_energy_with_nucl_rep, &
|
||||||
pt2_data , N_det, N_occ_pattern, N_states, psi_s2)
|
pt2_data , pt2_data_err, N_det, N_occ_pattern, N_states, psi_s2)
|
||||||
call save_iterations(psi_energy_with_nucl_rep(1:N_states),pt2_data % rpt2,N_det)
|
call save_iterations(psi_energy_with_nucl_rep(1:N_states),pt2_data % rpt2,N_det)
|
||||||
call print_extrapolated_energy()
|
call print_extrapolated_energy()
|
||||||
endif
|
endif
|
||||||
call pt2_dealloc(pt2_data)
|
call pt2_dealloc(pt2_data)
|
||||||
|
call pt2_dealloc(pt2_data_err)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -32,29 +32,34 @@ subroutine run
|
|||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
logical, external :: detEq
|
logical, external :: detEq
|
||||||
|
|
||||||
type(pt2_type) :: pt2_data
|
type(pt2_type) :: pt2_data, pt2_data_err
|
||||||
integer :: degree
|
integer :: degree
|
||||||
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
|
double precision :: relative_error
|
||||||
|
double precision, allocatable :: E_CI_before(:)
|
||||||
|
|
||||||
|
allocate ( E_CI_before(N_states))
|
||||||
call pt2_alloc(pt2_data, N_states)
|
call pt2_alloc(pt2_data, N_states)
|
||||||
|
call pt2_alloc(pt2_data_err, N_states)
|
||||||
|
|
||||||
E_CI_before(:) = psi_energy(:) + nuclear_repulsion
|
E_CI_before(:) = psi_energy(:) + nuclear_repulsion
|
||||||
relative_error=PT2_relative_error
|
relative_error=PT2_relative_error
|
||||||
|
|
||||||
if (do_pt2) then
|
if (do_pt2) then
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2_data, relative_error, 0) ! Stochastic PT2
|
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, relative_error, 0) ! Stochastic PT2
|
||||||
else
|
else
|
||||||
call ZMQ_selection(0, pt2_data)
|
call ZMQ_selection(0, pt2_data)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
call print_summary(psi_energy_with_nucl_rep(1:N_states), &
|
call print_summary(psi_energy_with_nucl_rep(1:N_states), &
|
||||||
pt2_data, N_det,N_occ_pattern,N_states,psi_s2)
|
pt2_data, pt2_data_err, N_det,N_occ_pattern,N_states,psi_s2)
|
||||||
|
|
||||||
call save_energy(E_CI_before,pt2_data % pt2)
|
call save_energy(E_CI_before, pt2_data % pt2)
|
||||||
call pt2_dealloc(pt2_data)
|
call pt2_dealloc(pt2_data)
|
||||||
|
call pt2_dealloc(pt2_data_err)
|
||||||
|
deallocate(E_CI_before)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
subroutine print_summary(e_,pt2_data,n_det_,n_occ_pattern_,n_st,s2_)
|
subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_occ_pattern_,n_st,s2_)
|
||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -7,7 +7,7 @@ subroutine print_summary(e_,pt2_data,n_det_,n_occ_pattern_,n_st,s2_)
|
|||||||
|
|
||||||
integer, intent(in) :: n_det_, n_occ_pattern_, n_st
|
integer, intent(in) :: n_det_, n_occ_pattern_, n_st
|
||||||
double precision, intent(in) :: e_(n_st), s2_(n_st)
|
double precision, intent(in) :: e_(n_st), s2_(n_st)
|
||||||
type(pt2_type) , intent(in) :: pt2_data
|
type(pt2_type) , intent(in) :: pt2_data, pt2_data_err
|
||||||
integer :: i, k
|
integer :: i, k
|
||||||
integer :: N_states_p
|
integer :: N_states_p
|
||||||
character*(9) :: pt2_string
|
character*(9) :: pt2_string
|
||||||
@ -44,16 +44,16 @@ subroutine print_summary(e_,pt2_data,n_det_,n_occ_pattern_,n_st,s2_)
|
|||||||
write(*,fmt) '# Excit. (eV)', (e_(1:N_states_p)-e_(1))*27.211396641308d0
|
write(*,fmt) '# Excit. (eV)', (e_(1:N_states_p)-e_(1))*27.211396641308d0
|
||||||
endif
|
endif
|
||||||
write(fmt,*) '(A13,', 2*N_states_p, '(1X,F14.8))'
|
write(fmt,*) '(A13,', 2*N_states_p, '(1X,F14.8))'
|
||||||
write(*,fmt) '# PT2 '//pt2_string, (pt2_data % pt2(k), pt2_data % pt2_err(k), k=1,N_states_p)
|
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 % pt2_err(k)*f(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(*,'(A)') '#'
|
write(*,'(A)') '#'
|
||||||
write(*,fmt) '# E+PT2 ', (e_(k)+pt2_data % pt2(k),pt2_data % pt2_err(k), k=1,N_states_p)
|
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 % pt2_err(k)*f(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)
|
||||||
if (N_states_p > 1) then
|
if (N_states_p > 1) then
|
||||||
write(*,fmt) '# Excit. (au)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1)), &
|
write(*,fmt) '# Excit. (au)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1)), &
|
||||||
dsqrt(pt2_data % pt2_err(k)*pt2_data % pt2_err(k)+pt2_data % pt2_err(1)*pt2_data % pt2_err(1)), k=1,N_states_p)
|
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)
|
||||||
write(*,fmt) '# Excit. (eV)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1))*27.211396641308d0, &
|
write(*,fmt) '# Excit. (eV)', ( (e_(k)+pt2_data % pt2(k)-e_(1)-pt2_data % pt2(1))*27.211396641308d0, &
|
||||||
dsqrt(pt2_data % pt2_err(k)*pt2_data % pt2_err(k)+pt2_data % pt2_err(1)*pt2_data % pt2_err(1))*27.211396641308d0, k=1,N_states_p)
|
dsqrt(pt2_data_err % pt2(k)*pt2_data_err % pt2(k)+pt2_data_err % pt2(1)*pt2_data_err % pt2(1))*27.211396641308d0, k=1,N_states_p)
|
||||||
endif
|
endif
|
||||||
write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))'
|
write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))'
|
||||||
write(*,fmt)
|
write(*,fmt)
|
||||||
@ -70,12 +70,12 @@ subroutine print_summary(e_,pt2_data,n_det_,n_occ_pattern_,n_st,s2_)
|
|||||||
print*,'* State ',k
|
print*,'* State ',k
|
||||||
print *, '< S^2 > = ', s2_(k)
|
print *, '< S^2 > = ', s2_(k)
|
||||||
print *, 'E = ', e_(k)
|
print *, 'E = ', e_(k)
|
||||||
print *, 'Variance = ', pt2_data % variance(k), ' +/- ', pt2_data % variance_err(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 % norm2_err(k) / pt2_data % norm2(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 *, 'PT2 = ', pt2_data % pt2(k), ' +/- ', pt2_data % pt2_err(k)
|
print *, 'PT2 = ', pt2_data % pt2(k), ' +/- ', pt2_data_err % pt2(k)
|
||||||
print *, 'rPT2 = ', pt2_data % pt2(k)*f(k), ' +/- ', pt2_data % rpt2_err(k)
|
print *, 'rPT2 = ', pt2_data % pt2(k)*f(k), ' +/- ', pt2_data_err % rpt2(k)
|
||||||
print *, 'E+PT2 '//pt2_string//' = ', e_(k)+pt2_data % pt2(k), ' +/- ', pt2_data % pt2_err(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 % pt2_err(k)*f(k)
|
print *, 'E+rPT2'//pt2_string//' = ', e_(k)+pt2_data % pt2(k)*f(k), ' +/- ', pt2_data_err % pt2(k)*f(k)
|
||||||
print *, ''
|
print *, ''
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user