LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-25 13:53:49 +01:00
Code Issues Releases Wiki Activity

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

Browse Source
This commit is contained in:
Anthony Scemama 2018-05-23 13:49:50 +02:00
commit a0850d34ad
2 changed files with 34 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
plugins/Full_CI_ZMQ/run_selection_slave.irp.f
View File

@ -50,8 +50,8 @@ subroutine run_selection_slave(thread,iproc,energy)
if (done) then if (done) then
ctask = ctask - 1 ctask = ctask - 1
else else
integer :: i_generator, N integer :: i_generator, N, subset
read(task,*) i_generator, N read(task,*) subset, i_generator, N
if(buf%N == 0) then if(buf%N == 0) then
! Only first time ! Only first time
call create_selection_buffer(N, N*2, buf) call create_selection_buffer(N, N*2, buf)
@ -60,7 +60,7 @@ subroutine run_selection_slave(thread,iproc,energy)
else else
ASSERT (N == buf%N) ASSERT (N == buf%N)
end if end if
call select_connected(i_generator,energy,pt2,buf,0) call select_connected(i_generator,energy,pt2,buf,subset)
endif endif
integer, external :: task_done_to_taskserver integer, external :: task_done_to_taskserver

46
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -10,7 +10,6 @@ subroutine ZMQ_selection(N_in, pt2)
integer :: i, N integer :: i, N
integer, external :: omp_get_thread_num integer, external :: omp_get_thread_num
double precision, intent(out) :: pt2(N_states) double precision, intent(out) :: pt2(N_states)
integer, parameter :: maxtasks=10000
PROVIDE fragment_count PROVIDE fragment_count
@ -21,7 +20,7 @@ subroutine ZMQ_selection(N_in, pt2)
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order PROVIDE psi_bilinear_matrix_transp_order fragment_count
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
@ -46,26 +45,40 @@ subroutine ZMQ_selection(N_in, pt2)
endif endif
integer, external :: add_task_to_taskserver integer, external :: add_task_to_taskserver
character*(20*maxtasks) :: task character(len=64000) :: task
integer :: j,k,ipos
ipos=1
task = ' ' task = ' '
integer :: k
k=0
do i= 1, N_det_generators do i= 1, N_det_generators
k = k+1 if (i>ishft(N_det_generators,-7)) then
write(task(20*(k-1)+1:20*k),'(I9,1X,I9,''|'')') i, N write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') 0, i, N
if (k>=maxtasks) then ipos += 30
k=0 if (ipos > 63970) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,task) == -1) then if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server' stop 'Unable to add task to task server'
endif endif
ipos=1
endif
else
do j=1,fragment_count
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N
ipos += 30
if (ipos > 63970) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server'
endif
ipos=1
endif
end do
endif endif
end do enddo
if (k > 0) then if (ipos > 1) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,task) == -1) then if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server' stop 'Unable to add task to task server'
endif endif
endif endif
ASSERT (associated(b%det)) ASSERT (associated(b%det))
ASSERT (associated(b%val)) ASSERT (associated(b%val))
@ -130,6 +143,9 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2)
integer(bit_kind), pointer :: det(:,:,:) integer(bit_kind), pointer :: det(:,:,:)
integer, allocatable :: task_id(:) integer, allocatable :: task_id(:)
type(selection_buffer) :: b2 type(selection_buffer) :: b2
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
call create_selection_buffer(N, N*2, b2) call create_selection_buffer(N, N*2, b2)