mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-25 05:43:47 +01:00
Retry with zmq_abort
This commit is contained in:
parent
2a54a2e449
commit
fadb96856d
@ -133,7 +133,7 @@ subroutine run_wf
|
||||
|
||||
call wall_time(t0)
|
||||
if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
|
||||
if (zmq_get_psi_bilinear(zmq_to_qp_run_socket,1) == -1) cycle
|
||||
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
|
||||
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) == -1) cycle
|
||||
|
||||
call wall_time(t1)
|
||||
|
@ -309,7 +309,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
||||
if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then
|
||||
stop 'Unable to put N_states_diag on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_psi_bilinear(zmq_to_qp_run_socket,1) == -1) then
|
||||
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
|
||||
stop 'Unable to put psi on ZMQ server'
|
||||
endif
|
||||
energy = 0.d0
|
||||
@ -323,7 +323,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
||||
|
||||
integer :: istep, imin, imax, ishift, ipos
|
||||
integer, external :: add_task_to_taskserver
|
||||
integer, parameter :: tasksize=20000
|
||||
integer, parameter :: tasksize=40000
|
||||
character*(100000) :: task
|
||||
istep=1
|
||||
ishift=0
|
||||
@ -372,7 +372,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
||||
integer*8 :: rc8
|
||||
double precision :: energy(N_st)
|
||||
|
||||
integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag, zmq_put_psi_bilinear
|
||||
integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag
|
||||
integer, external :: zmq_put_dmatrix
|
||||
|
||||
if (size(u_t) < 8388608) then
|
||||
@ -409,11 +409,22 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
||||
!$OMP END PARALLEL
|
||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'davidson')
|
||||
|
||||
!$OMP PARALLEL
|
||||
!$OMP SINGLE
|
||||
do k=1,N_st
|
||||
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
|
||||
call dset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||
!$OMP END TASK
|
||||
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
|
||||
call dset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||
!$OMP END TASK
|
||||
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
|
||||
call dset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||
!$OMP END TASK
|
||||
enddo
|
||||
!$OMP END SINGLE
|
||||
!$OMP TASKWAIT
|
||||
!$OMP END PARALLEL
|
||||
end
|
||||
|
||||
|
||||
|
@ -491,6 +491,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
|
||||
deallocate(u_1)
|
||||
endif
|
||||
double precision :: norm
|
||||
!$OMP PARALLEL DO PRIVATE(i,norm) DEFAULT(SHARED)
|
||||
do i=1,N_st
|
||||
norm = u_dot_u(u_0(1,i),n)
|
||||
if (norm /= 0.d0) then
|
||||
@ -499,6 +500,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
|
||||
e_0(i) = 0.d0
|
||||
endif
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
deallocate (s_0, v_0)
|
||||
end
|
||||
|
||||
|
@ -336,10 +336,9 @@ end subroutine
|
||||
! function.
|
||||
END_DOC
|
||||
|
||||
print *, '==> ', irp_here
|
||||
call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, &
|
||||
psi_det_sorted_bit, psi_coef_sorted_bit, N_states)
|
||||
print *, ' <== ', irp_here
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, det_out, coef_out, N_st)
|
||||
|
@ -80,11 +80,7 @@ BEGIN_TEMPLATE
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
double precision :: w0,w1
|
||||
call wall_time(w0)
|
||||
call i8sort(bit_tmp,iorder,N_det)
|
||||
call wall_time(w1)
|
||||
print *, '==> ', irp_here, w1-w0
|
||||
|
||||
N_det_$alpha_unique = 0
|
||||
last_key = 0_8
|
||||
|
@ -783,21 +783,31 @@ integer function zmq_abort(zmq_to_qp_run_socket)
|
||||
! Aborts a running parallel computation
|
||||
END_DOC
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||
integer :: rc, sze
|
||||
integer :: rc, sze, i
|
||||
integer, parameter :: count_max=60
|
||||
character*(512) :: message
|
||||
zmq_abort = 0
|
||||
|
||||
write(message,*) 'abort '
|
||||
|
||||
|
||||
sze = len(trim(message))
|
||||
do i=1,count_max
|
||||
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
|
||||
if (rc == sze) exit
|
||||
call sleep(1)
|
||||
enddo
|
||||
if (rc /= sze) then
|
||||
print *, 'zmq_abort: rc /= sze', rc, sze
|
||||
zmq_abort = -1
|
||||
return
|
||||
endif
|
||||
|
||||
do i=1,count_max
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
|
||||
if (trim(message(1:rc)) == 'ok') exit
|
||||
call sleep(1)
|
||||
enddo
|
||||
if (trim(message(1:rc)) /= 'ok') then
|
||||
print *, 'zmq_abort: ', rc, ':', trim(message(1:rc))
|
||||
zmq_abort = -1
|
||||
|
Loading…
Reference in New Issue
Block a user