10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-13 09:34:02 +01:00
quantum_package/plugins/CAS_SD_ZMQ/selection_cassd_slave.irp.f

94 lines
2.1 KiB
Fortran
Raw Normal View History

2016-11-16 14:52:12 +01:00
program selection_slave
implicit none
BEGIN_DOC
! Helper program to compute the PT2 in distributed mode.
END_DOC
read_wf = .False.
SOFT_TOUCH read_wf
call provide_everything
call switch_qp_run_to_master
call run_wf
end
subroutine provide_everything
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
PROVIDE pt2_e0_denominator mo_tot_num N_int
end
subroutine run_wf
use f77_zmq
implicit none
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
2016-11-16 15:18:24 +01:00
double precision :: energy(N_states)
2016-11-16 14:52:12 +01:00
character*(64) :: states(1)
integer :: rc, i
call provide_everything
zmq_context = f77_zmq_ctx_new ()
states(1) = 'selection'
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
do
call wait_for_states(states,zmq_state,1)
if(trim(zmq_state) == 'Stopped') then
exit
else if (trim(zmq_state) == 'selection') then
! Selection
! ---------
print *, 'Selection'
2016-11-16 15:18:24 +01:00
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
2016-11-16 14:52:12 +01:00
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call selection_slave_tcp(i, energy)
!$OMP END PARALLEL
print *, 'Selection done'
endif
end do
end
subroutine update_energy(energy)
implicit none
2016-11-16 15:18:24 +01:00
double precision, intent(in) :: energy(N_states)
2016-11-16 14:52:12 +01:00
BEGIN_DOC
! Update energy when it is received from ZMQ
END_DOC
integer :: j,k
do j=1,N_states
do k=1,N_det
CI_eigenvectors(k,j) = psi_coef(k,j)
enddo
enddo
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
if (.True.) then
2016-11-16 21:28:10 +01:00
do k=1,N_states
2016-11-16 14:52:12 +01:00
ci_electronic_energy(k) = energy(k)
enddo
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
endif
call write_double(6,ci_energy,'Energy')
end
subroutine selection_slave_tcp(i,energy)
implicit none
2016-11-16 15:18:24 +01:00
double precision, intent(in) :: energy(N_states)
2016-11-16 14:52:12 +01:00
integer, intent(in) :: i
call run_selection_slave(0,i,energy)
end