Parallel bugs fixed

ocaml/TaskServer.ml

@@ -625,7 +625,7 @@ let get_data msg program_state rep_socket =
       let value = 
         match StringHashtbl.find program_state.data key with
         | Some value -> value
-        | None -> ""
+        | None -> "\0"
       in
       Message.GetDataReply (Message.GetDataReply_msg.create ~value)
       |> Message.to_string_list

plugins/Full_CI_ZMQ/pt2_slave.irp.f

@@ -1,82 +0,0 @@
-program pt2_slave
-  implicit none
-  BEGIN_DOC
-! Helper program to compute the PT2 in distributed mode.
-  END_DOC
-
-  read_wf = .False.
-  distributed_davidson = .False.
-  SOFT_TOUCH read_wf distributed_davidson
-  call provide_everything
-  call switch_qp_run_to_master
-  call run_wf
-end
-
-subroutine provide_everything
-  PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
-end
-
-subroutine run_wf
-  use f77_zmq
-  implicit none
-
-  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) :: states(1)
-  integer :: rc, i
-
-  integer, external              :: zmq_get_dvector
-  integer, external              :: zmq_get_psi
-  
-  call provide_everything
-  
-  zmq_context = f77_zmq_ctx_new ()
-  states(1) = 'pt2'
-
-  zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
-
-  do
-
-    call wait_for_states(states,zmq_state,1)
-
-    if(trim(zmq_state) == 'Stopped') then
-
-      exit
-
-    else if (trim(zmq_state) == 'pt2') then
-
-      ! Selection
-      ! ---------
-
-      print *,  'PT2'
-      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) == -1) cycle
-
-      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
-      PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
-      PROVIDE psi_bilinear_matrix_transp_order
-      psi_energy(1:N_states) = energy(1:N_states)
-      TOUCH psi_energy
-
-      !$OMP PARALLEL PRIVATE(i)
-      i = omp_get_thread_num()
-      call pt2_slave_tcp(i, energy)
-      !$OMP END PARALLEL
-      print *,  'PT2 done'
-
-    endif
-
-  end do
-end
-
-subroutine pt2_slave_tcp(i,energy)
-  implicit none
-  double precision, intent(in) :: energy(N_states_diag)
-  integer, intent(in)            :: i
-  logical :: lstop
-  lstop = .False.
-  call run_pt2_slave(0,i,energy,lstop)
-end
-

plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f

@@ -37,10 +37,9 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
     
     state_average_weight_save(:) = state_average_weight(:)
     do pt2_stoch_istate=1,N_states
-      SOFT_TOUCH pt2_stoch_istate
       state_average_weight(:) = 0.d0
       state_average_weight(pt2_stoch_istate) = 1.d0
-      TOUCH state_average_weight 
+      TOUCH state_average_weight pt2_stoch_istate
       
       allocate(pt2_detail(N_states,N_det_generators+1), comb(N_det_generators), computed(N_det_generators), tbc(0:size_tbc))
       sumabove = 0d0
@@ -71,6 +70,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
       integer, external              :: zmq_put_N_det_generators
       integer, external              :: zmq_put_N_det_selectors
       integer, external              :: zmq_put_dvector
+      integer, external              :: zmq_put_ivector
       if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
         stop 'Unable to put psi on ZMQ server'
       endif
@@ -83,6 +83,20 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
       if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
         stop 'Unable to put energy on ZMQ server'
       endif
+      if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',pt2_e0_denominator,size(state_average_weight)) == -1) then
+        stop 'Unable to put state_average_weight on ZMQ server'
+      endif
+      if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then
+        stop 'Unable to put pt2_stoch_istate on ZMQ server'
+      endif
+    if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) then
+      stop 'Unable to put threshold_selectors on ZMQ server'
+    endif
+    if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then
+      stop 'Unable to put threshold_generators on ZMQ server'
+    endif
+
+
       call create_selection_buffer(1, 1*2, b)
       
       integer                        :: ipos

plugins/Full_CI_ZMQ/run_pt2_slave.irp.f

@@ -25,6 +25,12 @@ subroutine run_pt2_slave(thread,iproc,energy)
   integer :: n_tasks, k, n_tasks_max
   integer, allocatable :: i_generator(:), subset(:)
 
+!if (mpi_master) then
+!  do i=1,N_det_generators
+!    print '(I6,X,100(I10,X))' ,i,  psi_det_generators(:,:,i)
+!  enddo
+!endif
+
   n_tasks_max = N_det_generators/100+1
   allocate(task_id(n_tasks_max), task(n_tasks_max))
   allocate(pt2(N_states,n_tasks_max), i_generator(n_tasks_max), subset(n_tasks_max))
@@ -77,8 +83,8 @@ subroutine run_pt2_slave(thread,iproc,energy)
     continue 
   endif 
 
-  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   call end_zmq_push_socket(zmq_socket_push,thread)
+  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   call delete_selection_buffer(buf)
 end subroutine
 

plugins/Full_CI_ZMQ/run_selection_slave.irp.f

@@ -1,5 +1,110 @@
-
 subroutine run_selection_slave(thread,iproc,energy)
+  call run_selection_slave_new(thread,iproc,energy)
+end
+
+subroutine run_selection_slave_new(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, N
+  logical                        :: buffer_ready
+
+  integer                        :: worker_id, ltask
+  character*(512), allocatable   :: task(:)
+  integer, allocatable           :: task_id(:)
+
+  integer(ZMQ_PTR),external      :: new_zmq_to_qp_run_socket
+  integer(ZMQ_PTR)               :: zmq_to_qp_run_socket
+
+  integer(ZMQ_PTR), external     :: new_zmq_push_socket
+  integer(ZMQ_PTR)               :: zmq_socket_push
+
+  type(selection_buffer) :: buf, buf2
+  logical :: done
+
+  double precision,allocatable :: pt2(:,:)
+  integer :: n_tasks, k, n_tasks_max
+  integer, allocatable :: i_generator(:), subset(:)
+
+  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
+  PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
+  PROVIDE psi_bilinear_matrix_transp_order
+
+  buffer_ready = .False.
+  n_tasks_max = N_det_generators/100+1
+  allocate(task_id(n_tasks_max), task(n_tasks_max))
+  allocate(pt2(N_states,n_tasks_max), i_generator(n_tasks_max), subset(n_tasks_max))
+
+  zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
+
+  integer, external :: connect_to_taskserver
+  if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
+    call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+    return
+  endif
+
+  zmq_socket_push      = new_zmq_push_socket(thread)
+
+  buf%N = 0
+  n_tasks = 0
+  call create_selection_buffer(0, 0, buf)
+  done = .False.
+  do while (.not.done)
+
+    n_tasks = min(n_tasks+1,n_tasks_max)
+
+    integer, external :: get_tasks_from_taskserver
+    if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then
+      exit
+    endif
+    done = task_id(n_tasks) == 0
+    if (done) n_tasks = n_tasks-1
+    if (n_tasks == 0) exit
+
+    do k=1,n_tasks
+      read (task(k),*) subset(k), i_generator(k), N
+    enddo
+
+    if(buf%N == 0) then
+        ! Only first time 
+        call create_selection_buffer(N, N*2, buf)
+        call create_selection_buffer(N, N*2, buf2)
+        buffer_ready = .True.
+    endif
+
+    do k=1,n_tasks
+        pt2(:,k) = 0.d0
+        buf%cur = 0
+        call select_connected(i_generator(k),energy,pt2(1,k),buf,subset(k))
+    enddo
+    integer, external :: tasks_done_to_taskserver
+    if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then
+      done = .true.
+    endif
+    call sort_selection_buffer(buf)
+    call merge_selection_buffers(buf,buf2)
+    call push_selection_results(zmq_socket_push, pt2, buf, task_id, n_tasks)
+    buf%mini = buf2%mini
+    pt2(:,:) = 0d0
+    buf%cur = 0
+  end do
+
+  integer, external :: disconnect_from_taskserver
+  if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
+    continue
+  endif
+
+  call end_zmq_push_socket(zmq_socket_push,thread)
+  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+  call delete_selection_buffer(buf)
+
+end
+
+subroutine run_selection_slave_old(thread,iproc,energy)
   use f77_zmq
   use selection_types
   implicit none

plugins/Full_CI_ZMQ/selection.irp.f

@@ -137,7 +137,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
       puti = p(j, sp)
       if(bannedOrb(puti)) cycle
       pmob = p(turn2(j), sp)
-      hij = mo_bielec_integral(pfix, pmob, hfix, hmob)
+      hij = mo_bielec_integral(pmob, pfix, hmob, hfix)
       hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix)
       vect(:, puti) += hij * coefs
     end do
@@ -193,13 +193,13 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
     
     do i=1,hole-1
       if(lbanned(i)) cycle
-      hij = (mo_bielec_integral(p1, p2, i, hole) - mo_bielec_integral(p2, p1, i, hole))
+      hij = (mo_bielec_integral(i, hole, p1, p2) - mo_bielec_integral(i, hole, p2, p1))
       hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2)
       vect(1:N_states,i) += hij * coefs(1:N_states)
     end do
     do i=hole+1,mo_tot_num
       if(lbanned(i)) cycle
-      hij = (mo_bielec_integral(p1, p2, hole, i) - mo_bielec_integral(p2, p1, hole, i))
+      hij = (mo_bielec_integral(hole, i, p1, p2) - mo_bielec_integral(hole, i, p2, p1))
       hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2)
       vect(1:N_states,i) += hij * coefs(1:N_states)
     end do
@@ -211,7 +211,7 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
     p2 = p(1, sh)
     do i=1,mo_tot_num
       if(lbanned(i)) cycle
-      hij = mo_bielec_integral(p1, p2, i, hole)
+      hij = mo_bielec_integral(i, hole, p1, p2)
       hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2)
       vect(1:N_states,i) += hij * coefs(1:N_states)
     end do
@@ -910,12 +910,12 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
       tmp_row = 0d0
       do putj=1, hfix-1
         if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle
-        hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
+        hij = (mo_bielec_integral(putj, hfix, p1, p2)-mo_bielec_integral(putj,hfix,p2,p1)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
         tmp_row(1:N_states,putj) += hij * coefs(1:N_states)
       end do
       do putj=hfix+1, mo_tot_num
         if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle
-        hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
+        hij = (mo_bielec_integral(hfix,putj,p1, p2)-mo_bielec_integral(hfix,putj,p2,p1)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
         tmp_row(1:N_states,putj) += hij * coefs(1:N_states)
       end do
 
@@ -935,13 +935,13 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
       !p1 fixed
       putj = p1
       if(.not. banned(putj,puti,bant)) then
-        hij = mo_bielec_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix)
+        hij = mo_bielec_integral(puti,hfix,pfix,p2) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix)
         tmp_row(:,puti) += hij * coefs(:)
       end if
       
       putj = p2
       if(.not. banned(putj,puti,bant)) then
-        hij = mo_bielec_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix)
+        hij = mo_bielec_integral(puti,hfix,pfix,p1) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix)
         tmp_row2(:,puti) += hij * coefs(:)
       end if
     end do
@@ -963,12 +963,12 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
         tmp_row = 0d0
         do putj=1,hfix-1
           if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
-          hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
+          hij = (mo_bielec_integral(putj, hfix, p1, p2)-mo_bielec_integral(putj,hfix,p2,p1)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
           tmp_row(:,putj) += hij * coefs(:)
         end do
         do putj=hfix+1,mo_tot_num
           if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
-          hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
+          hij = (mo_bielec_integral(putj, hfix, p2, p1)-mo_bielec_integral(putj,hfix,p1,p2)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
           tmp_row(:,putj) += hij * coefs(:)
         end do
 
@@ -986,13 +986,13 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
         if(lbanned(puti,ma)) cycle
         putj = p2
         if(.not. banned(puti,putj,1)) then
-          hij = mo_bielec_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1)
+          hij = mo_bielec_integral(puti,hfix, p1,pfix) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1)
           tmp_row(:,puti) += hij * coefs(:)
         end if
         
         putj = p1
         if(.not. banned(puti,putj,1)) then
-          hij = mo_bielec_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2)
+          hij = mo_bielec_integral(puti, hfix, p2, pfix) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2)
           tmp_row2(:,puti) += hij * coefs(:)
         end if
       end do
@@ -1064,7 +1064,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
           call i_h_j(gen, det, N_int, hij)
         else
           phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2)
-          hij = mo_bielec_integral(p1, p2, h1, h2) * phase
+          hij = mo_bielec_integral(p2, p1, h2, h1) * phase
         end if
         mat(:, p1, p2) += coefs(:) * hij
       end do
@@ -1081,7 +1081,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
           call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
           call i_h_j(gen, det, N_int, hij)
         else
-          hij = (mo_bielec_integral(p1, p2, puti, putj) -  mo_bielec_integral(p2, p1, puti, putj))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2)
+          hij = (mo_bielec_integral(putj, puti, p2, p1) -  mo_bielec_integral(putj, puti, p1, p2))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2)
         end if
         mat(:, puti, putj) += coefs(:) * hij
       end do

plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f

@@ -34,6 +34,7 @@ subroutine run_wf
   double precision :: t0, t1
   
   integer, external              :: zmq_get_dvector, zmq_get_N_det_generators 
+  integer, external              :: zmq_get_ivector
   integer, external              :: zmq_get_psi, zmq_get_N_det_selectors
   integer, external              :: zmq_get_N_states_diag
 
@@ -65,8 +66,10 @@ subroutine run_wf
       if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
       if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
       if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle
+      if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) cycle
+      if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) cycle
       psi_energy(1:N_states) = energy(1:N_states)
-      TOUCH psi_energy
+      TOUCH psi_energy threshold_selectors threshold_generators
 
       call wall_time(t1)
       call write_double(6,(t1-t0),'Broadcast time')
@@ -105,10 +108,20 @@ subroutine run_wf
       call wall_time(t0)
       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) == -1) cycle
+      if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle
+      if (zmq_get_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) cycle
       if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
       if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
+      if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) cycle
+      if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) cycle
       psi_energy(1:N_states) = energy(1:N_states)
-      TOUCH psi_energy
+      TOUCH psi_energy state_average_weight pt2_stoch_istate threshold_selectors threshold_generators
+      print *,  'N_det', N_det
+      print *,  'N_det_generators', N_det_generators
+      print *,  'N_det_selectors', N_det_selectors
+      print *,  'psi_energy', psi_energy
+      print *,  'pt2_stoch_istate', pt2_stoch_istate
+      print *,  'state_average_weight', state_average_weight
 
       call wall_time(t1)
       call write_double(6,(t1-t0),'Broadcast time')
@@ -117,9 +130,11 @@ subroutine run_wf
       lstop = .False.
       !$OMP PARALLEL PRIVATE(i)
       i = omp_get_thread_num()
-      call run_pt2_slave(0,i,energy,lstop)
+      call run_pt2_slave(0,i,pt2_e0_denominator)
       !$OMP END PARALLEL
       print *,  'PT2 done'
+exit
+      FREE state_average_weight
 
     endif
 

plugins/Full_CI_ZMQ/zmq_selection.irp.f

@@ -41,6 +41,12 @@ subroutine ZMQ_selection(N_in, pt2)
     if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
       stop 'Unable to put energy on ZMQ server'
     endif
+    if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) then
+      stop 'Unable to put threshold_selectors on ZMQ server'
+    endif
+    if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then
+      stop 'Unable to put threshold_generators on ZMQ server'
+    endif
     call create_selection_buffer(N, N*2, b)
   endif
 

src/Determinants/s2.irp.f

@@ -189,8 +189,8 @@ subroutine S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
   allocate(vt(sze_8,N_st))
   vt = 0.d0
   
-  !$OMP DO SCHEDULE(dynamic)
   do sh=1,shortcut(0,1)
+    !$OMP DO 
     do sh2=sh,shortcut(0,1)
       exa = 0
       do ni=1,Nint
@@ -227,11 +227,11 @@ subroutine S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
         enddo
       enddo
     enddo
-  enddo
     !$OMP END DO NOWAIT
+  enddo
   
-  !$OMP DO SCHEDULE(dynamic)
   do sh=1,shortcut(0,2)
+    !$OMP DO 
     do i=shortcut(sh,2),shortcut(sh+1,2)-1
       org_i = sort_idx(i,2)
       do j=shortcut(sh,2),i-1
@@ -249,8 +249,9 @@ subroutine S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
         end if
       end do
     end do
-  enddo
     !$OMP END DO NOWAIT
+  enddo
+  !$OMP BARRIER
   
   do istate=1,N_st
     do i=n,1,-1

src/Integrals_Bielec/map_integrals.irp.f

@@ -421,8 +421,8 @@ double precision function mo_bielec_integral(i,j,k,l)
   integer, intent(in)            :: i,j,k,l
   double precision               :: get_mo_bielec_integral
   PROVIDE mo_bielec_integrals_in_map mo_integrals_cache
-  !DIR$ FORCEINLINE
   PROVIDE mo_bielec_integrals_in_map
+  !DIR$ FORCEINLINE
   mo_bielec_integral = get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
   return
 end

src/ZMQ/put_get.irp.f

@@ -2,7 +2,7 @@ integer function zmq_put_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
   use f77_zmq
   implicit none
   BEGIN_DOC
-! Put the X vector on the qp_run scheduler
+! Put a float vector on the qp_run scheduler
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
@@ -40,7 +40,7 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
   use f77_zmq
   implicit none
   BEGIN_DOC
-! Get psi_coef from the qp_run scheduler
+! Get a float vector from the qp_run scheduler
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
@@ -86,7 +86,7 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
       print *,  irp_here//': Unable to broadcast zmq_get_dvector'
       stop -1
     endif
-    call MPI_BCAST (x, size_x, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    call MPI_BCAST (x, size_x, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
     if (ierr /= MPI_SUCCESS) then
       print *,  irp_here//': Unable to broadcast dvector'
       stop -1
@@ -97,3 +97,102 @@ end
 
 
 
+integer function zmq_put_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Put a vector of integers on the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  character*(*)                  :: name
+  integer, intent(in)            :: size_x
+  integer, intent(out)           :: x(size_x)
+  integer                        :: rc
+  character*(256)                :: msg
+
+  zmq_put_ivector = 0
+
+  write(msg,'(A,1X,I8,1X,A200)') 'put_data '//trim(zmq_state), worker_id, name
+  rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
+  if (rc /= len(trim(msg))) then
+    zmq_put_ivector = -1
+    return 
+  endif
+
+  rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*4,0)
+  if (rc /= size_x*4) then
+    zmq_put_ivector = -1
+    return
+  endif
+
+  rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
+  if (msg(1:rc) /= 'put_data_reply ok') then
+    zmq_put_ivector = -1
+    return
+  endif
+
+end
+
+
+integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Get a vector of integers from the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  integer, intent(in)            :: size_x
+  character*(*), intent(in)      :: name
+  integer, intent(out)           :: x(size_x)
+  integer                        :: rc
+  integer*8                      :: rc8
+  character*(256)                :: msg
+
+  PROVIDE zmq_state
+  ! Success
+  zmq_get_ivector = 0
+
+  if (mpi_master) then
+    write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, name
+    rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
+    if (rc /= len(trim(msg))) then
+      zmq_get_ivector = -1
+      go to 10
+    endif
+
+    rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
+    if (msg(1:14) /= 'get_data_reply') then
+      zmq_get_ivector = -1
+      go to 10
+    endif
+
+    rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*4,0)
+    if (rc /= size_x*4) then
+      zmq_get_ivector = -1
+      go to 10
+    endif
+  endif
+
+  10 continue
+
+  IRP_IF MPI
+    integer :: ierr
+    include 'mpif.h'
+    call MPI_BCAST (zmq_get_ivector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      print *,  irp_here//': Unable to broadcast zmq_get_ivector'
+      stop -1
+    endif
+    call MPI_BCAST (x, size_x, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      print *,  irp_here//': Unable to broadcast ivector'
+      stop -1
+    endif
+  IRP_ENDIF
+
+end
+
+
+

src/ZMQ/utils.irp.f

@@ -148,12 +148,12 @@ function new_zmq_to_qp_run_socket()
      stop 'Unable to create zmq req socket'
   endif
 
-  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 60000, 4)
+  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 300000, 4)
   if (rc /= 0) then
     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, 60000, 4)
+  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 300000, 4)
   if (rc /= 0) then
     stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket'
   endif
@@ -250,7 +250,7 @@ IRP_ENDIF
      stop 'Unable to create zmq pull socket'
   endif
   
-  rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_LINGER,60000,4)
+  rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_LINGER,300000,4)
   if (rc /= 0) then
     stop 'Unable to set ZMQ_LINGER on pull socket'
   endif
@@ -332,7 +332,7 @@ IRP_ENDIF
      stop 'Unable to create zmq push socket'
   endif
   
-  rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_LINGER,60000,4)
+  rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_LINGER,300000,4)
   if (rc /= 0) then
     stop 'Unable to set ZMQ_LINGER on push socket'
   endif
@@ -352,7 +352,7 @@ IRP_ENDIF
     stop 'Unable to set ZMQ_IMMEDIATE on push socket'
   endif
   
-  rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 60000, 4)
+  rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 300000, 4)
   if (rc /= 0) then
     stop 'Unable to set send timout in new_zmq_push_socket'
   endif
@@ -488,7 +488,7 @@ subroutine end_zmq_push_socket(zmq_socket_push,thread)
   integer                        :: rc
   character*(8), external        :: zmq_port
   
-  rc = f77_zmq_setsockopt(zmq_socket_push,ZMQ_LINGER,60000,4)
+  rc = f77_zmq_setsockopt(zmq_socket_push,ZMQ_LINGER,300000,4)
   if (rc /= 0) then
     stop 'Unable to set ZMQ_LINGER on push socket'
   endif
@@ -1019,7 +1019,7 @@ subroutine end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   character*(8), external        :: zmq_port
   integer                        :: rc
 
-  rc = f77_zmq_setsockopt(zmq_to_qp_run_socket,ZMQ_LINGER,60000,4)
+  rc = f77_zmq_setsockopt(zmq_to_qp_run_socket,ZMQ_LINGER,300000,4)
   if (rc /= 0) then
     stop 'Unable to set ZMQ_LINGER on zmq_to_qp_run_socket'
   endif