diff --git a/src/determinants/zmq.irp.f b/src/determinants/zmq.irp.f index 5a114533..ee8165da 100644 --- a/src/determinants/zmq.irp.f +++ b/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 + !--------------------------------------------------------------------------- diff --git a/src/mpi/mpi.irp.f b/src/mpi/mpi.irp.f index d947f1b9..41f303ea 100644 --- a/src/mpi/mpi.irp.f +++ b/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 diff --git a/src/utils_complex/qp2-pbc-diff.txt b/src/utils_complex/qp2-pbc-diff.txt index abec037c..cbe87d05 100644 --- a/src/utils_complex/qp2-pbc-diff.txt +++ b/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 ------------------------------------------------------------------------------------- diff --git a/src/zmq/put_get.irp.f b/src/zmq/put_get.irp.f index fce8722d..3985721d 100644 --- a/src/zmq/put_get.irp.f +++ b/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