LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

Fixed MPI parallelism

This commit is contained in:
Anthony Scemama 2017-11-27 00:09:25 +01:00
parent 514b13bc2f
commit 3aeff1b2b1
8 changed files with 25 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
plugins/Full_CI_ZMQ/pt2_slave.irp.f
View File

@ -47,7 +47,8 @@ subroutine run_wf
! ---------
print *, 'PT2'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
call zmq_get_psi(zmq_to_qp_run_socket,1)
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order

3
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -61,7 +61,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
print *, '========== ================= ================= ================='
call new_parallel_job(zmq_to_qp_run_socket,'pt2')
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
call zmq_put_psi(zmq_to_qp_run_socket,1)
call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator))
call create_selection_buffer(1, 1*2, b)
Ncomb=size(comb)

12
plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f
View File

@ -54,7 +54,8 @@ subroutine run_wf
print *, 'Selection'
if (mpi_master) then
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
call zmq_get_psi(zmq_to_qp_run_socket,1)
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
endif
call mpi_bcast_psi(energy,N_states)
@ -77,11 +78,13 @@ subroutine run_wf
print *, 'Davidson'
if (mpi_master) then
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
call zmq_get_psi(zmq_to_qp_run_socket,1)
call zmq_get_N_states_diag(zmq_to_qp_run_socket,1)
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag)
endif
double precision :: t0, t1
call wall_time(t0)
call mpi_bcast_psi(energy,N_states)
call mpi_bcast_psi(energy,N_states_diag)
call wall_time(t1)
call write_double(6,(t1-t0),'Broadcast time')
@ -104,7 +107,8 @@ subroutine run_wf
print *, 'PT2'
if (mpi_master) then
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
call zmq_get_psi(zmq_to_qp_run_socket,1)
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
endif
call mpi_bcast_psi(energy,N_states)

6
plugins/Full_CI_ZMQ/selection_slave.irp.f
View File

@ -51,7 +51,8 @@ subroutine run_wf
! ---------
print *, 'Selection'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
call zmq_get_psi(zmq_to_qp_run_socket,1)
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
@ -65,7 +66,8 @@ subroutine run_wf
! ---
print *, 'PT2'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
call zmq_get_psi(zmq_to_qp_run_socket,1)
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
logical :: lstop
lstop = .False.

3
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -24,7 +24,8 @@ subroutine ZMQ_selection(N_in, pt2)
PROVIDE psi_bilinear_matrix_transp_order
call new_parallel_job(zmq_to_qp_run_socket,"selection")
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
call zmq_put_psi(zmq_to_qp_run_socket,1)
call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator))
call create_selection_buffer(N, N*2, b)
endif

17
plugins/Selectors_full/zmq.irp.f
View File

@ -1,4 +1,4 @@
subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id)
use f77_zmq
implicit none
BEGIN_DOC
@ -6,10 +6,6 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer, intent(in) :: worker_id
integer, intent(in) :: size_energy
double precision, intent(out) :: energy(size_energy)
integer :: rc
integer*8 :: rc8
character*(256) :: msg
call zmq_put_N_states(zmq_to_qp_run_socket, worker_id)
@ -19,7 +15,6 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
call zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id)
call zmq_put_N_det_generators(zmq_to_qp_run_socket, worker_id)
call zmq_put_N_det_selectors(zmq_to_qp_run_socket, worker_id)
call zmq_put_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size_energy)
end
@ -208,7 +203,7 @@ end
!---------------------------------------------------------------------------
subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id)
use f77_zmq
implicit none
BEGIN_DOC
@ -216,10 +211,6 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer, intent(in) :: worker_id
integer, intent(in) :: size_energy
double precision, intent(out) :: energy(size_energy)
integer :: rc
integer*8 :: rc8
character*(64) :: msg
call zmq_get_N_states(zmq_to_qp_run_socket, worker_id)
@ -237,8 +228,6 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
call zmq_get_N_det_selectors(zmq_to_qp_run_socket, worker_id)
TOUCH N_det_selectors
call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size_energy)
end
@ -271,7 +260,7 @@ subroutine zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
if (rc8 /= N_int*2_8*N_det*bit_kind) then
print *, irp_here, ': Error getting psi_det'
print *, irp_here, ': Error getting psi_det', rc8, N_int*2_8*N_det*bit_kind
stop 'error'
endif

21
src/Davidson/davidson_parallel.irp.f
View File

@ -90,24 +90,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
integer :: ierr
call broadcast_chunks_double(u_t,size(u_t))
call MPI_BCAST (N_st, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_st'
stop -1
endif
if (.not.mpi_master) then
allocate (energy(N_st))
endif
call MPI_BCAST (energy, N_st, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast energy'
stop -1
endif
IRP_ENDIF
! Run tasks
@ -312,9 +295,9 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
energy = 0.d0
call zmq_put_N_states_diag(zmq_to_qp_run_socket, 1)
call zmq_put_psi_det(zmq_to_qp_run_socket, 1)
call zmq_put_psi(zmq_to_qp_run_socket,1)
call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy))
call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'u_t', u_t, size(u_t))
call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'energy', energy, size(energy))
deallocate(u_t)

3
src/Determinants/H_apply_zmq.template.f
View File

@ -33,7 +33,8 @@ subroutine $subroutine($params_main)
call new_parallel_job(zmq_to_qp_run_socket,'$subroutine')
zmq_socket_pair = new_zmq_pair_socket(.True.)
call zmq_put_psi(zmq_to_qp_run_socket,1,energy,size(energy))
call zmq_put_psi(zmq_to_qp_run_socket,1)
call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy))
do i_generator=1,N_det_generators
$skip