LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-01 10:15:18 +02:00
Code Releases Activity

complex zmq determinants

Browse Source
This commit is contained in:
Kevin Gasperich 2020-02-24 16:36:56 -06:00
parent 3982ee4479
commit 338e793ed6
4 changed files with 255 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
src/determinants/zmq.irp.f
View File

@ -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
!---------------------------------------------------------------------------

1
src/mpi/mpi.irp.f
View File

@ -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

6
src/utils_complex/qp2-pbc-diff.txt
View File

@ -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
-------------------------------------------------------------------------------------

128
src/zmq/put_get.irp.f
View File

@ -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