From 6d3a801d0e4b06b75e0b8cd4897cbe63c6d5e7f4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2017 16:46:08 +0200 Subject: [PATCH] Parallelization of Davidson --- src/Davidson/davidson_parallel.irp.f | 37 ++++++---------------------- src/Davidson/u0Hu0.irp.f | 4 +-- src/ZMQ/utils.irp.f | 5 ++++ 3 files changed, 14 insertions(+), 32 deletions(-) diff --git a/src/Davidson/davidson_parallel.irp.f b/src/Davidson/davidson_parallel.irp.f index 51863c1e..e11a5fdf 100644 --- a/src/Davidson/davidson_parallel.irp.f +++ b/src/Davidson/davidson_parallel.irp.f @@ -208,13 +208,12 @@ end subroutine -subroutine davidson_collector(zmq_to_qp_run_socket, zmq_socket_pull , v0, s0, LDA) +subroutine davidson_collector(zmq_to_qp_run_socket, v0, s0, LDA) use f77_zmq implicit none integer :: LDA integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull double precision ,intent(inout) :: v0(LDA, N_states_diag) double precision ,intent(inout) :: s0(LDA, N_states_diag) @@ -223,11 +222,14 @@ subroutine davidson_collector(zmq_to_qp_run_socket, zmq_socket_pull , v0, s0, LD double precision, allocatable :: v_0(:,:), s_0(:,:) integer :: i,j + integer(ZMQ_PTR), external :: new_zmq_pull_socket + integer(ZMQ_PTR) :: zmq_socket_pull allocate(v_0(N_det,N_states_diag), s_0(N_det,N_states_diag)) v0 = 0.d0 s0 = 0.d0 more = 1 + zmq_socket_pull = new_zmq_pull_socket() do while (more == 1) call davidson_pull_results(zmq_socket_pull, v_0, s_0, task_id) do j=1,N_states_diag @@ -239,38 +241,13 @@ subroutine davidson_collector(zmq_to_qp_run_socket, zmq_socket_pull , v0, s0, LD call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) end do deallocate(v_0,s_0) - -end subroutine - - -subroutine davidson_run(zmq_to_qp_run_socket , v0, s0, LDA) - use f77_zmq - implicit none - - integer :: LDA - integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_collector - integer(ZMQ_PTR), external :: new_zmq_pull_socket - integer(ZMQ_PTR) :: zmq_socket_pull - - integer :: i - integer, external :: omp_get_thread_num - - double precision , intent(inout) :: v0(LDA, N_states_diag) - double precision , intent(inout) :: s0(LDA, N_states_diag) - - - zmq_collector = new_zmq_to_qp_run_socket() - zmq_socket_pull = new_zmq_pull_socket() - call davidson_collector(zmq_collector, zmq_socket_pull , v0, s0, LDA) - call end_zmq_to_qp_run_socket(zmq_collector) call end_zmq_pull_socket(zmq_socket_pull) end subroutine + subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze_8) use omp_lib use bitmasks @@ -361,7 +338,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze_8) integer :: istep, imin, imax, ishift - istep=1 + istep=2 do imin=1,N_det, 524288 do ishift=0,istep-1 imax = min(N_det, imin+524288-1) @@ -378,7 +355,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze_8) ithread = omp_get_thread_num() if (ithread == 0 ) then call zmq_set_running(zmq_to_qp_run_socket) - call davidson_run(zmq_to_qp_run_socket, v_0, s_0, size(v_0,1)) + call davidson_collector(zmq_to_qp_run_socket, v_0, s_0, size(v_0,1)) else call davidson_slave_inproc(1) endif diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index c17e2b49..ac70ec7a 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -157,7 +157,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif s_t = 0.d0 - !$OMP DO SCHEDULE(static,1) + !$OMP DO SCHEDULE(static,1024) do k_a=istart+ishift,iend,istep krow = psi_bilinear_matrix_rows(k_a) @@ -217,7 +217,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif enddo - !$OMP DO SCHEDULE(static,1) + !$OMP DO SCHEDULE(static,1024) do k_a=istart+ishift,iend,istep diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 91ed9200..e61cf92a 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -445,6 +445,11 @@ subroutine end_zmq_pull_socket(zmq_socket_pull) integer :: rc character*(8), external :: zmq_port + rc = f77_zmq_setsockopt(zmq_socket_pull,ZMQ_LINGER,0,4) + if (rc /= 0) then + stop 'Unable to set ZMQ_LINGER on pull socket' + endif + call omp_set_lock(zmq_lock) rc = f77_zmq_close(zmq_socket_pull) call omp_unset_lock(zmq_lock)