10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-03 12:43:48 +01:00

Updated PT2

This commit is contained in:
Anthony Scemama 2023-02-16 14:15:15 +01:00
parent 8429ff9f76
commit edb1b43563
3 changed files with 20 additions and 33 deletions

View File

@ -70,8 +70,8 @@ subroutine run_cipsi
do while ( & do while ( &
(N_det < N_det_max) .and. & (N_det < N_det_max) .and. &
(sum(abs(pt2_data % pt2(1:N_states)) * state_average_weight(1:N_states)) > pt2_max) .and. & (maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max) .and. &
(sum(abs(pt2_data % variance(1:N_states)) * state_average_weight(1:N_states)) > variance_max) .and. & (maxval(abs(pt2_data % variance(1:N_states))) > variance_max) .and. &
(correlation_energy_ratio <= correlation_energy_ratio_max) & (correlation_energy_ratio <= correlation_energy_ratio_max) &
) )
write(*,'(A)') '--------------------------------------------------------------------------------' write(*,'(A)') '--------------------------------------------------------------------------------'

View File

@ -31,11 +31,12 @@ subroutine run_pt2_slave(thread,iproc,energy)
double precision, intent(in) :: energy(N_states_diag) double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: thread, iproc integer, intent(in) :: thread, iproc
if (N_det > 100000 ) then call run_pt2_slave_large(thread,iproc,energy)
call run_pt2_slave_large(thread,iproc,energy) ! if (N_det > 100000 ) then
else ! call run_pt2_slave_large(thread,iproc,energy)
call run_pt2_slave_small(thread,iproc,energy) ! else
endif ! call run_pt2_slave_small(thread,iproc,energy)
! endif
end end
subroutine run_pt2_slave_small(thread,iproc,energy) subroutine run_pt2_slave_small(thread,iproc,energy)
@ -66,6 +67,7 @@ subroutine run_pt2_slave_small(thread,iproc,energy)
double precision, external :: memory_of_double, memory_of_int double precision, external :: memory_of_double, memory_of_int
integer :: bsize ! Size of selection buffers integer :: bsize ! Size of selection buffers
! logical :: sending
allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max)) allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max))
allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max)) allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max))
@ -162,11 +164,6 @@ end subroutine
subroutine run_pt2_slave_large(thread,iproc,energy) subroutine run_pt2_slave_large(thread,iproc,energy)
use selection_types use selection_types
use f77_zmq use f77_zmq
BEGIN_DOC
! This subroutine can miss important determinants when the PT2 is completely
! computed. It should be called only for large workloads where the PT2 is
! interrupted before the end
END_DOC
implicit none implicit none
double precision, intent(in) :: energy(N_states_diag) double precision, intent(in) :: energy(N_states_diag)
@ -192,12 +189,8 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
integer :: bsize ! Size of selection buffers integer :: bsize ! Size of selection buffers
logical :: sending logical :: sending
double precision :: time_shift
PROVIDE global_selection_buffer global_selection_buffer_lock PROVIDE global_selection_buffer global_selection_buffer_lock
call random_number(time_shift)
time_shift = time_shift*15.d0
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
@ -215,9 +208,6 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
sending = .False. sending = .False.
done = .False. done = .False.
double precision :: time0, time1
call wall_time(time0)
time0 = time0+time_shift
do while (.not.done) do while (.not.done)
integer, external :: get_tasks_from_taskserver integer, external :: get_tasks_from_taskserver
@ -244,28 +234,25 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
ASSERT (b%N == bsize) ASSERT (b%N == bsize)
endif endif
double precision :: time0, time1
call wall_time(time0)
call pt2_alloc(pt2_data,N_states) call pt2_alloc(pt2_data,N_states)
b%cur = 0 b%cur = 0
call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator)) call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator))
call wall_time(time1)
integer, external :: tasks_done_to_taskserver integer, external :: tasks_done_to_taskserver
if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then
done = .true. done = .true.
endif endif
call sort_selection_buffer(b) call sort_selection_buffer(b)
call wall_time(time1)
! if (time1-time0 > 15.d0) then
call omp_set_lock(global_selection_buffer_lock)
global_selection_buffer%mini = b%mini
call merge_selection_buffers(b,global_selection_buffer)
b%cur=0
call omp_unset_lock(global_selection_buffer_lock)
call wall_time(time0)
! endif
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
if ( iproc == 1 .or. i_generator < 100 .or. done) then call omp_set_lock(global_selection_buffer_lock)
global_selection_buffer%mini = b%mini
call merge_selection_buffers(b,global_selection_buffer)
b%cur=0
call omp_unset_lock(global_selection_buffer_lock)
if ( iproc == 1 ) then
call omp_set_lock(global_selection_buffer_lock) call omp_set_lock(global_selection_buffer_lock)
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending)
global_selection_buffer%cur = 0 global_selection_buffer%cur = 0

View File

@ -69,8 +69,8 @@ subroutine run_stochastic_cipsi
do while ( & do while ( &
(N_det < N_det_max) .and. & (N_det < N_det_max) .and. &
(sum(abs(pt2_data % pt2(1:N_states)) * state_average_weight(1:N_states)) > pt2_max) .and. & (maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max) .and. &
(sum(abs(pt2_data % variance(1:N_states)) * state_average_weight(1:N_states)) > variance_max) .and. & (maxval(abs(pt2_data % variance(1:N_states))) > variance_max) .and. &
(correlation_energy_ratio <= correlation_energy_ratio_max) & (correlation_energy_ratio <= correlation_energy_ratio_max) &
) )
write(*,'(A)') '--------------------------------------------------------------------------------' write(*,'(A)') '--------------------------------------------------------------------------------'