From 22b9eb4fb973ea5cc7f62a9dbc5a9bf44b0e125f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 15 Oct 2018 11:33:10 +0200 Subject: [PATCH] Fixed bug related to ncache --- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 4 +- src/DavidsonUndressed/davidson_slave.irp.f | 140 +++++++++++++++---- 2 files changed, 119 insertions(+), 25 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 728a682d..c94fcdfa 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -181,6 +181,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error) endif ipos=1 if (ifirst == 0) then + ifirst=1 if (zmq_set_running(zmq_to_qp_run_socket) == -1) then print *, irp_here, ': Failed in zmq_set_running' endif @@ -445,10 +446,11 @@ BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)] logical, allocatable :: pt2_d(:) integer :: m,l,r,k - integer, parameter :: ncache=10000 + integer :: ncache integer, allocatable :: ii(:,:) double precision :: dt + ncache = min(N_det_generators,10000) allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators)) pt2_R(:) = 0 diff --git a/src/DavidsonUndressed/davidson_slave.irp.f b/src/DavidsonUndressed/davidson_slave.irp.f index d8143958..ecd4a395 100644 --- a/src/DavidsonUndressed/davidson_slave.irp.f +++ b/src/DavidsonUndressed/davidson_slave.irp.f @@ -1,32 +1,124 @@ -program davidson_slave - use f77_zmq +program selection_slave implicit none + BEGIN_DOC +! Helper program to compute the PT2 in distributed mode. + END_DOC - - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - double precision :: energy(N_states_diag) - character*(64) :: state - + call omp_set_nested(.false.) + read_wf = .False. + distributed_davidson = .False. + SOFT_TOUCH read_wf distributed_davidson call provide_everything call switch_qp_run_to_master - call omp_set_nested(.True.) - - 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 + call run_wf end subroutine provide_everything - PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context ref_bitmask_energy -end subroutine + PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_sorted_bit n_states zmq_context N_states_diag + 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 + +