diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 474412c9..6f012981 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -547,7 +547,6 @@ let terminate program_state rep_socket = let error msg program_state rep_socket = - Printf.printf "%s\n%!" msg; Message.Error (Message.Error_msg.create msg) |> Message.to_string |> ZMQ.Socket.send rep_socket ; diff --git a/plugins/Full_CI_ZMQ/selection_slave.irp.f b/plugins/Full_CI_ZMQ/selection_slave.irp.f index 4c365238..2aba32fe 100644 --- a/plugins/Full_CI_ZMQ/selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/selection_slave.irp.f @@ -23,31 +23,55 @@ subroutine run_wf 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 + character*(64) :: states(2) + integer :: rc, i call provide_everything zmq_context = f77_zmq_ctx_new () - zmq_state = 'selection' - state = 'Waiting' + states(1) = 'selection' + states(2) = 'davidson' zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() do - call wait_for_state(zmq_state,state) - if(trim(state) /= 'selection') exit - print *, 'Getting wave function' - call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag) - + + call wait_for_states(states,zmq_state,2) + + if(trim(zmq_state) == 'Stopped') then + + exit + + else if (trim(zmq_state) == 'selection') then + + ! Selection + ! --------- + + print *, 'Selection' + call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag) - integer :: rc, i - - print *, 'Selection slave running' - - !$OMP PARALLEL PRIVATE(i) - i = omp_get_thread_num() - call selection_dressing_slave_tcp(i, energy) - !$OMP END PARALLEL + !$OMP PARALLEL PRIVATE(i) + i = omp_get_thread_num() + call selection_dressing_slave_tcp(i, energy) + !$OMP END PARALLEL + print *, 'Selection done' + + else if (trim(zmq_state) == 'davidson') then + + ! Davidson + ! -------- + + print *, 'Davidson' + call davidson_miniserver_get() + + !$OMP PARALLEL PRIVATE(i) + i = omp_get_thread_num() + call davidson_slave_tcp(i) + !$OMP END PARALLEL + print *, 'Davidson done' + + endif + end do end diff --git a/src/Davidson/davidson.irp.f b/src/Davidson/davidson.irp.f deleted file mode 100644 index abe3b504..00000000 --- a/src/Davidson/davidson.irp.f +++ /dev/null @@ -1,3 +0,0 @@ -program davidson - stop 1 -end diff --git a/src/Davidson/davidson_slave.irp.f b/src/Davidson/davidson_slave.irp.f index 6cb284a0..b5ec0592 100644 --- a/src/Davidson/davidson_slave.irp.f +++ b/src/Davidson/davidson_slave.irp.f @@ -8,7 +8,7 @@ program davidson_slave double precision :: energy(N_states_diag) character*(64) :: state -! call provide_everything + call provide_everything call switch_qp_run_to_master zmq_context = f77_zmq_ctx_new () @@ -35,6 +35,6 @@ program davidson_slave end do end -! subroutine provide_everything -! PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context -! end subroutine +subroutine provide_everything + PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context +end subroutine diff --git a/src/Davidson/diagonalization_hs2.irp.f b/src/Davidson/diagonalization_hs2.irp.f index 848e83ed..c44a27d2 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/src/Davidson/diagonalization_hs2.irp.f @@ -89,7 +89,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s integer :: i,j,k,l,m logical :: converged - double precision, allocatable :: overlap(:,:) double precision :: u_dot_v, u_dot_u integer, allocatable :: kl_pairs(:,:) @@ -144,14 +143,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s integer, external :: align_double sze_8 = align_double(sze) - double precision :: delta - - if (s2_eig) then - delta = 1.d0 - else - delta = 0.d0 - endif - allocate( & kl_pairs(2,N_st_diag*(N_st_diag+1)/2), & W(sze_8,N_st_diag*davidson_sze_max), & @@ -163,11 +154,20 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s s_(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), & s_tmp(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), & residual_norm(N_st_diag), & - overlap(N_st_diag,N_st_diag), & c(N_st_diag*davidson_sze_max), & s2(N_st_diag*davidson_sze_max), & lambda(N_st_diag*davidson_sze_max)) + h = 0.d0 + s_ = 0.d0 + s_tmp = 0.d0 + c = 0.d0 + U = 0.d0 + S = 0.d0 + R = 0.d0 + y = 0.d0 + + ASSERT (N_st > 0) ASSERT (N_st_diag >= N_st) ASSERT (sze > 0) @@ -425,7 +425,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s deallocate ( & kl_pairs, & W, residual_norm, & - U, overlap, & + U, & R, c, S, & h, & y, s_, s_tmp, & diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index 66c75659..e22fbbf9 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -249,7 +249,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) call davidson_init(handler) do sh=shortcut(0,1),1,-1 workload += (shortcut(sh+1,1) - shortcut(sh,1))**2 - if(workload > 10000) then + if(workload > 1000000) then blocke = sh call davidson_add_task(handler, blocke, blockb) blockb = sh-1 @@ -257,7 +257,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) end if enddo - if(blockb) call davidson_add_task(handler, 1, blockb) + if(blockb > 0) call davidson_add_task(handler, 1, blockb) call davidson_run(handler, v_0, s_0) diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index d7dd8002..3b3c912d 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -881,3 +881,37 @@ end +subroutine wait_for_states(state_wait,state,n) + use f77_zmq + implicit none + BEGIN_DOC +! Wait for the ZMQ state to be ready + END_DOC + integer, intent(in) :: n + character*(64), intent(in) :: state_wait(n) + character*(64), intent(out) :: state + integer(ZMQ_PTR) :: zmq_socket_sub + integer(ZMQ_PTR), external :: new_zmq_sub_socket + integer :: rc, i + logical :: condition + + zmq_socket_sub = new_zmq_sub_socket() + state = 'Waiting' + condition = .True. + do while (condition) + rc = f77_zmq_recv( zmq_socket_sub, state, 64, 0) + if (rc > 0) then + state = trim(state(1:rc)) + else + print *, 'Timeout reached. Stopping' + state = "Stopped" + endif + condition = trim(state) /= 'Stopped' + do i=1,n + condition = condition .and. (trim(state) /= trim(state_wait(i))) + enddo + end do + call end_zmq_sub_socket(zmq_socket_sub) +end + +