Merge lpqlx139:quantum_package

plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f

@@ -425,9 +425,6 @@ end function
   deallocate(seed)
 
   call RANDOM_NUMBER(pt2_u)
-  call RANDOM_NUMBER(pt2_u)
-  
-
   
   U = 0
   

plugins/Full_CI_ZMQ/selection.irp.f

@@ -414,7 +414,8 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
   allocate (mat(N_states, mo_tot_num, mo_tot_num))
   maskInd = -1
 
-  integer :: nb_count, maskInd_save, monoBdo_save
+  integer :: nb_count, maskInd_save
+  logical :: monoBdo_save
   logical :: found
   do s1=1,2
     do i1=N_holes(s1),1,-1   ! Generate low excitations first

src/Determinants/zmq.irp.f

@@ -163,6 +163,7 @@ integer function zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
 
   rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
   if (rc8 /= N_int*2_8*N_det*bit_kind) then
+    print *,  'rc=', rc8
     zmq_put_psi_det = -1
     return
   endif
@@ -195,8 +196,9 @@ integer function zmq_put_psi_coef(zmq_to_qp_run_socket,worker_id)
     return
   endif
 
-  rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
+  rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size,8)*int(N_states,8)*8_8,0)
   if (rc8 /= psi_det_size*N_states*8_8) then
+    print *,  'rc=', rc8
     zmq_put_psi_coef = -1
     return
   endif

src/ZMQ/put_get.irp.f

@@ -48,7 +48,6 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
   character*(*), intent(in)      :: name
   double precision, intent(out)  :: x(size_x)
   integer                        :: rc
-  integer*8                      :: rc8
   character*(256)                :: msg
 
   PROVIDE zmq_state
@@ -151,7 +150,6 @@ integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_
   character*(*), intent(in)      :: name
   integer, intent(out)           :: x(size_x)
   integer                        :: rc
-  integer*8                      :: rc8
   character*(256)                :: msg
 
   PROVIDE zmq_state
@@ -200,6 +198,206 @@ integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_
 end
 
 
+integer function zmq_put8_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
+  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*8, intent(in)          :: size_x
+  double precision, intent(in)   :: x(size_x)
+  integer*8                      :: rc
+  character*(256)                :: msg
+
+  zmq_put8_dvector = 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_put8_dvector = -1
+    return 
+  endif
+
+  rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*8,0)
+  if (rc /= size_x*8) then
+    zmq_put8_dvector = -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_put8_dvector = -1
+    return
+  endif
+
+end
+
+
+integer function zmq_get8_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
+  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*8, intent(in)          :: size_x
+  character*(*), intent(in)      :: name
+  double precision, intent(out)  :: x(size_x)
+  integer*8                      :: rc
+  character*(256)                :: msg
+
+  PROVIDE zmq_state
+  ! Success
+  zmq_get8_dvector = 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_get8_dvector = -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_get8_dvector = -1
+      go to 10
+    endif
+
+    rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0)
+    if (rc /= size_x*8) then
+      print *,  irp_here, 'rc /= size_x*8', rc, size_x*8
+      zmq_get8_dvector = -1
+      go to 10
+    endif
+  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_get8_dvector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      print *,  irp_here//': Unable to broadcast zmq_get8_dvector'
+      stop -1
+    endif
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+    call broadcast_chunks_double(x, size_x)
+  IRP_ENDIF
+
+end
+
+
+
+integer function zmq_put8_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*8, intent(in)          :: size_x
+  integer, intent(in)            :: x(size_x)
+  integer*8                      :: rc
+  character*(256)                :: msg
+
+  zmq_put8_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_put8_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_put8_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_put8_ivector = -1
+    return
+  endif
+
+end
+
+
+integer function zmq_get8_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*8, intent(in)            :: size_x
+  character*(*), intent(in)      :: name
+  integer, intent(out)           :: x(size_x)
+  integer*8                      :: rc
+  character*(256)                :: msg
+
+  PROVIDE zmq_state
+  ! Success
+  zmq_get8_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_get8_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_get8_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_get8_ivector = -1
+      go to 10
+    endif
+  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_get8_ivector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      print *,  irp_here//': Unable to broadcast zmq_get8_ivector'
+      stop -1
+    endif
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+    call broadcast_chunks_integer(x, size_x)
+  IRP_ENDIF
+
+end
+
+
 
 integer function zmq_put_int(zmq_to_qp_run_socket, worker_id, name, x)
   use f77_zmq