LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-08 20:33:26 +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 2016-10-06 17:39:23 +02:00
commit 1de02c46e6
7 changed files with 91 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ocaml/TaskServer.ml
View File

@ -547,7 +547,6 @@ let terminate program_state rep_socket =
let error msg program_state rep_socket =
Printf.printf "%s\n%!" msg;
Message.Error (Message.Error_msg.create msg)
|> Message.to_string
|> ZMQ.Socket.send rep_socket ;

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

@ -23,31 +23,55 @@ subroutine run_wf
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
double precision :: energy(N_states_diag)
character*(64) :: state
character*(64) :: states(2)
integer :: rc, i
call provide_everything
zmq_context = f77_zmq_ctx_new ()
zmq_state = 'selection'
state = 'Waiting'
states(1) = 'selection'
states(2) = 'davidson'
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
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)
if(trim(zmq_state) == 'Stopped') then
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)
integer :: rc, i
print *, 'Selection slave running'
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call selection_dressing_slave_tcp(i, energy)
!$OMP END PARALLEL
!$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
end do
end

3
src/Davidson/davidson.irp.f
View File

@ -1,3 +0,0 @@
program davidson
stop 1
end

8
src/Davidson/davidson_slave.irp.f
View File

@ -8,7 +8,7 @@ program davidson_slave
double precision :: energy(N_states_diag)
character*(64) :: state
! call provide_everything
call provide_everything
call switch_qp_run_to_master
zmq_context = f77_zmq_ctx_new ()
@ -35,6 +35,6 @@ program davidson_slave
end do
end
! subroutine provide_everything
! PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context
! end subroutine
subroutine provide_everything
PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context
end subroutine

22
src/Davidson/diagonalization_hs2.irp.f
View File

@ -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
logical :: converged
double precision, allocatable :: overlap(:,:)
double precision :: u_dot_v, u_dot_u
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
sze_8 = align_double(sze)
double precision :: delta
if (s2_eig) then
delta = 1.d0
else
delta = 0.d0
endif
allocate( &
kl_pairs(2,N_st_diag*(N_st_diag+1)/2), &
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_tmp(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max), &
residual_norm(N_st_diag), &
overlap(N_st_diag,N_st_diag), &
c(N_st_diag*davidson_sze_max), &
s2(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_diag >= N_st)
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 ( &
kl_pairs, &
W, residual_norm, &
U, overlap, &
U, &
R, c, S, &
h, &
y, s_, s_tmp, &

4
src/Davidson/u0Hu0.irp.f
View File

@ -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)
do sh=shortcut(0,1),1,-1
workload += (shortcut(sh+1,1) - shortcut(sh,1))**2
if(workload > 10000) then
if(workload > 1000000) then
blocke = sh
call davidson_add_task(handler, blocke, blockb)
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
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)

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

@ -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