Merge branch 'master' of github.com:scemama/quantum_package

plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f

@@ -38,7 +38,8 @@ subroutine run_wf
   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
+  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 ()
@@ -131,8 +132,8 @@ subroutine run_wf
       ! --------
 
       call wall_time(t0)
-      if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
       if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
+      if (zmq_get_psi_bilinear(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)

src/Davidson/davidson_parallel.irp.f

@@ -84,6 +84,11 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
   integer, external :: zmq_get_dvector
   integer, external :: zmq_get_dmatrix
 
+  PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique 
+  PROVIDE psi_bilinear_matrix_transp_values psi_bilinear_matrix_values psi_bilinear_matrix_columns_loc
+  PROVIDE ref_bitmask_energy nproc
+  PROVIDE mpi_initialized
+
   allocate(u_t(N_st,N_det))
   allocate (energy(N_st))
 
@@ -96,11 +101,11 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
     ni = 8388608
     nj = int(size(u_t,kind=8)/8388608_8,4) + 1
   endif
-  if (zmq_get_dmatrix(zmq_to_qp_run_socket, worker_id, 'u_t', u_t, ni, nj, size(u_t,kind=8)) == -1) then
+
-    print *,  irp_here, ': Unable to get u_t'
+  do while (zmq_get_dmatrix(zmq_to_qp_run_socket, worker_id, 'u_t', u_t, ni, nj, size(u_t,kind=8)) == -1) 
-    deallocate(u_t,energy)
+    call sleep(1)
-    return
+    print *,  irp_here, ': waiting for u_t...'
-  endif
+  enddo
 
   if (zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size(energy)) == -1) then
     print *,  irp_here, ': Unable to get energy'
@@ -293,17 +298,71 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   integer                        :: ithread
   double precision, allocatable  :: u_t(:,:)
   !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
-  
+  integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
   PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique 
   PROVIDE psi_bilinear_matrix_transp_values psi_bilinear_matrix_values psi_bilinear_matrix_columns_loc
   PROVIDE ref_bitmask_energy nproc
   PROVIDE mpi_initialized
 
+  call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'davidson')
+  
+  if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then
+    stop 'Unable to put N_states_diag on ZMQ server'
+  endif
+  if (zmq_put_psi_bilinear(zmq_to_qp_run_socket,1) == -1) then
+    stop 'Unable to put psi on ZMQ server'
+  endif
+  energy = 0.d0
+  if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy)) == -1) then
+    stop 'Unable to put energy on ZMQ server'
+  endif
+
+
+  ! Create tasks
+  ! ============
+
+  integer :: istep, imin, imax, ishift, ipos
+  integer, external :: add_task_to_taskserver
+  integer, parameter :: tasksize=10000
+  character*(100000) :: task
+  istep=1
+  ishift=0
+  imin=1
+
+
+  ipos=1
+  do imin=1,N_det,10000
+    imax = min(N_det,imin-1+tasksize)
+    do ishift=0,istep-1
+      write(task(ipos:ipos+50),'(4(I11,1X),1X,1A)') imin, imax, ishift, istep, '|'
+      ipos = ipos+50
+      if (ipos > 100000-50) then
+        if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
+          stop 'Unable to add task'
+        endif
+        ipos=1
+      endif
+    enddo
+  enddo
+
+  if (ipos > 1) then
+    if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
+      stop 'Unable to add task'
+    endif
+    ipos=1
+  endif
+    
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
+
 
   allocate(u_t(N_st,N_det))
   do k=1,N_st
     call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
   enddo
+
   call dtranspose(                                                   &
       u_0,                                                           &
       size(u_0, 1),                                                  &
@@ -312,32 +371,16 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
       N_det, N_st)
 
   
-  integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
-  
   ASSERT (N_st == N_states_diag)
   ASSERT (sze >= N_det) 
 
-  call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'davidson')
-  
-  character*(512) :: task
   integer :: rc, ni, nj
   integer*8 :: rc8
   double precision :: energy(N_st)
 
-  integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag
+  integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag, zmq_put_psi_bilinear
   integer, external :: zmq_put_dmatrix
 
-  energy = 0.d0
-
-  if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then
-    stop 'Unable to put N_states_diag on ZMQ server'
-  endif
-  if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
-    stop 'Unable to put psi on ZMQ server'
-  endif
-  if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy)) == -1) then
-    stop 'Unable to put energy on ZMQ server'
-  endif
   if (size(u_t) < 8388608) then
     ni = size(u_t)
     nj = 1
@@ -354,50 +397,9 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   deallocate(u_t)
 
 
-  ! Create tasks
-  ! ============
-
-  integer :: istep, imin, imax, ishift
-  double precision :: w, max_workload, N_det_inv
-  integer, external :: add_task_to_taskserver
-  w = 0.d0
-  istep=1
-  ishift=0
-  imin=1
-  N_det_inv = 1.d0/dble(N_det)
-  max_workload = 10000.d0
-  do imax=1,N_det
-    w = w + 1.d0
-    if (w > max_workload) then
-      do ishift=0,istep-1
-        write(task,'(4(I9,1X),1A)') imin, imax, ishift, istep, '|'
-        if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
-          stop 'Unable to add task'
-        endif
-      enddo
-      imin = imax+1
-      w = 0.d0
-    endif
-  enddo
-  if (w > 0.d0) then
-    imax = N_det
-    do ishift=0,istep-1
-      write(task,'(4(I9,1X),1A)') imin, imax, ishift, istep, '|'
-      if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
-        stop 'Unable to add task'
-      endif
-    enddo
-  endif
-    
-
   v_0 = 0.d0
   s_0 = 0.d0
 
-  integer, external :: zmq_set_running
-  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
-    print *,  irp_here, ': Failed in zmq_set_running'
-  endif
-
   call omp_set_nested(.True.)
   !$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
   ithread = omp_get_thread_num()

src/DavidsonUndressed/print_energy.irp.f

@@ -2,7 +2,7 @@ program print_energy
  implicit none
  read_wf = .true.
  touch read_wf
- provide mo_bielec_integrals_in_map
+ provide mo_bielec_integrals_in_map psi_coef psi_det psi_bilinear_matrix_transp_values
  double precision :: time1, time0
  call wall_time(time0)
  call routine

src/Determinants/spindeterminants.irp.f

@@ -519,7 +519,7 @@ BEGIN_PROVIDER  [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_
     do k=1,N_det
       psi_bilinear_matrix_transp_values (k,l) = psi_bilinear_matrix_values (k,l)
     enddo
-    !$OMP ENDDO
+    !$OMP ENDDO NOWAIT
   enddo
   !$OMP DO 
   do k=1,N_det

src/Determinants/zmq.irp.f

@@ -40,6 +40,242 @@ end
 
 
 
+integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Get the wave function from the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+
+  integer, external              :: zmq_get_N_states
+  integer, external              :: zmq_get_N_det
+  integer, external              :: zmq_get_psi_det_size
+  integer*8, external            :: zmq_get_psi_det
+  integer*8, external            :: zmq_get_psi_coef
+
+  zmq_get_psi_notouch = 0
+
+  if (zmq_get_N_states(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_get_psi_notouch = -1
+    return
+  endif
+  if (zmq_get_N_det(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_get_psi_notouch = -1
+    return
+  endif
+  if (zmq_get_psi_det_size(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_get_psi_notouch = -1
+    return
+  endif
+  
+  if (size(psi_det,kind=8) /= N_int*2_8*psi_det_size*bit_kind) then
+    deallocate(psi_det)
+    allocate(psi_det(N_int,2,psi_det_size))
+  endif
+
+  if (size(psi_coef,kind=8) /= psi_det_size*N_states) then
+    deallocate(psi_coef)
+    allocate(psi_coef(psi_det_size,N_states))
+  endif
+
+  if (zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) == -1_8) then
+    zmq_get_psi_notouch = -1
+    return
+  endif
+  if (zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) == -1_8) then
+    zmq_get_psi_notouch = -1
+    return
+  endif
+
+end
+
+
+integer function zmq_get_psi(zmq_to_qp_run_socket, worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Get the wave function from the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  integer, external :: zmq_get_psi_notouch
+  zmq_get_psi = zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
+  SOFT_TOUCH psi_det psi_coef psi_det_size N_det N_states
+
+end
+
+
+
+
+
+integer function zmq_put_psi_bilinear(zmq_to_qp_run_socket,worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Put the wave function on the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  character*(256)                :: msg
+
+
+  zmq_put_psi_bilinear = 0
+
+  integer, external            :: zmq_put_psi
+  if (zmq_put_psi(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_psi_bilinear_matrix_columns
+  if (zmq_put_psi_bilinear_matrix_rows(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_psi_bilinear_matrix_rows
+  if (zmq_put_psi_bilinear_matrix_columns(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_psi_bilinear_matrix_order
+  if (zmq_put_psi_bilinear_matrix_order(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_psi_bilinear_matrix_values
+  if (zmq_put_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_N_det_alpha_unique
+  if (zmq_put_N_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_N_det_beta_unique
+  if (zmq_put_N_det_beta_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_psi_det_alpha_unique
+  if (zmq_put_psi_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_put_psi_det_beta_unique
+  if (zmq_put_psi_det_beta_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_put_psi_bilinear = -1
+    return
+  endif
+
+end
+
+
+integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Get the wave function from the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+
+  integer, external            :: zmq_get_psi_notouch
+  if (zmq_get_psi_notouch(zmq_to_qp_run_socket,1) == -1) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  zmq_get_psi_bilinear= 0
+
+  if (size(psi_bilinear_matrix_values,kind=8) /= N_det*N_states) then
+    deallocate(psi_bilinear_matrix_values)
+    allocate(psi_bilinear_matrix_values(N_det,N_states))
+  endif
+
+  if (size(psi_bilinear_matrix_rows,kind=8) /= N_det) then
+    deallocate(psi_bilinear_matrix_rows)
+    allocate(psi_bilinear_matrix_rows(N_det))
+  endif
+
+  if (size(psi_bilinear_matrix_columns,kind=8) /= N_det) then
+    deallocate(psi_bilinear_matrix_columns)
+    allocate(psi_bilinear_matrix_columns(N_det))
+  endif
+
+  if (size(psi_bilinear_matrix_order,kind=8) /= N_det) then
+    deallocate(psi_bilinear_matrix_order)
+    allocate(psi_bilinear_matrix_order(N_det))
+  endif
+
+  integer*8, external            :: zmq_get_psi_bilinear_matrix_values
+  if (zmq_get_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1_8) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_get_psi_bilinear_matrix_rows
+  if (zmq_get_psi_bilinear_matrix_rows(zmq_to_qp_run_socket, worker_id) == -1_8) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_get_psi_bilinear_matrix_columns
+  if (zmq_get_psi_bilinear_matrix_columns(zmq_to_qp_run_socket, worker_id) == -1_8) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_get_psi_bilinear_matrix_order
+  if (zmq_get_psi_bilinear_matrix_order(zmq_to_qp_run_socket, worker_id) == -1_8) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+
+  integer*8, external            :: zmq_get_N_det_alpha_unique
+  if (zmq_get_N_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_get_N_det_beta_unique
+  if (zmq_get_N_det_beta_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_get_psi_det_alpha_unique
+  if (zmq_get_psi_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  integer*8, external            :: zmq_get_psi_det_beta_unique
+  if (zmq_get_psi_det_beta_unique(zmq_to_qp_run_socket,worker_id) == -1) then
+    zmq_get_psi_bilinear = -1
+    return
+  endif
+
+  SOFT_TOUCH psi_bilinear_matrix_values psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique
+
+end
+
+
+
+
+
+
+
 BEGIN_TEMPLATE 
 
 integer function zmq_put_$X(zmq_to_qp_run_socket,worker_id)
@@ -136,15 +372,20 @@ SUBST [ X ]
 
 N_states ;;
 N_det ;;
+N_det_alpha_unique ;;
+N_det_beta_unique ;;
 psi_det_size ;;
 
 END_TEMPLATE
 
-integer*8 function zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
+
+BEGIN_TEMPLATE
+
+integer*8 function zmq_put_$X(zmq_to_qp_run_socket,worker_id)
   use f77_zmq
   implicit none
   BEGIN_DOC
-! Put psi_det on the qp_run scheduler
+! Put $X on the qp_run scheduler
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
@@ -154,49 +395,22 @@ integer*8 function zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
   integer*8 :: zmq_put_i8matrix
   integer   :: ni, nj
 
-  if (size(psi_det,kind=8) <= 8388608_8) then
+  if (size($X,kind=8) <= 8388608_8) then
-    ni = size(psi_det,kind=4)
+    ni = size($X,kind=4)
     nj = 1
   else
     ni = 8388608_8
-    nj = int(size(psi_det,kind=8)/8388608_8,4) + 1
+    nj = int(size($X,kind=8)/8388608_8,4) + 1
   endif
-  rc8 = zmq_put_i8matrix(zmq_to_qp_run_socket, 1, 'psi_det', psi_det, ni, nj, size(psi_det,kind=8))
+  rc8 = zmq_put_i8matrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8))
-  zmq_put_psi_det = rc8
+  zmq_put_$X = rc8
 end
 
-integer*8 function zmq_put_psi_coef(zmq_to_qp_run_socket,worker_id)
+integer*8 function zmq_get_$X(zmq_to_qp_run_socket,worker_id)
   use f77_zmq
   implicit none
   BEGIN_DOC
-! Put psi_coef on the qp_run scheduler
+! Get $X on the qp_run scheduler
-  END_DOC
-  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
-  integer, intent(in)            :: worker_id
-  integer*8                      :: rc8
-  character*(256)                :: msg
-
-  zmq_put_psi_coef = 0
-
-  integer*8 :: zmq_put_dmatrix
-  integer   :: ni, nj
-
-  if (size(psi_coef,kind=8) <= 8388608_8) then
-    ni = size(psi_coef,kind=4)
-    nj = 1
-  else
-    ni = 8388608
-    nj = int(size(psi_coef,kind=8)/8388608_8,4) + 1
-  endif
-  rc8 = zmq_put_dmatrix(zmq_to_qp_run_socket, 1, 'psi_coef', psi_coef, ni, nj, size(psi_coef,kind=8) )
-  zmq_put_psi_coef = rc8
-end
-
-integer*8 function zmq_get_psi_det(zmq_to_qp_run_socket,worker_id)
-  use f77_zmq
-  implicit none
-  BEGIN_DOC
-! Get psi_det on the qp_run scheduler
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
@@ -206,99 +420,150 @@ integer*8 function zmq_get_psi_det(zmq_to_qp_run_socket,worker_id)
   integer*8 :: zmq_get_i8matrix
   integer   :: ni, nj
 
-  if (size(psi_det,kind=8) <= 8388608_8) then
+  if (size($X,kind=8) <= 8388608_8) then
-    ni = size(psi_det,kind=4)
+    ni = size($X,kind=4)
     nj = 1
   else
     ni = 8388608
-    nj = int(size(psi_det,kind=8)/8388608_8,4) + 1
+    nj = int(size($X,kind=8)/8388608_8,4) + 1
   endif
-  rc8 = zmq_get_i8matrix(zmq_to_qp_run_socket, 1, 'psi_det', psi_det, ni, nj, size(psi_det,kind=8))
+  rc8 = zmq_get_i8matrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8))
-  zmq_get_psi_det = rc8
+  zmq_get_$X = rc8
 end
 
-integer*8 function zmq_get_psi_coef(zmq_to_qp_run_socket,worker_id)
+SUBST [ X ]
+
+psi_det ;;
+psi_det_alpha_unique ;;
+psi_det_beta_unique ;;
+
+END_TEMPLATE
+
+BEGIN_TEMPLATE
+
+integer*8 function zmq_put_$X(zmq_to_qp_run_socket,worker_id)
   use f77_zmq
   implicit none
   BEGIN_DOC
-! get psi_coef on the qp_run scheduler
+! Put $X on the qp_run scheduler
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
   integer*8                      :: rc8
   character*(256)                :: msg
 
-  zmq_get_psi_coef = 0_8
+  integer*8 :: zmq_put_imatrix
+  integer   :: ni, nj
+
+  if (size($X,kind=8) <= 8388608_8) then
+    ni = size($X,kind=4)
+    nj = 1
+  else
+    ni = 8388608_8
+    nj = int(size($X,kind=8)/8388608_8,4) + 1
+  endif
+  rc8 = zmq_put_imatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8))
+  zmq_put_$X = rc8
+end
+
+integer*8 function zmq_get_$X(zmq_to_qp_run_socket,worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Get $X on the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  integer*8                      :: rc8
+  character*(256)                :: msg
+
+  integer*8 :: zmq_get_imatrix
+  integer   :: ni, nj
+
+  if (size($X,kind=8) <= 8388608_8) then
+    ni = size($X,kind=4)
+    nj = 1
+  else
+    ni = 8388608
+    nj = int(size($X,kind=8)/8388608_8,4) + 1
+  endif
+  rc8 = zmq_get_imatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8))
+  zmq_get_$X = rc8
+end
+
+SUBST [ X ]
+
+psi_bilinear_matrix_rows ;;
+psi_bilinear_matrix_columns ;;
+psi_bilinear_matrix_order ;;
+
+END_TEMPLATE
+
+
+BEGIN_TEMPLATE
+
+integer*8 function zmq_put_$X(zmq_to_qp_run_socket,worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Put $X on the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  integer*8                      :: rc8
+  character*(256)                :: msg
+
+  zmq_put_$X = 0
+
+  integer*8 :: zmq_put_dmatrix
+  integer   :: ni, nj
+
+  if (size($X,kind=8) <= 8388608_8) then
+    ni = size($X,kind=4)
+    nj = 1
+  else
+    ni = 8388608
+    nj = int(size($X,kind=8)/8388608_8,4) + 1
+  endif
+  rc8 = zmq_put_dmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) )
+  zmq_put_$X = rc8
+end
+
+integer*8 function zmq_get_$X(zmq_to_qp_run_socket,worker_id)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! get $X on the qp_run scheduler
+  END_DOC
+  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
+  integer, intent(in)            :: worker_id
+  integer*8                      :: rc8
+  character*(256)                :: msg
+
+  zmq_get_$X = 0_8
 
   integer*8 :: zmq_get_dmatrix
   integer   :: ni, nj
 
-  if (size(psi_coef,kind=8) <= 8388608_8) then
+  if (size($X,kind=8) <= 8388608_8) then
-    ni = size(psi_coef,kind=4)
+    ni = size($X,kind=4)
     nj = 1
   else
     ni = 8388608
-    nj = int(size(psi_coef,kind=8)/8388608_8,4) + 1
+    nj = int(size($X,kind=8)/8388608_8,4) + 1
   endif
-  rc8 = zmq_get_dmatrix(zmq_to_qp_run_socket, 1, 'psi_coef', psi_coef, ni, nj, size(psi_coef,kind=8) )
+  rc8 = zmq_get_dmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) )
-  zmq_get_psi_coef = rc8
+  zmq_get_$X = rc8
 end
 
+SUBST [ X ]
+
+psi_coef ;;
+psi_bilinear_matrix_values ;;
+
+END_TEMPLATE
+
+
 !---------------------------------------------------------------------------
 
 
-integer function zmq_get_psi(zmq_to_qp_run_socket, worker_id)
-  use f77_zmq
-  implicit none
-  BEGIN_DOC
-! Get the wave function from the qp_run scheduler
-  END_DOC
-  integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
-  integer, intent(in)            :: worker_id
-
-  integer, external              :: zmq_get_N_states
-  integer, external              :: zmq_get_N_det
-  integer, external              :: zmq_get_psi_det_size
-  integer*8, external            :: zmq_get_psi_det
-  integer*8, external            :: zmq_get_psi_coef
-
-  zmq_get_psi = 0
-
-  if (zmq_get_N_states(zmq_to_qp_run_socket, worker_id) == -1) then
-    zmq_get_psi = -1
-    return
-  endif
-  if (zmq_get_N_det(zmq_to_qp_run_socket, worker_id) == -1) then
-    zmq_get_psi = -1
-    return
-  endif
-  if (zmq_get_psi_det_size(zmq_to_qp_run_socket, worker_id) == -1) then
-    zmq_get_psi = -1
-    return
-  endif
-  
-  if (size(psi_det,kind=8) /= N_int*2_8*psi_det_size*bit_kind) then
-    deallocate(psi_det)
-    allocate(psi_det(N_int,2,psi_det_size))
-  endif
-
-  if (size(psi_coef,kind=8) /= psi_det_size*N_states) then
-    deallocate(psi_coef)
-    allocate(psi_coef(psi_det_size,N_states))
-  endif
-
-  if (zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) == -1_8) then
-    zmq_get_psi = -1
-    return
-  endif
-  if (zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) == -1_8) then
-    zmq_get_psi = -1
-    return
-  endif
-  SOFT_TOUCH psi_det psi_coef psi_det_size N_det N_states
-
-end
-
-
-
-

src/Utils/sort.irp.f

@@ -456,16 +456,16 @@ BEGIN_TEMPLATE
         iorder(i) = iorder1(1_$int_type+i1-i)
       enddo
     endif
-    deallocate(x1,iorder1,stat=err)
-    if (err /= 0) then
-      print *,  irp_here, ': Unable to deallocate arrays x1, iorder1'
-      stop
-    endif
     
     if (i2>1_$int_type) then
       call $Xradix_sort$big(x(i1+1_$int_type),iorder(i1+1_$int_type),i2,-2)
     endif
     
+    deallocate(x1,iorder1,stat=err)
+    if (err /= 0) then
+      print *,  irp_here, ': Unable to deallocate arrays x1, iorder1'
+      stop
+    endif
     return
 
   else if (iradix == -2) then ! Positive
@@ -526,14 +526,24 @@ BEGIN_TEMPLATE
     endif
     
     
+    !$OMP PARALLEL DEFAULT(SHARED) if (isize > 1000000)
+    !$OMP SINGLE
     if (i3>1_$int_type) then
+      !$OMP TASK FIRSTPRIVATE(iradix_new,i3) SHARED(x,iorder) if(i3 > 1000000)
       call $Xradix_sort$big(x,iorder,i3,iradix_new-1)
+      !$OMP END TASK
     endif
     
     if (isize-i3>1_$int_type) then
+      !$OMP TASK FIRSTPRIVATE(iradix_new,i3) SHARED(x,iorder) if(isize-i3 > 1000000)
       call $Xradix_sort$big(x(i3+1_$int_type),iorder(i3+1_$int_type),isize-i3,iradix_new-1)
+      !$OMP END TASK
     endif
 
+    !$OMP TASKWAIT
+    !$OMP END SINGLE
+    !$OMP END PARALLEL
+    
     return
   endif
   
@@ -588,11 +598,16 @@ BEGIN_TEMPLATE
   
   
   if (i1>1_$int_type) then
+    !$OMP TASK FIRSTPRIVATE(i0,iradix,i1) SHARED(x,iorder) if(i1 >1000000)
     call $Xradix_sort$big(x(i0+1_$int_type),iorder(i0+1_$int_type),i1,iradix-1)
+    !$OMP END TASK
   endif
   if (i0>1) then
+    !$OMP TASK FIRSTPRIVATE(i0,iradix) SHARED(x,iorder) if(i0 >1000000)
     call $Xradix_sort$big(x,iorder,i0,iradix-1)
+    !$OMP END TASK
   endif
+  !$OMP TASKWAIT
   
  end
 

src/ZMQ/put_get.irp.f

@@ -608,13 +608,13 @@ integer function zmq_get_int(zmq_to_qp_run_socket, worker_id, name, x)
     include 'mpif.h'
     call MPI_BCAST (zmq_get_int, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
     if (ierr /= MPI_SUCCESS) then
-      print *,  irp_here//': Unable to broadcast zmq_get_i8matrix'
+      print *,  irp_here//': Unable to broadcast zmq_get_int'
       stop -1
     endif
     call MPI_BARRIER(MPI_COMM_WORLD,ierr)
     call MPI_BCAST (x, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
     if (ierr /= MPI_SUCCESS) then
-      print *,  irp_here//': Unable to broadcast zmq_get_i8matrix'
+      print *,  irp_here//': Unable to broadcast zmq_get_int'
       stop -1
     endif
   IRP_ENDIF
@@ -723,7 +723,7 @@ integer function zmq_get_i8matrix(zmq_to_qp_run_socket, worker_id, name, x, size
   integer, intent(in)            :: size_x1, size_x2
   integer*8, intent(in)          :: sze
   character*(*), intent(in)      :: name
-  double precision, intent(out)  :: x(size_x1,size_x2)
+  integer*8, intent(out)         :: x(size_x1,size_x2)
   integer*8                      :: rc, ni
   integer*8                      :: j
   character*(256)                :: msg
@@ -777,7 +777,7 @@ integer function zmq_get_i8matrix(zmq_to_qp_run_socket, worker_id, name, x, size
       stop -1
     endif
     call MPI_BARRIER(MPI_COMM_WORLD,ierr)
-    call broadcast_chunks_double(x, sze)
+    call broadcast_chunks_integer8(x, sze)
   IRP_ENDIF
 
 end
@@ -786,3 +786,124 @@ end
 
 
 
+integer function zmq_put_imatrix(zmq_to_qp_run_socket, worker_id, name, x, size_x1, size_x2, sze)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! 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
+  character*(*)                  :: name
+  integer, intent(in)            :: size_x1, size_x2
+  integer*8, intent(in)          :: sze
+  integer, intent(in)            :: x(size_x1, size_x2)
+  integer*8                      :: rc, ni
+  integer*8                      :: j
+  character*(256)                :: msg
+
+  zmq_put_imatrix = 0
+
+  ni = size_x1
+  do j=1,size_x2
+    if (j == size_x2) then
+      ni = sze - (j-1_8)*int(size_x1,8)
+    endif
+    write(msg,'(A,1X,I8,1X,A,I8.8)') 'put_data '//trim(zmq_state), worker_id, trim(name), j
+    rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
+    if (rc /= len(trim(msg))) then
+      zmq_put_imatrix = -1
+      print *,  irp_here, 'Failed in put_data', rc, j
+      return 
+    endif
+
+    rc = f77_zmq_send8(zmq_to_qp_run_socket,x(1,j),ni*4_8,0)
+    if (rc /= ni*4_8) then
+      print *,  irp_here, 'Failed in send ', rc, j
+      zmq_put_imatrix = -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
+      print *,  irp_here, 'Failed in recv ',  rc, j
+      zmq_put_imatrix = -1
+      return
+    endif
+  enddo
+
+end
+
+
+integer function zmq_get_imatrix(zmq_to_qp_run_socket, worker_id, name, x, size_x1, size_x2, sze)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! 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
+  integer, intent(in)            :: size_x1, size_x2
+  integer*8, intent(in)          :: sze
+  character*(*), intent(in)      :: name
+  integer, intent(out)           :: x(size_x1,size_x2)
+  integer*8                      :: rc, ni
+  integer*8                      :: j
+  character*(256)                :: msg
+
+  PROVIDE zmq_state
+  ! Success
+  zmq_get_imatrix = 0
+
+  if (mpi_master) then
+    ni = size_x1
+    do j=1, size_x2
+      if (j == size_x2) then
+        ni = sze - (j-1)*size_x1
+      endif
+      write(msg,'(A,1X,I8,1X,A,I8.8)') 'get_data '//trim(zmq_state), worker_id, trim(name),j
+      rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
+      if (rc /= len(trim(msg))) then
+        zmq_get_imatrix = -1
+        print *,  irp_here, 'rc /= len(trim(msg))', rc, len(trim(msg))
+        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
+        print *,  irp_here, 'msg(1:14) /= get_data_reply', msg(1:14)
+        zmq_get_imatrix = -1
+        go to 10
+      endif
+
+      rc = f77_zmq_recv8(zmq_to_qp_run_socket,x(1,j),ni*4_8,0)
+      if (rc /= ni*4_8) then
+        print *,  irp_here, 'rc /= ni*8', rc, ni*4_8
+        zmq_get_imatrix = -1
+        go to 10
+      endif
+    enddo
+  endif
+
+  10 continue
+
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+  IRP_IF MPI
+    integer :: ierr
+    include 'mpif.h'
+    call MPI_BCAST (zmq_get_imatrix, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      print *,  irp_here//': Unable to broadcast zmq_get_imatrix'
+      stop -1
+    endif
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+    call broadcast_chunks_integer(x, sze)
+  IRP_ENDIF
+
+end
+
+
+