mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 14:01:46 +02:00
Merge branch 'master' of github.com:scemama/quantum_package
This commit is contained in:
commit
1de02c46e6
@ -547,7 +547,6 @@ let terminate program_state rep_socket =
|
|||||||
|
|
||||||
|
|
||||||
let error msg program_state rep_socket =
|
let error msg program_state rep_socket =
|
||||||
Printf.printf "%s\n%!" msg;
|
|
||||||
Message.Error (Message.Error_msg.create msg)
|
Message.Error (Message.Error_msg.create msg)
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> ZMQ.Socket.send rep_socket ;
|
|> ZMQ.Socket.send rep_socket ;
|
||||||
|
@ -23,31 +23,55 @@ subroutine run_wf
|
|||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
double precision :: energy(N_states_diag)
|
double precision :: energy(N_states_diag)
|
||||||
character*(64) :: state
|
character*(64) :: states(2)
|
||||||
|
integer :: rc, i
|
||||||
|
|
||||||
call provide_everything
|
call provide_everything
|
||||||
|
|
||||||
zmq_context = f77_zmq_ctx_new ()
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
zmq_state = 'selection'
|
states(1) = 'selection'
|
||||||
state = 'Waiting'
|
states(2) = 'davidson'
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
do
|
do
|
||||||
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,N_states_diag)
|
|
||||||
|
|
||||||
|
call wait_for_states(states,zmq_state,2)
|
||||||
|
|
||||||
integer :: rc, i
|
if(trim(zmq_state) == 'Stopped') then
|
||||||
|
|
||||||
print *, 'Selection slave running'
|
exit
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'selection') then
|
||||||
|
|
||||||
|
! Selection
|
||||||
|
! ---------
|
||||||
|
|
||||||
|
print *, 'Selection'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call selection_dressing_slave_tcp(i, energy)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'Selection done'
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'davidson') then
|
||||||
|
|
||||||
|
! Davidson
|
||||||
|
! --------
|
||||||
|
|
||||||
|
print *, 'Davidson'
|
||||||
|
call davidson_miniserver_get()
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call davidson_slave_tcp(i)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'Davidson done'
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
!$OMP PARALLEL PRIVATE(i)
|
|
||||||
i = omp_get_thread_num()
|
|
||||||
call selection_dressing_slave_tcp(i, energy)
|
|
||||||
!$OMP END PARALLEL
|
|
||||||
end do
|
end do
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1,3 +0,0 @@
|
|||||||
program davidson
|
|
||||||
stop 1
|
|
||||||
end
|
|
@ -8,7 +8,7 @@ program davidson_slave
|
|||||||
double precision :: energy(N_states_diag)
|
double precision :: energy(N_states_diag)
|
||||||
character*(64) :: state
|
character*(64) :: state
|
||||||
|
|
||||||
! call provide_everything
|
call provide_everything
|
||||||
call switch_qp_run_to_master
|
call switch_qp_run_to_master
|
||||||
|
|
||||||
zmq_context = f77_zmq_ctx_new ()
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
@ -35,6 +35,6 @@ program davidson_slave
|
|||||||
end do
|
end do
|
||||||
end
|
end
|
||||||
|
|
||||||
! subroutine provide_everything
|
subroutine provide_everything
|
||||||
! PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context
|
PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context
|
||||||
! end subroutine
|
end subroutine
|
||||||
|
@ -89,7 +89,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
|
|||||||
integer :: i,j,k,l,m
|
integer :: i,j,k,l,m
|
||||||
logical :: converged
|
logical :: converged
|
||||||
|
|
||||||
double precision, allocatable :: overlap(:,:)
|
|
||||||
double precision :: u_dot_v, u_dot_u
|
double precision :: u_dot_v, u_dot_u
|
||||||
|
|
||||||
integer, allocatable :: kl_pairs(:,:)
|
integer, allocatable :: kl_pairs(:,:)
|
||||||
@ -144,14 +143,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
|
|||||||
integer, external :: align_double
|
integer, external :: align_double
|
||||||
sze_8 = align_double(sze)
|
sze_8 = align_double(sze)
|
||||||
|
|
||||||
double precision :: delta
|
|
||||||
|
|
||||||
if (s2_eig) then
|
|
||||||
delta = 1.d0
|
|
||||||
else
|
|
||||||
delta = 0.d0
|
|
||||||
endif
|
|
||||||
|
|
||||||
allocate( &
|
allocate( &
|
||||||
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
|
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
|
||||||
W(sze_8,N_st_diag*davidson_sze_max), &
|
W(sze_8,N_st_diag*davidson_sze_max), &
|
||||||
@ -163,11 +154,20 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
|
|||||||
s_(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
s_(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
||||||
s_tmp(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
s_tmp(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
|
||||||
residual_norm(N_st_diag), &
|
residual_norm(N_st_diag), &
|
||||||
overlap(N_st_diag,N_st_diag), &
|
|
||||||
c(N_st_diag*davidson_sze_max), &
|
c(N_st_diag*davidson_sze_max), &
|
||||||
s2(N_st_diag*davidson_sze_max), &
|
s2(N_st_diag*davidson_sze_max), &
|
||||||
lambda(N_st_diag*davidson_sze_max))
|
lambda(N_st_diag*davidson_sze_max))
|
||||||
|
|
||||||
|
h = 0.d0
|
||||||
|
s_ = 0.d0
|
||||||
|
s_tmp = 0.d0
|
||||||
|
c = 0.d0
|
||||||
|
U = 0.d0
|
||||||
|
S = 0.d0
|
||||||
|
R = 0.d0
|
||||||
|
y = 0.d0
|
||||||
|
|
||||||
|
|
||||||
ASSERT (N_st > 0)
|
ASSERT (N_st > 0)
|
||||||
ASSERT (N_st_diag >= N_st)
|
ASSERT (N_st_diag >= N_st)
|
||||||
ASSERT (sze > 0)
|
ASSERT (sze > 0)
|
||||||
@ -425,7 +425,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
|
|||||||
deallocate ( &
|
deallocate ( &
|
||||||
kl_pairs, &
|
kl_pairs, &
|
||||||
W, residual_norm, &
|
W, residual_norm, &
|
||||||
U, overlap, &
|
U, &
|
||||||
R, c, S, &
|
R, c, S, &
|
||||||
h, &
|
h, &
|
||||||
y, s_, s_tmp, &
|
y, s_, s_tmp, &
|
||||||
|
@ -249,7 +249,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
|
|||||||
call davidson_init(handler)
|
call davidson_init(handler)
|
||||||
do sh=shortcut(0,1),1,-1
|
do sh=shortcut(0,1),1,-1
|
||||||
workload += (shortcut(sh+1,1) - shortcut(sh,1))**2
|
workload += (shortcut(sh+1,1) - shortcut(sh,1))**2
|
||||||
if(workload > 10000) then
|
if(workload > 1000000) then
|
||||||
blocke = sh
|
blocke = sh
|
||||||
call davidson_add_task(handler, blocke, blockb)
|
call davidson_add_task(handler, blocke, blockb)
|
||||||
blockb = sh-1
|
blockb = sh-1
|
||||||
@ -257,7 +257,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
|
|||||||
end if
|
end if
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if(blockb) call davidson_add_task(handler, 1, blockb)
|
if(blockb > 0) call davidson_add_task(handler, 1, blockb)
|
||||||
|
|
||||||
call davidson_run(handler, v_0, s_0)
|
call davidson_run(handler, v_0, s_0)
|
||||||
|
|
||||||
|
@ -881,3 +881,37 @@ end
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine wait_for_states(state_wait,state,n)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Wait for the ZMQ state to be ready
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n
|
||||||
|
character*(64), intent(in) :: state_wait(n)
|
||||||
|
character*(64), intent(out) :: state
|
||||||
|
integer(ZMQ_PTR) :: zmq_socket_sub
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_sub_socket
|
||||||
|
integer :: rc, i
|
||||||
|
logical :: condition
|
||||||
|
|
||||||
|
zmq_socket_sub = new_zmq_sub_socket()
|
||||||
|
state = 'Waiting'
|
||||||
|
condition = .True.
|
||||||
|
do while (condition)
|
||||||
|
rc = f77_zmq_recv( zmq_socket_sub, state, 64, 0)
|
||||||
|
if (rc > 0) then
|
||||||
|
state = trim(state(1:rc))
|
||||||
|
else
|
||||||
|
print *, 'Timeout reached. Stopping'
|
||||||
|
state = "Stopped"
|
||||||
|
endif
|
||||||
|
condition = trim(state) /= 'Stopped'
|
||||||
|
do i=1,n
|
||||||
|
condition = condition .and. (trim(state) /= trim(state_wait(i)))
|
||||||
|
enddo
|
||||||
|
end do
|
||||||
|
call end_zmq_sub_socket(zmq_socket_sub)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user