mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-25 13:53:49 +01:00
Fixed bug related to ncache
This commit is contained in:
parent
665ece19e5
commit
22b9eb4fb9
@ -181,6 +181,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error)
|
|||||||
endif
|
endif
|
||||||
ipos=1
|
ipos=1
|
||||||
if (ifirst == 0) then
|
if (ifirst == 0) then
|
||||||
|
ifirst=1
|
||||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
print *, irp_here, ': Failed in zmq_set_running'
|
print *, irp_here, ': Failed in zmq_set_running'
|
||||||
endif
|
endif
|
||||||
@ -445,10 +446,11 @@ BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)]
|
|||||||
|
|
||||||
logical, allocatable :: pt2_d(:)
|
logical, allocatable :: pt2_d(:)
|
||||||
integer :: m,l,r,k
|
integer :: m,l,r,k
|
||||||
integer, parameter :: ncache=10000
|
integer :: ncache
|
||||||
integer, allocatable :: ii(:,:)
|
integer, allocatable :: ii(:,:)
|
||||||
double precision :: dt
|
double precision :: dt
|
||||||
|
|
||||||
|
ncache = min(N_det_generators,10000)
|
||||||
allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators))
|
allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators))
|
||||||
|
|
||||||
pt2_R(:) = 0
|
pt2_R(:) = 0
|
||||||
|
@ -1,32 +1,124 @@
|
|||||||
program davidson_slave
|
program selection_slave
|
||||||
use f77_zmq
|
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Helper program to compute the PT2 in distributed mode.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
call omp_set_nested(.false.)
|
||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
read_wf = .False.
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
distributed_davidson = .False.
|
||||||
double precision :: energy(N_states_diag)
|
SOFT_TOUCH read_wf distributed_davidson
|
||||||
character*(64) :: state
|
|
||||||
|
|
||||||
call provide_everything
|
call provide_everything
|
||||||
call switch_qp_run_to_master
|
call switch_qp_run_to_master
|
||||||
call omp_set_nested(.True.)
|
call run_wf
|
||||||
|
|
||||||
zmq_context = f77_zmq_ctx_new ()
|
|
||||||
zmq_state = 'davidson'
|
|
||||||
state = 'Waiting'
|
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
|
||||||
do
|
|
||||||
call wait_for_state(zmq_state,state)
|
|
||||||
if(trim(state) /= "davidson") exit
|
|
||||||
integer :: rc, i
|
|
||||||
print *, 'Davidson slave running'
|
|
||||||
call davidson_slave_tcp(i)
|
|
||||||
end do
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine provide_everything
|
subroutine provide_everything
|
||||||
PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context ref_bitmask_energy
|
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_sorted_bit n_states zmq_context N_states_diag
|
||||||
end subroutine
|
PROVIDE mo_tot_num N_int ci_energy mpi_master zmq_state zmq_context
|
||||||
|
PROVIDE psi_det psi_coef state_average_weight
|
||||||
|
PROVIDE N_det
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run_wf
|
||||||
|
use f77_zmq
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
double precision :: energy(N_states)
|
||||||
|
character*(64) :: states(3)
|
||||||
|
character*(64) :: old_state
|
||||||
|
integer :: rc, i, ierr
|
||||||
|
double precision :: t0, t1
|
||||||
|
|
||||||
|
integer, external :: zmq_get_dvector, zmq_get_N_det_generators
|
||||||
|
integer, external :: zmq_get8_dvector
|
||||||
|
integer, external :: zmq_get_ivector
|
||||||
|
integer, external :: zmq_get_psi, zmq_get_N_det_selectors, zmq_get_psi_bilinear
|
||||||
|
integer, external :: zmq_get_psi_notouch
|
||||||
|
integer, external :: zmq_get_N_states_diag
|
||||||
|
|
||||||
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
|
states(1) = 'davidson'
|
||||||
|
old_state = 'Waiting'
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
PROVIDE psi_det psi_coef state_average_weight mpi_master
|
||||||
|
PROVIDE zmq_state N_det
|
||||||
|
PROVIDE N_states N_states_diag psi_energy
|
||||||
|
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
do
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
call wait_for_states(states,zmq_state,size(states))
|
||||||
|
if (zmq_state(1:64) == old_state(1:64)) then
|
||||||
|
call sleep(1)
|
||||||
|
cycle
|
||||||
|
else
|
||||||
|
old_state(1:64) = zmq_state(1:64)
|
||||||
|
endif
|
||||||
|
print *, trim(zmq_state)
|
||||||
|
endif
|
||||||
|
|
||||||
|
IRP_IF MPI_DEBUG
|
||||||
|
print *, irp_here, mpi_rank
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BCAST (zmq_state, 128, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
print *, irp_here, 'error in broadcast of zmq_state'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
if(zmq_state(1:7) == 'Stopped') then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
if (zmq_state(1:8) == 'davidson') then
|
||||||
|
|
||||||
|
! Davidson
|
||||||
|
! --------
|
||||||
|
|
||||||
|
call wall_time(t0)
|
||||||
|
if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
|
||||||
|
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
|
||||||
|
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) == -1) cycle
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
if (mpi_master) then
|
||||||
|
call write_double(6,(t1-t0),'Broadcast time')
|
||||||
|
endif
|
||||||
|
|
||||||
|
call omp_set_nested(.True.)
|
||||||
|
call davidson_slave_tcp(0)
|
||||||
|
call omp_set_nested(.False.)
|
||||||
|
print *, 'Davidson done'
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
print *, irp_here, 'error in barrier'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
print *, 'All Davidson done'
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end do
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_finalize(ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user