LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-20 12:12:13 +02:00
Code Issues Releases Wiki Activity

No more davidson on clients

Browse Source
This commit is contained in:
Anthony Scemama 2016-08-01 23:08:22 +02:00
parent 2dd38c0bdb
commit eb15a392be
6 changed files with 103 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
ocaml/TaskServer.ml
View File

@ -681,9 +681,10 @@ let run ~port =
in
(** Debug input *)
Printf.sprintf "%d %d : %s\n%!"
Printf.sprintf "q:%d r:%d n:%d : %s\n%!"
(Queuing_system.number_of_queued program_state.queue)
(Queuing_system.number_of_running program_state.queue)
(Queuing_system.number program_state.queue)
(Message.to_string message)
|> debug;

2
plugins/Full_CI_ZMQ/fci_zmq.irp.f
View File

@ -155,6 +155,6 @@ subroutine selection_dressing_slave_inproc(i)
implicit none
integer, intent(in) :: i
call selection_slaved(1,i)
call selection_slaved(1,i,ci_electronic_energy)
end

55
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -11,15 +11,16 @@ BEGIN_PROVIDER [ double precision, integral8, (mo_tot_num, mo_tot_num, mo_tot_n
END_PROVIDER
subroutine selection_slaved(thread,iproc)
subroutine selection_slaved(thread,iproc,energy)
use f77_zmq
use selection_types
implicit none
double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: thread, iproc
integer :: rc, i
integer :: worker_id, task_id(10), ctask, ltask
integer :: worker_id, task_id(1), ctask, ltask
character*(512) :: task
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
@ -61,7 +62,7 @@ subroutine selection_slaved(thread,iproc)
end if
!print *, "psi_selectors_coef ", psi_selectors_coef(N_det_selectors-5:N_det_selectors, 1)
!call debug_det(psi_selectors(1,1,N_det_selectors), N_int)
call select_connected(i_generator,ci_electronic_energy,pt2,buf)
call select_connected(i_generator,energy,pt2,buf)
endif
if(done .or. ctask == size(task_id)) then
@ -117,6 +118,8 @@ subroutine push_selection_results(zmq_socket_push, pt2, b, task_id, ntask)
rc = f77_zmq_send( zmq_socket_push, task_id(1), ntask*4, 0)
if(rc /= 4*ntask) stop "push"
! Activate is zmq_socket_push is a REQ
! rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0)
end subroutine
@ -131,23 +134,26 @@ subroutine pull_selection_results(zmq_socket_pull, pt2, val, det, N, task_id, nt
integer, intent(out) :: N, ntask, task_id(*)
integer :: rc, rn, i
rc = f77_zmq_recv( zmq_socket_pull, N, 4, ZMQ_SNDMORE)
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
if(rc /= 4) stop "pull"
rc = f77_zmq_recv( zmq_socket_pull, pt2, N_states*8, ZMQ_SNDMORE)
rc = f77_zmq_recv( zmq_socket_pull, pt2, N_states*8, 0)
if(rc /= 8*N_states) stop "pull"
rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, ZMQ_SNDMORE)
rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)
if(rc /= 8*N) stop "pull"
rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, ZMQ_SNDMORE)
rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)
if(rc /= bit_kind*N_int*2*N) stop "pull"
rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, ZMQ_SNDMORE)
rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0)
if(rc /= 4) stop "pull"
rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0)
if(rc /= 4*ntask) stop "pull"
! Activate is zmq_socket_pull is a REP
! rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0)
end subroutine
@ -293,7 +299,9 @@ subroutine selection_collector(b, pt2)
end do
do i=1, ntask
if(task_id(i) == 0) stop "Error in collector"
if(task_id(i) == 0) then
print *, "Error in collector"
endif
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
end do
done += ntask
@ -389,7 +397,7 @@ subroutine select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
call create_microlist_single(psi_selectors, i_generator, N_det_selectors, ion_det, microlist, idx_microlist, N_microlist, ptr_microlist, N_int)
do j=1, ptr_microlist(mo_tot_num * 2 + 1) - 1
psi_coef_microlist(j,:) = psi_selectors_coef(idx_microlist(j),:)
psi_coef_microlist(j,:) = psi_selectors_coef_transp(:,idx_microlist(j))
enddo
if(ptr_microlist(mo_tot_num * 2 + 1) == 1) then
@ -568,10 +576,10 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
do j=1, ptr_microlist(mo_tot_num * 2 + 1) - 1
psi_coef_microlist(j,:) = psi_selectors_coef(idx_microlist(j),:)
psi_coef_microlist(j,:) = psi_selectors_coef_transp(:,idx_microlist(j))
enddo
do j=1, ptr_tmicrolist(mo_tot_num * 2 + 1) - 1
psi_coef_tmicrolist(j,:) = psi_selectors_coef(idx_tmicrolist(j),:)
psi_coef_tmicrolist(j,:) = psi_selectors_coef_transp(:,idx_tmicrolist(j))
enddo
@ -1042,7 +1050,7 @@ subroutine create_microlist_double(minilist, i_cur, N_minilist, key_mask, microl
!!!! INTEGRAL DRIVEN
! !!!!!!!!!!!!!!!!!!!!
call get_d0(minilist(1,1,idx(i)), banned, banned_pair, d0s, key_mask, 1+(nt2-1)/mo_tot_num, 1+(nt-1)/mo_tot_num, &
mod(nt2-1, mo_tot_num)+1, mod(nt-1, mo_tot_num)+1, psi_selectors_coef(idx(i), :))
mod(nt2-1, mo_tot_num)+1, mod(nt-1, mo_tot_num)+1, psi_selectors_coef_transp(1,idx(i)))
! do j=1, N_states
! do nt2=1, mo_tot_num
@ -1062,7 +1070,7 @@ subroutine create_microlist_double(minilist, i_cur, N_minilist, key_mask, microl
end do
end do
call get_d1(minilist(1,1,idx(i)), banned, banned_pair, d0s, key_mask, pwen, psi_selectors_coef(idx(i), :))
call get_d1(minilist(1,1,idx(i)), banned, banned_pair, d0s, key_mask, pwen, psi_selectors_coef_transp(1,idx(i)))
! do k=1, N_states
! do nt2=1, mo_tot_num
@ -1094,6 +1102,7 @@ subroutine get_d1(gen, banned, banned_pair, mat, mask, pwen, coefs)
integer :: exc(0:2, 2, 2)
logical :: lbanned(mo_tot_num*2)
logical :: ok, mono, ab
integer :: tmp_array(4)
lbanned = banned
!mat = 0d0
@ -1145,12 +1154,14 @@ subroutine get_d1(gen, banned, banned_pair, mat, mask, pwen, coefs)
exc(1, 1, 2) = p(a1)
exc(1, 2, sfix) = pfix
call apply_particle(mask, (/0, 0 ,s(i), p(i) /), deth, ok, N_int)
tmp_array = (/0, 0 ,s(i), p(i) /)
call apply_particle(mask, tmp_array, deth, ok, N_int)
do j=1,mo_tot_num
mwen = j + (sm-1)*mo_tot_num
if(lbanned(mwen)) cycle
call apply_particle(deth, (/0,0,sm,j/), det, ok, N_int)
tmp_array = (/0,0,sm,j/)
call apply_particle(deth, tmp_array, det, ok, N_int)
if(.not. ok) cycle
mono = mwen == pwen(a1) .or. mwen == pwen(a2)
@ -1193,13 +1204,14 @@ subroutine get_d1(gen, banned, banned_pair, mat, mask, pwen, coefs)
exc(1, 1, sp) = min(h1, h2)
exc(2, 1, sp) = max(h1, h2)
call apply_particle(mask, (/0, 0 ,s(i), p(i) /), deth, ok, N_int)
tmp_array = (/0, 0 ,s(i), p(i) /)
call apply_particle(mask, tmp_array, deth, ok, N_int)
do j=1,mo_tot_num
if(j == pfix) inv = -inv
mwen = j + (sm-1)*mo_tot_num
if(lbanned(mwen)) cycle
call apply_particle(deth, (/0,0,sm,j/), det, ok, N_int)
call apply_particle(deth, tmp_array, det, ok, N_int)
if(.not. ok) cycle
mono = mwen == pwen(a1) .or. mwen == pwen(a2)
@ -1245,6 +1257,7 @@ subroutine get_d0(gen, banned, banned_pair, mat, mask, s1, s2, h1, h2, coefs)
integer :: p1, p2, hmi, hma, ns1, ns2, st
logical, external :: detEq
integer :: exc(0:2, 2, 2), exc2(0:2,2,2)
integer :: tmp_array(4)
exc = 0
! mat_mwen = integral8(:,:,h1,h2)
@ -1268,7 +1281,8 @@ subroutine get_d0(gen, banned, banned_pair, mat, mask, s1, s2, h1, h2, coefs)
if(banned(p1 + ns1)) cycle
if(p1 == p2) cycle
if(banned_pair(p1 + ns1, p2 + ns2)) cycle
call apply_particle(mask, (/s1,p1,s2,p2/), det2, ok, N_int)
tmp_array = (/s1,p1,s2,p2/)
call apply_particle(mask, tmp_array, det2, ok, N_int)
if(.not. ok) cycle
mono = (hmi == p1 .or. hma == p2 .or. hmi == p2 .or. hma == p1)
if(mono) then
@ -1299,7 +1313,8 @@ subroutine get_d0(gen, banned, banned_pair, mat, mask, s1, s2, h1, h2, coefs)
do p1=1, mo_tot_num
if(banned(p1 + ns1)) cycle
if(banned_pair(p1 + ns1, p2 + ns2)) cycle
call apply_particle(mask, (/s1,p1,s2,p2/), det2, ok, N_int)
tmp_array = (/s1,p1,s2,p2/)
call apply_particle(mask, tmp_array, det2, ok, N_int)
if(.not. ok) cycle
mono = (h1 == p1 .or. h2 == p2)
if(mono) then

50
plugins/Full_CI_ZMQ/selection_slave.irp.f
View File

@ -40,22 +40,7 @@ subroutine run_wf
call wait_for_state(zmq_state,state)
if(trim(state) /= 'selection') exit
print *, 'Getting wave function'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,size(energy))
integer :: j,k
do j=1,N_states_diag
do k=1,N_det
CI_eigenvectors(k,j) = psi_coef(k,j)
enddo
call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),CI_eigenvectors_s2(j))
enddo
if (.True.) then
do k=1,size(ci_electronic_energy)
ci_electronic_energy(k) = energy(k)
enddo
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
endif
call write_double(6,ci_energy,'Energy')
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
integer :: rc, i
@ -64,16 +49,39 @@ subroutine run_wf
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call selection_dressing_slave_tcp(i)
call selection_dressing_slave_tcp(i, energy)
!$OMP END PARALLEL
end do
end
subroutine selection_dressing_slave_tcp(i)
subroutine update_energy(energy)
implicit none
integer, intent(in) :: i
double precision, intent(in) :: energy(N_states_diag)
BEGIN_DOC
! Update energy when it is received from ZMQ
END_DOC
integer :: j,k
do j=1,N_states_diag
do k=1,N_det
CI_eigenvectors(k,j) = psi_coef(k,j)
enddo
call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),CI_eigenvectors_s2(j))
enddo
if (.True.) then
do k=1,size(ci_electronic_energy)
ci_electronic_energy(k) = energy(k)
enddo
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
endif
call selection_slaved(0,i)
call write_double(6,ci_energy,'Energy')
end
subroutine selection_dressing_slave_tcp(i,energy)
implicit none
double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: i
call selection_slaved(0,i,energy)
end

18
plugins/Selectors_full/selectors.irp.f
View File

@ -48,7 +48,21 @@ END_PROVIDER
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_selectors_diag_h_mat, (psi_selectors_size) ]
BEGIN_PROVIDER [ double precision, psi_selectors_coef_transp, (N_states,psi_selectors_size) ]
implicit none
BEGIN_DOC
! Transposed psi_selectors
END_DOC
integer :: i,k
do i=1,N_det_selectors
do k=1,N_states
psi_selectors_coef_transp(k,i) = psi_selectors_coef(i,k)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_selectors_diag_h_mat, (psi_selectors_size) ]
implicit none
BEGIN_DOC
! Diagonal elements of the H matrix for each selectors
@ -58,6 +72,6 @@ END_PROVIDER
do i = 1, N_det_selectors
psi_selectors_diag_h_mat(i) = diag_H_mat_elem(psi_selectors(1,1,i),N_int)
enddo
END_PROVIDER
END_PROVIDER

25
src/ZMQ/utils.irp.f
View File

@ -145,12 +145,12 @@ function new_zmq_to_qp_run_socket()
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 120000, 4)
if (rc /= 0) then
stop 'Unable to set send timout in new_zmq_to_qp_run_socket'
stop 'Unable to set send timeout in new_zmq_to_qp_run_socket'
endif
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 120000, 4)
if (rc /= 0) then
stop 'Unable to set recv timout in new_zmq_to_qp_run_socket'
stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket'
endif
rc = f77_zmq_connect(new_zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0)))
@ -247,7 +247,12 @@ function new_zmq_pull_socket()
stop 'Unable to set ZMQ_LINGER on pull socket'
endif
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,1000,4)
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVBUF,100000000,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_RCVBUF on pull socket'
endif
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,1,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_RCVHWM on pull socket'
endif
@ -295,11 +300,16 @@ function new_zmq_push_socket(thread)
stop 'Unable to set ZMQ_LINGER on push socket'
endif
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,1000,4)
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,1,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_SNDHWM on push socket'
endif
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDBUF,100000000,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_RCVBUF on push socket'
endif
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,1,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_IMMEDIATE on push socket'
@ -347,6 +357,11 @@ function new_zmq_sub_socket()
stop 'Unable to set timeout in new_zmq_sub_socket'
endif
rc = f77_zmq_setsockopt(new_zmq_sub_socket,ZMQ_CONFLATE,1,4)
if (rc /= 0) then
stop 'Unable to set conflate in new_zmq_sub_socket'
endif
rc = f77_zmq_setsockopt(new_zmq_sub_socket,ZMQ_SUBSCRIBE,"",0)
if (rc /= 0) then
stop 'Unable to subscribe new_zmq_sub_socket'
@ -431,7 +446,7 @@ subroutine end_zmq_pull_socket(zmq_socket_pull)
! stop 'error'
! endif
call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922
! call sleep(1) ! see https://github.com/zeromq/libzmq/issues/1922
! rc = f77_zmq_setsockopt(zmq_socket_pull,ZMQ_LINGER,10000,4)
! if (rc /= 0) then