complex zmq determinants

src/determinants/zmq.irp.f

@@ -13,6 +13,7 @@ integer function zmq_put_psi(zmq_to_qp_run_socket,worker_id)
   integer, external              :: zmq_put_psi_det_size
   integer*8, external            :: zmq_put_psi_det
   integer*8, external            :: zmq_put_psi_coef
+  integer*8, external            :: zmq_put_psi_coef_complex
 
   zmq_put_psi = 0
   if (zmq_put_N_states(zmq_to_qp_run_socket, worker_id) == -1) then
@@ -31,11 +32,17 @@ integer function zmq_put_psi(zmq_to_qp_run_socket,worker_id)
     zmq_put_psi = -1
     return
   endif
+  if (is_complex) then
+    if (zmq_put_psi_coef_complex(zmq_to_qp_run_socket, worker_id) == -1) then
+      zmq_put_psi = -1
+      return
+    endif
+  else
   if (zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id) == -1) then
     zmq_put_psi = -1
     return
   endif
-
+  endif
 end
 
 
@@ -54,6 +61,7 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
   integer, external              :: zmq_get_psi_det_size
   integer*8, external            :: zmq_get_psi_det
   integer*8, external            :: zmq_get_psi_coef
+  integer*8, external            :: zmq_get_psi_coef_complex
 
   zmq_get_psi_notouch = 0
 
@@ -75,19 +83,35 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
     allocate(psi_det(N_int,2,psi_det_size))
   endif
 
+  if (is_complex) then
+    !todo: check this
+    if (size(psi_coef_complex,kind=8) /= psi_det_size*N_states) then
+      deallocate(psi_coef_complex)
+      allocate(psi_coef_complex(psi_det_size,N_states))
+    endif
+  else
   if (size(psi_coef,kind=8) /= psi_det_size*N_states) then
     deallocate(psi_coef)
     allocate(psi_coef(psi_det_size,N_states))
   endif
+  endif
 
   if (zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) == -1_8) then
     zmq_get_psi_notouch = -1
     return
   endif
+
+  if (is_complex) then
+    if (zmq_get_psi_coef_complex(zmq_to_qp_run_socket, worker_id) == -1_8) then
+      zmq_get_psi_notouch = -1
+      return
+    endif
+  else
   if (zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) == -1_8) then
     zmq_get_psi_notouch = -1
     return
   endif
+  endif
 
 end
 
@@ -102,8 +126,11 @@ integer function zmq_get_psi(zmq_to_qp_run_socket, worker_id)
   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)
+  if (is_complex) then
+    SOFT_TOUCH psi_det psi_coef_complex psi_det_size N_det N_states
+  else
   SOFT_TOUCH psi_det psi_coef psi_det_size N_det N_states
-
+  endif
 end
 
 
@@ -146,12 +173,20 @@ integer function zmq_put_psi_bilinear(zmq_to_qp_run_socket,worker_id)
     zmq_put_psi_bilinear = -1
     return
   endif
-
+  
+  if (is_complex) then
+    integer*8, external            :: zmq_put_psi_bilinear_matrix_values_complex
+    if (zmq_put_psi_bilinear_matrix_values_complex(zmq_to_qp_run_socket, worker_id) == -1) then
+      zmq_put_psi_bilinear = -1
+      return
+    endif
+  else
   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
+  endif
 
   integer, external            :: zmq_put_N_det_alpha_unique
   if (zmq_put_N_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
@@ -197,10 +232,17 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
 
   zmq_get_psi_bilinear= 0
 
+  if (is_complex) then
+    if (size(psi_bilinear_matrix_values_complex,kind=8) /= N_det*N_states) then
+      deallocate(psi_bilinear_matrix_values_complex)
+      allocate(psi_bilinear_matrix_values_complex(N_det,N_states))
+    endif
+  else
   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
+  endif
 
   if (size(psi_bilinear_matrix_rows,kind=8) /= N_det) then
     deallocate(psi_bilinear_matrix_rows)
@@ -216,12 +258,20 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
     deallocate(psi_bilinear_matrix_order)
     allocate(psi_bilinear_matrix_order(N_det))
   endif
-
+  
+  if (is_complex) then
+    integer*8, external            :: zmq_get_psi_bilinear_matrix_values_complex
+    if (zmq_get_psi_bilinear_matrix_values_complex(zmq_to_qp_run_socket, worker_id) == -1_8) then
+      zmq_get_psi_bilinear = -1
+      return
+    endif
+  else
   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
+  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
@@ -266,7 +316,11 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
     return
   endif
 
+  if (is_complex) then
+    SOFT_TOUCH psi_bilinear_matrix_values_complex psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef_complex psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique
+  else
   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
+  endif
 
 end
 
@@ -563,6 +617,69 @@ psi_bilinear_matrix_values ;;
 
 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_cdmatrix
+  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_cdmatrix(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_cdmatrix
+  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_cdmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) )
+  zmq_get_$X = rc8
+end
+
+SUBST [ X ]
+
+psi_coef_complex ;;
+psi_bilinear_matrix_values_complex ;;
+
+END_TEMPLATE
+
 
 !---------------------------------------------------------------------------
 

src/mpi/mpi.irp.f

@@ -93,6 +93,7 @@ SUBST [ double, type, 8, DOUBLE_PRECISION ]
 double    ; double precision  ; 8 ; DOUBLE_PRECISION ;;
 integer   ; integer           ; 4  ; INTEGER ;;
 integer8  ; integer*8         ; 8  ; INTEGER8 ;;
+complex_double  ; complex*16  ; 16 ; DOUBLE_COMPLEX ;;
 
 END_TEMPLATE
 

src/utils_complex/qp2-pbc-diff.txt

@@ -51,7 +51,11 @@ determinants:
            remaining functions aren't called anywhere, so don't worry about them for now
   (****) two_e_density_matrix.irp.pouet
   (done) utils.irp.f
-  (****) zmq.irp.f
+  (done?) zmq.irp.f
+           make sure template is correct for put/get psi_coef_complex
+           (why is limit 2^23? is this specific for doubles? should we divide by 2 for complex*16?)
+           also depends on zmq_{put,get}_cdmatrix in zmq/put_get.irp.f
+           and broadcast_chunks_complex_double in mpi/mpi.irp.f
 
 
 -------------------------------------------------------------------------------------

src/zmq/put_get.irp.f

@@ -443,6 +443,134 @@ integer function zmq_get_dmatrix(zmq_to_qp_run_socket, worker_id, name, x, size_
 end
 
 
+integer function zmq_put_cdmatrix(zmq_to_qp_run_socket, worker_id, name, x, size_x1, size_x2, sze)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Put a complex 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
+  complex*16, intent(in)         :: x(size_x1, size_x2)
+  integer*8                      :: rc, ni
+  integer                        :: j
+  character*(256)                :: msg
+
+  zmq_put_cdmatrix = 0
+
+  ni = size_x1
+  do j=1,size_x2
+    if (j == size_x2) then
+      ni = int(sze - int(j-1,8)*int(size_x1,8),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
+      print *,  trim(msg)
+      zmq_put_cdmatrix = -1
+      print *,  'Failed in put_data', rc, j
+      return
+    endif
+
+    rc = f77_zmq_send8(zmq_to_qp_run_socket,x(1,j),ni*8_8*2,0)
+    if (rc /= ni*8_8*2) then
+      print *,  'Failed in send ', rc, j
+      zmq_put_cdmatrix = -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 *,  trim(msg)
+      print *,  'Failed in recv ',  rc, j
+      zmq_put_cdmatrix = -1
+      return
+    endif
+  enddo
+
+end
+
+
+integer function zmq_get_cdmatrix(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
+  complex*16, intent(out)        :: x(size_x1,size_x2)
+  integer*8                      :: rc, ni
+  integer*8                      :: j
+  character*(256)                :: msg
+
+  PROVIDE zmq_state
+  ! Success
+  zmq_get_cdmatrix = 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
+        print *,  trim(msg)
+        zmq_get_cdmatrix = -1
+        print *,  irp_here, 'rc /= len(trim(msg))'
+        print *,  irp_here, '  received : ', rc
+        print *,  irp_here, '  expected : ', 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'
+        print *,  trim(msg)
+        zmq_get_cdmatrix = -1
+        go to 10
+      endif
+
+      rc = f77_zmq_recv8(zmq_to_qp_run_socket,x(1,j),ni*8_8*2,0)
+      if (rc /= ni*8_8*2) then
+        print *,  irp_here, 'rc /= size_x1*8*2 : ', trim(name)
+        print *,  irp_here, '  received: ', rc
+        print *,  irp_here, '  expected: ', ni*8_8*2
+        zmq_get_cdmatrix = -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_cdmatrix, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      print *,  irp_here//': Unable to broadcast zmq_get_cdmatrix'
+      stop -1
+    endif
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+    call broadcast_chunks_complex_double(x, sze)
+  IRP_ENDIF
+
+end
+
+
 
 integer function zmq_put8_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
   use f77_zmq