10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00
quantum_package/plugins/Full_CI_ZMQ/selection_slave.irp.f

85 lines
2.0 KiB
Fortran
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) :: state
call provide_everything
zmq_context = f77_zmq_ctx_new ()
2016-08-01 17:15:03 +02:00
zmq_state = 'selection'
state = 'Waiting'
2016-08-01 16:05:40 +02:00
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
do
2016-08-01 17:15:03 +02:00
call wait_for_state(zmq_state,state)
if(trim(state) /= 'selection') exit
2016-08-01 16:05:40 +02:00
print *, 'Getting wave function'
2016-08-01 23:08:22 +02:00
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
2016-08-01 16:05:40 +02:00
integer :: rc, i
print *, 'Selection slave running'
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
2016-08-01 23:08:22 +02:00
call selection_dressing_slave_tcp(i, energy)
2016-08-01 16:05:40 +02:00
!$OMP END PARALLEL
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
2016-08-01 23:08:22 +02:00
subroutine selection_dressing_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