diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 75334adc..927ac241 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -681,9 +681,10 @@ let run ~port = in (** Debug input *) - Printf.sprintf "%d %d : %s\n%!" + Printf.sprintf "q:%d r:%d n:%d : %s\n%!" (Queuing_system.number_of_queued program_state.queue) (Queuing_system.number_of_running program_state.queue) + (Queuing_system.number program_state.queue) (Message.to_string message) |> debug; diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f index f45da233..02461ee3 100644 --- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f +++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f @@ -155,6 +155,6 @@ subroutine selection_dressing_slave_inproc(i) implicit none integer, intent(in) :: i - call selection_slaved(1,i) + call selection_slaved(1,i,ci_electronic_energy) end diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index e39ebd6b..5af0e206 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -11,15 +11,16 @@ BEGIN_PROVIDER [ double precision, integral8, (mo_tot_num, mo_tot_num, mo_tot_n END_PROVIDER -subroutine selection_slaved(thread,iproc) +subroutine selection_slaved(thread,iproc,energy) use f77_zmq use selection_types implicit none + double precision, intent(in) :: energy(N_states_diag) integer, intent(in) :: thread, iproc integer :: rc, i - integer :: worker_id, task_id(10), ctask, ltask + integer :: worker_id, task_id(1), ctask, ltask character*(512) :: task integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket @@ -61,7 +62,7 @@ subroutine selection_slaved(thread,iproc) end if !print *, "psi_selectors_coef ", psi_selectors_coef(N_det_selectors-5:N_det_selectors, 1) !call debug_det(psi_selectors(1,1,N_det_selectors), N_int) - call select_connected(i_generator,ci_electronic_energy,pt2,buf) + call select_connected(i_generator,energy,pt2,buf) endif if(done .or. ctask == size(task_id)) then @@ -117,6 +118,8 @@ subroutine push_selection_results(zmq_socket_push, pt2, b, task_id, ntask) rc = f77_zmq_send( zmq_socket_push, task_id(1), ntask*4, 0) if(rc /= 4*ntask) stop "push" +! Activate is zmq_socket_push is a REQ +! rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0) end subroutine @@ -131,23 +134,26 @@ subroutine pull_selection_results(zmq_socket_pull, pt2, val, det, N, task_id, nt integer, intent(out) :: N, ntask, task_id(*) integer :: rc, rn, i - rc = f77_zmq_recv( zmq_socket_pull, N, 4, ZMQ_SNDMORE) + rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0) if(rc /= 4) stop "pull" - rc = f77_zmq_recv( zmq_socket_pull, pt2, N_states*8, ZMQ_SNDMORE) + rc = f77_zmq_recv( zmq_socket_pull, pt2, N_states*8, 0) if(rc /= 8*N_states) stop "pull" - rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, ZMQ_SNDMORE) + rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0) if(rc /= 8*N) stop "pull" - rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, ZMQ_SNDMORE) + rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0) if(rc /= bit_kind*N_int*2*N) stop "pull" - rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, ZMQ_SNDMORE) + rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0) if(rc /= 4) stop "pull" rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0) if(rc /= 4*ntask) stop "pull" + +! Activate is zmq_socket_pull is a REP +! rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0) end subroutine @@ -293,7 +299,9 @@ subroutine selection_collector(b, pt2) end do do i=1, ntask - if(task_id(i) == 0) stop "Error in collector" + if(task_id(i) == 0) then + print *, "Error in collector" + endif call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more) end do done += ntask @@ -389,7 +397,7 @@ subroutine select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p call create_microlist_single(psi_selectors, i_generator, N_det_selectors, ion_det, microlist, idx_microlist, N_microlist, ptr_microlist, N_int) do j=1, ptr_microlist(mo_tot_num * 2 + 1) - 1 - psi_coef_microlist(j,:) = psi_selectors_coef(idx_microlist(j),:) + psi_coef_microlist(j,:) = psi_selectors_coef_transp(:,idx_microlist(j)) enddo if(ptr_microlist(mo_tot_num * 2 + 1) == 1) then @@ -568,10 +576,10 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p do j=1, ptr_microlist(mo_tot_num * 2 + 1) - 1 - psi_coef_microlist(j,:) = psi_selectors_coef(idx_microlist(j),:) + psi_coef_microlist(j,:) = psi_selectors_coef_transp(:,idx_microlist(j)) enddo do j=1, ptr_tmicrolist(mo_tot_num * 2 + 1) - 1 - psi_coef_tmicrolist(j,:) = psi_selectors_coef(idx_tmicrolist(j),:) + psi_coef_tmicrolist(j,:) = psi_selectors_coef_transp(:,idx_tmicrolist(j)) enddo @@ -1042,7 +1050,7 @@ subroutine create_microlist_double(minilist, i_cur, N_minilist, key_mask, microl !!!! INTEGRAL DRIVEN ! !!!!!!!!!!!!!!!!!!!! call get_d0(minilist(1,1,idx(i)), banned, banned_pair, d0s, key_mask, 1+(nt2-1)/mo_tot_num, 1+(nt-1)/mo_tot_num, & - mod(nt2-1, mo_tot_num)+1, mod(nt-1, mo_tot_num)+1, psi_selectors_coef(idx(i), :)) + mod(nt2-1, mo_tot_num)+1, mod(nt-1, mo_tot_num)+1, psi_selectors_coef_transp(1,idx(i))) ! do j=1, N_states ! do nt2=1, mo_tot_num @@ -1062,7 +1070,7 @@ subroutine create_microlist_double(minilist, i_cur, N_minilist, key_mask, microl end do end do - call get_d1(minilist(1,1,idx(i)), banned, banned_pair, d0s, key_mask, pwen, psi_selectors_coef(idx(i), :)) + call get_d1(minilist(1,1,idx(i)), banned, banned_pair, d0s, key_mask, pwen, psi_selectors_coef_transp(1,idx(i))) ! do k=1, N_states ! do nt2=1, mo_tot_num @@ -1094,6 +1102,7 @@ subroutine get_d1(gen, banned, banned_pair, mat, mask, pwen, coefs) integer :: exc(0:2, 2, 2) logical :: lbanned(mo_tot_num*2) logical :: ok, mono, ab + integer :: tmp_array(4) lbanned = banned !mat = 0d0 @@ -1145,12 +1154,14 @@ subroutine get_d1(gen, banned, banned_pair, mat, mask, pwen, coefs) exc(1, 1, 2) = p(a1) exc(1, 2, sfix) = pfix - call apply_particle(mask, (/0, 0 ,s(i), p(i) /), deth, ok, N_int) + tmp_array = (/0, 0 ,s(i), p(i) /) + call apply_particle(mask, tmp_array, deth, ok, N_int) do j=1,mo_tot_num mwen = j + (sm-1)*mo_tot_num if(lbanned(mwen)) cycle - call apply_particle(deth, (/0,0,sm,j/), det, ok, N_int) + tmp_array = (/0,0,sm,j/) + call apply_particle(deth, tmp_array, det, ok, N_int) if(.not. ok) cycle mono = mwen == pwen(a1) .or. mwen == pwen(a2) @@ -1193,13 +1204,14 @@ subroutine get_d1(gen, banned, banned_pair, mat, mask, pwen, coefs) exc(1, 1, sp) = min(h1, h2) exc(2, 1, sp) = max(h1, h2) - call apply_particle(mask, (/0, 0 ,s(i), p(i) /), deth, ok, N_int) + tmp_array = (/0, 0 ,s(i), p(i) /) + call apply_particle(mask, tmp_array, deth, ok, N_int) do j=1,mo_tot_num if(j == pfix) inv = -inv mwen = j + (sm-1)*mo_tot_num if(lbanned(mwen)) cycle - call apply_particle(deth, (/0,0,sm,j/), det, ok, N_int) + call apply_particle(deth, tmp_array, det, ok, N_int) if(.not. ok) cycle mono = mwen == pwen(a1) .or. mwen == pwen(a2) @@ -1245,6 +1257,7 @@ subroutine get_d0(gen, banned, banned_pair, mat, mask, s1, s2, h1, h2, coefs) integer :: p1, p2, hmi, hma, ns1, ns2, st logical, external :: detEq integer :: exc(0:2, 2, 2), exc2(0:2,2,2) + integer :: tmp_array(4) exc = 0 ! mat_mwen = integral8(:,:,h1,h2) @@ -1268,7 +1281,8 @@ subroutine get_d0(gen, banned, banned_pair, mat, mask, s1, s2, h1, h2, coefs) if(banned(p1 + ns1)) cycle if(p1 == p2) cycle if(banned_pair(p1 + ns1, p2 + ns2)) cycle - call apply_particle(mask, (/s1,p1,s2,p2/), det2, ok, N_int) + tmp_array = (/s1,p1,s2,p2/) + call apply_particle(mask, tmp_array, det2, ok, N_int) if(.not. ok) cycle mono = (hmi == p1 .or. hma == p2 .or. hmi == p2 .or. hma == p1) if(mono) then @@ -1299,7 +1313,8 @@ subroutine get_d0(gen, banned, banned_pair, mat, mask, s1, s2, h1, h2, coefs) do p1=1, mo_tot_num if(banned(p1 + ns1)) cycle if(banned_pair(p1 + ns1, p2 + ns2)) cycle - call apply_particle(mask, (/s1,p1,s2,p2/), det2, ok, N_int) + tmp_array = (/s1,p1,s2,p2/) + call apply_particle(mask, tmp_array, det2, ok, N_int) if(.not. ok) cycle mono = (h1 == p1 .or. h2 == p2) if(mono) then diff --git a/plugins/Full_CI_ZMQ/selection_slave.irp.f b/plugins/Full_CI_ZMQ/selection_slave.irp.f index a09e1bf2..bdb76db4 100644 --- a/plugins/Full_CI_ZMQ/selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/selection_slave.irp.f @@ -40,22 +40,7 @@ subroutine run_wf 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,size(energy)) - integer :: j,k - do j=1,N_states_diag - do k=1,N_det - CI_eigenvectors(k,j) = psi_coef(k,j) - enddo - call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),CI_eigenvectors_s2(j)) - enddo - if (.True.) then - do k=1,size(ci_electronic_energy) - ci_electronic_energy(k) = energy(k) - enddo - TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors - endif - - call write_double(6,ci_energy,'Energy') + call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag) integer :: rc, i @@ -64,16 +49,39 @@ subroutine run_wf !$OMP PARALLEL PRIVATE(i) i = omp_get_thread_num() - call selection_dressing_slave_tcp(i) + call selection_dressing_slave_tcp(i, energy) !$OMP END PARALLEL end do end - -subroutine selection_dressing_slave_tcp(i) +subroutine update_energy(energy) implicit none - integer, intent(in) :: i + double precision, intent(in) :: energy(N_states_diag) + BEGIN_DOC +! Update energy when it is received from ZMQ + END_DOC + integer :: j,k + do j=1,N_states_diag + do k=1,N_det + CI_eigenvectors(k,j) = psi_coef(k,j) + enddo + call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),CI_eigenvectors_s2(j)) + enddo + if (.True.) then + do k=1,size(ci_electronic_energy) + ci_electronic_energy(k) = energy(k) + enddo + TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors + endif - call selection_slaved(0,i) + call write_double(6,ci_energy,'Energy') +end + +subroutine selection_dressing_slave_tcp(i,energy) + implicit none + double precision, intent(in) :: energy(N_states_diag) + integer, intent(in) :: i + + call selection_slaved(0,i,energy) end diff --git a/plugins/Selectors_full/selectors.irp.f b/plugins/Selectors_full/selectors.irp.f index 826dcc4b..6fbad9ec 100644 --- a/plugins/Selectors_full/selectors.irp.f +++ b/plugins/Selectors_full/selectors.irp.f @@ -48,7 +48,21 @@ END_PROVIDER enddo END_PROVIDER - BEGIN_PROVIDER [ double precision, psi_selectors_diag_h_mat, (psi_selectors_size) ] +BEGIN_PROVIDER [ double precision, psi_selectors_coef_transp, (N_states,psi_selectors_size) ] + implicit none + BEGIN_DOC + ! Transposed psi_selectors + END_DOC + integer :: i,k + + do i=1,N_det_selectors + do k=1,N_states + psi_selectors_coef_transp(k,i) = psi_selectors_coef(i,k) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ double precision, psi_selectors_diag_h_mat, (psi_selectors_size) ] implicit none BEGIN_DOC ! Diagonal elements of the H matrix for each selectors @@ -58,6 +72,6 @@ END_PROVIDER do i = 1, N_det_selectors psi_selectors_diag_h_mat(i) = diag_H_mat_elem(psi_selectors(1,1,i),N_int) enddo - END_PROVIDER +END_PROVIDER diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 9fa70d5e..e5a9f8ef 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -145,12 +145,12 @@ function new_zmq_to_qp_run_socket() rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 120000, 4) if (rc /= 0) then - stop 'Unable to set send timout in new_zmq_to_qp_run_socket' + stop 'Unable to set send timeout in new_zmq_to_qp_run_socket' endif rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 120000, 4) if (rc /= 0) then - stop 'Unable to set recv timout in new_zmq_to_qp_run_socket' + stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket' endif rc = f77_zmq_connect(new_zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0))) @@ -247,7 +247,12 @@ function new_zmq_pull_socket() stop 'Unable to set ZMQ_LINGER on pull socket' endif - rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,1000,4) + rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVBUF,100000000,4) + if (rc /= 0) then + stop 'Unable to set ZMQ_RCVBUF on pull socket' + endif + + rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,1,4) if (rc /= 0) then stop 'Unable to set ZMQ_RCVHWM on pull socket' endif @@ -295,11 +300,16 @@ function new_zmq_push_socket(thread) stop 'Unable to set ZMQ_LINGER on push socket' endif - rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,1000,4) + rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,1,4) if (rc /= 0) then stop 'Unable to set ZMQ_SNDHWM on push socket' endif + rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDBUF,100000000,4) + if (rc /= 0) then + stop 'Unable to set ZMQ_RCVBUF on push socket' + endif + rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,1,4) if (rc /= 0) then stop 'Unable to set ZMQ_IMMEDIATE on push socket' @@ -347,6 +357,11 @@ function new_zmq_sub_socket() stop 'Unable to set timeout in new_zmq_sub_socket' endif + rc = f77_zmq_setsockopt(new_zmq_sub_socket,ZMQ_CONFLATE,1,4) + if (rc /= 0) then + stop 'Unable to set conflate in new_zmq_sub_socket' + endif + rc = f77_zmq_setsockopt(new_zmq_sub_socket,ZMQ_SUBSCRIBE,"",0) if (rc /= 0) then stop 'Unable to subscribe new_zmq_sub_socket' @@ -431,7 +446,7 @@ subroutine end_zmq_pull_socket(zmq_socket_pull) ! stop 'error' ! endif - call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922 +! call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922 ! rc = f77_zmq_setsockopt(zmq_socket_pull,ZMQ_LINGER,10000,4) ! if (rc /= 0) then