10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-30 00:44:28 +02:00
quantum_package/plugins/Full_CI_ZMQ/selection_slave.irp.f

94 lines
2.1 KiB
FortranFixed
Raw Normal View History

2016-08-01 16:05:40 +02: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 ci_electronic_energy 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
double precision :: energy(N_states_diag)
character*(64) :: states(1)
2016-10-06 16:39:34 +02:00
integer :: rc, i
2016-08-01 16:05:40 +02:00
call provide_everything
zmq_context = f77_zmq_ctx_new ()
2016-10-06 16:39:34 +02:00
states(1) = 'selection'
2016-08-01 16:05:40 +02:00
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
do
2016-10-06 16:39:34 +02:00
call wait_for_states(states,zmq_state,1)
2016-10-06 16:39:34 +02:00
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)
2016-08-01 16:05:40 +02:00
2016-10-06 16:39:34 +02:00
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call selection_slave_tcp(i, energy)
2016-10-06 16:39:34 +02:00
!$OMP END PARALLEL
print *, 'Selection done'
endif
2016-08-01 16:05:40 +02:00
end do
end
2016-08-01 23:08:22 +02:00
subroutine update_energy(energy)
implicit none
double precision, intent(in) :: energy(N_states_diag)
BEGIN_DOC
! Update energy when it is received from ZMQ
END_DOC
integer :: j,k
2016-09-25 22:14:17 +02:00
do j=1,N_states
2016-08-01 23:08:22 +02:00
do k=1,N_det
CI_eigenvectors(k,j) = psi_coef(k,j)
enddo
enddo
2016-09-23 10:01:26 +02:00
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
2016-08-01 23:08:22 +02:00
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')
end
2016-08-01 16:05:40 +02:00
subroutine selection_slave_tcp(i,energy)
2016-08-01 16:05:40 +02:00
implicit none
2016-08-01 23:08:22 +02:00
double precision, intent(in) :: energy(N_states_diag)
2016-08-01 16:05:40 +02:00
integer, intent(in) :: i
2016-09-01 14:43:13 +02:00
call run_selection_slave(0,i,energy)
2016-08-01 16:05:40 +02:00
end