mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-26 14:31:44 +02:00
improved synchronization
This commit is contained in:
parent
c2343ae337
commit
727c9a84cd
@ -285,7 +285,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
call wall_time(time)
|
call wall_time(time)
|
||||||
|
|
||||||
print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, ''
|
print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, ''
|
||||||
if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. cur_cp == N_cp) then
|
if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. cur_cp == N_cp-4) then
|
||||||
! Termination
|
! Termination
|
||||||
print *, "TERMINATE"
|
print *, "TERMINATE"
|
||||||
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
|
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
|
||||||
@ -294,7 +294,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
print *, irp_here, ': Error in sending abort signal (2)'
|
print *, irp_here, ': Error in sending abort signal (2)'
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
!exit pullLoop
|
exit pullLoop
|
||||||
endif
|
endif
|
||||||
end if
|
end if
|
||||||
end do pullLoop
|
end do pullLoop
|
||||||
|
@ -11,6 +11,7 @@ END_PROVIDER
|
|||||||
|
|
||||||
subroutine run_dress_slave(thread,iproce,energy)
|
subroutine run_dress_slave(thread,iproce,energy)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
|
use omp_lib
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
double precision, intent(in) :: energy(N_states_diag)
|
double precision, intent(in) :: energy(N_states_diag)
|
||||||
@ -32,7 +33,6 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
integer :: ind
|
integer :: ind
|
||||||
|
|
||||||
double precision,allocatable :: delta_ij_loc(:,:,:)
|
double precision,allocatable :: delta_ij_loc(:,:,:)
|
||||||
double precision :: div(N_states)
|
|
||||||
integer :: h,p,n,i_state
|
integer :: h,p,n,i_state
|
||||||
logical :: ok
|
logical :: ok
|
||||||
|
|
||||||
@ -41,7 +41,7 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
integer(bit_kind), allocatable :: det_buf(:,:,:)
|
integer(bit_kind), allocatable :: det_buf(:,:,:)
|
||||||
integer :: N_buf(3)
|
integer :: N_buf(3)
|
||||||
logical :: last
|
logical :: last
|
||||||
integer, external :: omp_get_thread_num
|
!integer, external :: omp_get_thread_num
|
||||||
double precision, allocatable :: delta_det(:,:,:,:), cp(:,:,:,:)
|
double precision, allocatable :: delta_det(:,:,:,:), cp(:,:,:,:)
|
||||||
integer :: toothMwen
|
integer :: toothMwen
|
||||||
logical :: fracted
|
logical :: fracted
|
||||||
@ -60,24 +60,22 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
task(:) = CHAR(0)
|
task(:) = CHAR(0)
|
||||||
|
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
|
||||||
zmq_socket_push = new_zmq_push_socket(thread)
|
|
||||||
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
|
||||||
if(worker_id == -1) then
|
|
||||||
print *, "WORKER -1"
|
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
do i=1,N_states
|
|
||||||
div(i) = psi_coef(dressed_column_idx(i), i)
|
|
||||||
end do
|
|
||||||
|
|
||||||
integer :: iproc, cur_cp, done_for(0:N_cp)
|
integer :: iproc, cur_cp, done_for(0:N_cp)
|
||||||
integer, allocatable :: tasks(:)
|
integer, allocatable :: tasks(:)
|
||||||
integer :: lastCp(Nproc)
|
integer :: lastCp(Nproc)
|
||||||
integer :: lastSent, lastSendable
|
integer :: lastSent, lastSendable
|
||||||
logical :: send
|
logical :: send
|
||||||
|
integer(kind=OMP_LOCK_KIND) :: lck_det(0:comb_teeth+1)
|
||||||
|
integer(kind=OMP_LOCK_KIND) :: lck_sto(0:N_cp+1)
|
||||||
|
|
||||||
|
do i=0,N_cp+1
|
||||||
|
call omp_init_lock(lck_sto(i))
|
||||||
|
end do
|
||||||
|
do i=0,comb_teeth+1
|
||||||
|
call omp_init_lock(lck_det(i))
|
||||||
|
end do
|
||||||
|
|
||||||
lastCp = 0
|
lastCp = 0
|
||||||
lastSent = 0
|
lastSent = 0
|
||||||
send = .false.
|
send = .false.
|
||||||
@ -85,17 +83,30 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(SHARED) &
|
!$OMP PARALLEL DEFAULT(SHARED) &
|
||||||
!$OMP PRIVATE(int_buf, double_buf, det_buf, delta_ij_loc, task, task_id) &
|
!$OMP PRIVATE(int_buf, double_buf, det_buf, delta_ij_loc, task, task_id) &
|
||||||
!$OMP PRIVATE(toothMwen, fracted, fac) &
|
!$OMP PRIVATE(lastSendable, toothMwen, fracted, fac) &
|
||||||
!$OMP PRIVATE(send, i_generator, subset, iproc, N_buf)
|
!$OMP PRIVATE(i, cur_cp, send, i_generator, subset, iproc, N_buf) &
|
||||||
|
!$OMP PRIVATE(zmq_to_qp_run_socket, zmq_socket_push, worker_id)
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
|
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
|
if(worker_id == -1) then
|
||||||
|
print *, "WORKER -1"
|
||||||
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
stop "WORKER -1"
|
||||||
|
end if
|
||||||
|
|
||||||
|
|
||||||
iproc = omp_get_thread_num()+1
|
iproc = omp_get_thread_num()+1
|
||||||
allocate(int_buf(N_dress_int_buffer))
|
allocate(int_buf(N_dress_int_buffer))
|
||||||
allocate(double_buf(N_dress_double_buffer))
|
allocate(double_buf(N_dress_double_buffer))
|
||||||
allocate(det_buf(N_int, 2, N_dress_det_buffer))
|
allocate(det_buf(N_int, 2, N_dress_det_buffer))
|
||||||
allocate(delta_ij_loc(N_states,N_det,2))
|
allocate(delta_ij_loc(N_states,N_det,2))
|
||||||
do
|
do
|
||||||
!$OMP CRITICAL (SENDAGE)
|
!!1$OMP CRITICAL (SENDAGE)
|
||||||
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
||||||
!$OMP END CRITICAL (SENDAGE)
|
!!1$OMP END CRITICAL (SENDAGE)
|
||||||
task = task//" 0"
|
task = task//" 0"
|
||||||
if(task_id == 0) then
|
if(task_id == 0) then
|
||||||
print *, "DONEDONE"
|
print *, "DONEDONE"
|
||||||
@ -109,7 +120,7 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
send = .false.
|
send = .false.
|
||||||
lastSendable = N_cp*2
|
lastSendable = N_cp*2
|
||||||
do i=1,Nproc
|
do i=1,Nproc
|
||||||
lastSendable = min(lastCp(iproc), lastSendable)
|
lastSendable = min(lastCp(i), lastSendable)
|
||||||
end do
|
end do
|
||||||
lastSendable -= 1
|
lastSendable -= 1
|
||||||
if(lastSendable > lastSent) then
|
if(lastSendable > lastSent) then
|
||||||
@ -119,7 +130,7 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
!$OMP END CRITICAL
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
if(send) then
|
if(send) then
|
||||||
!$OMP CRITICAL
|
!!1$OMP CRITICAL
|
||||||
N_buf = (/0,1,0/)
|
N_buf = (/0,1,0/)
|
||||||
|
|
||||||
delta_ij_loc = 0d0
|
delta_ij_loc = 0d0
|
||||||
@ -131,12 +142,12 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
|
|
||||||
delta_ij_loc(:,:,:) = delta_ij_loc(:,:,:) / cps_N(cur_cp)
|
delta_ij_loc(:,:,:) = delta_ij_loc(:,:,:) / cps_N(cur_cp)
|
||||||
do i=cp_first_tooth(cur_cp)-1,0,-1
|
do i=cp_first_tooth(cur_cp)-1,0,-1
|
||||||
delta_ij_loc(:,:,:) = delta_ij_loc(:,:,:) +delta_det(:,:,i,:)
|
delta_ij_loc(:,:,:) = delta_ij_loc(:,:,:) +delta_det(:,:,i,:)
|
||||||
end do
|
end do
|
||||||
!$OMP END CRITICAL
|
!!1$OMP END CRITICAL
|
||||||
!$OMP CRITICAL (SENDAGE)
|
!!1$OMP CRITICAL (SENDAGE)
|
||||||
call push_dress_results(zmq_socket_push, done_for(cur_cp), cur_cp, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, -1)
|
call push_dress_results(zmq_socket_push, done_for(cur_cp), cur_cp, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, -1)
|
||||||
!$OMP END CRITICAL (SENDAGE)
|
!!1$OMP END CRITICAL (SENDAGE)
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
|
||||||
@ -148,13 +159,14 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
call alpha_callback(delta_ij_loc, i_generator, subset, iproc)
|
call alpha_callback(delta_ij_loc, i_generator, subset, iproc)
|
||||||
call generator_done(i_generator, int_buf, double_buf, det_buf, N_buf, iproc)
|
call generator_done(i_generator, int_buf, double_buf, det_buf, N_buf, iproc)
|
||||||
|
|
||||||
!if(.false.) then
|
!!1$OMP CRITICAL
|
||||||
!$OMP CRITICAL
|
|
||||||
do i=1,N_cp
|
do i=1,N_cp
|
||||||
fac = cps(i_generator, i) * dress_weight_inv(i_generator) * comb_step
|
fac = cps(i_generator, i) * dress_weight_inv(i_generator) * comb_step
|
||||||
if(fac == 0d0) cycle
|
if(fac == 0d0) cycle
|
||||||
|
call omp_set_lock(lck_sto(i))
|
||||||
cp(:,:,i,1) += (delta_ij_loc(:,:,1) * fac)
|
cp(:,:,i,1) += (delta_ij_loc(:,:,1) * fac)
|
||||||
cp(:,:,i,2) += (delta_ij_loc(:,:,2) * fac)
|
cp(:,:,i,2) += (delta_ij_loc(:,:,2) * fac)
|
||||||
|
call omp_unset_lock(lck_sto(i))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
|
||||||
@ -162,31 +174,41 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
fracted = (toothMwen /= 0)
|
fracted = (toothMwen /= 0)
|
||||||
if(fracted) fracted = (i_generator == first_det_of_teeth(toothMwen))
|
if(fracted) fracted = (i_generator == first_det_of_teeth(toothMwen))
|
||||||
if(fracted) then
|
if(fracted) then
|
||||||
|
call omp_set_lock(lck_det(toothMwen))
|
||||||
|
call omp_set_lock(lck_det(toothMwen-1))
|
||||||
delta_det(:,:,toothMwen-1, 1) += delta_ij_loc(:,:,1) * (1d0-fractage(toothMwen))
|
delta_det(:,:,toothMwen-1, 1) += delta_ij_loc(:,:,1) * (1d0-fractage(toothMwen))
|
||||||
delta_det(:,:,toothMwen-1, 2) += delta_ij_loc(:,:,2) * (1d0-fractage(toothMwen))
|
delta_det(:,:,toothMwen-1, 2) += delta_ij_loc(:,:,2) * (1d0-fractage(toothMwen))
|
||||||
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1) * (fractage(toothMwen))
|
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1) * (fractage(toothMwen))
|
||||||
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2) * (fractage(toothMwen))
|
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2) * (fractage(toothMwen))
|
||||||
|
call omp_unset_lock(lck_det(toothMwen))
|
||||||
|
call omp_unset_lock(lck_det(toothMwen-1))
|
||||||
else
|
else
|
||||||
|
call omp_set_lock(lck_det(toothMwen))
|
||||||
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1)
|
delta_det(:,:,toothMwen , 1) += delta_ij_loc(:,:,1)
|
||||||
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2)
|
delta_det(:,:,toothMwen , 2) += delta_ij_loc(:,:,2)
|
||||||
end if
|
call omp_unset_lock(lck_det(toothMwen))
|
||||||
|
end if
|
||||||
|
!!!&$OMP END CRITICAL
|
||||||
|
|
||||||
|
!!1$OMP CRITICAL (SENDAGE)
|
||||||
!$OMP END CRITICAL
|
|
||||||
!end if
|
|
||||||
|
|
||||||
!$OMP CRITICAL (SENDAGE)
|
|
||||||
call push_dress_results(zmq_socket_push, i_generator, -1, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, task_id)
|
call push_dress_results(zmq_socket_push, i_generator, -1, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, task_id)
|
||||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
||||||
!$OMP END CRITICAL (SENDAGE)
|
!!1$OMP END CRITICAL (SENDAGE)
|
||||||
lastCp(iproc) = done_cp_at_det(i_generator)
|
lastCp(iproc) = done_cp_at_det(i_generator)
|
||||||
end do
|
end do
|
||||||
!$OMP END PARALLEL
|
|
||||||
|
|
||||||
call sleep(10)
|
call sleep(10)
|
||||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
do i=0,N_cp+1
|
||||||
|
call omp_destroy_lock(lck_sto(i))
|
||||||
|
end do
|
||||||
|
do i=0,comb_teeth+1
|
||||||
|
call omp_destroy_lock(lck_det(i))
|
||||||
|
end do
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
@ -233,7 +255,7 @@ subroutine push_dress_results(zmq_socket_push, ind, cur_cp, delta_loc, int_buf,
|
|||||||
if(rc /= 8*N_states) stop "push"
|
if(rc /= 8*N_states) stop "push"
|
||||||
|
|
||||||
N_buf = N_bufi
|
N_buf = N_bufi
|
||||||
N_buf = (/0,1,0/)
|
!N_buf = (/0,1,0/)
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, N_buf, 4*3, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, N_buf, 4*3, ZMQ_SNDMORE)
|
||||||
if(rc /= 4*3) stop "push5"
|
if(rc /= 4*3) stop "push5"
|
||||||
|
Loading…
Reference in New Issue
Block a user