10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-04 02:16:02 +02:00
quantum_package/plugins/dress_zmq/dress_slave.irp.f

77 lines
1.9 KiB
Fortran
Raw Normal View History

2018-01-09 13:29:34 +01:00
subroutine dress_slave
2017-12-15 16:21:04 +01:00
implicit none
BEGIN_DOC
2018-02-27 18:43:07 +01:00
! Helper subroutine to compute the dress in distributed mode.
2017-12-15 16:21:04 +01:00
END_DOC
read_wf = .False.
distributed_davidson = .False.
SOFT_TOUCH read_wf distributed_davidson
2018-04-04 11:32:27 +02:00
threshold_selectors = 1.d0
threshold_generators = 1d0
2017-12-15 16:21:04 +01:00
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
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)
integer :: rc, i
2018-03-21 12:06:26 +01:00
2017-12-15 16:21:04 +01:00
call provide_everything
zmq_context = f77_zmq_ctx_new ()
states(1) = 'dress'
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
do
call wait_for_states(states,zmq_state,1)
2018-03-21 12:06:26 +01:00
if(zmq_state(:7) == 'Stopped') then
2017-12-15 16:21:04 +01:00
exit
2018-03-21 12:06:26 +01:00
else if (zmq_state(:5) == 'dress') then
2017-12-15 16:21:04 +01:00
! Selection
! ---------
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
2017-12-15 16:21:04 +01:00
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
2018-03-21 12:06:26 +01:00
call dress_slave_tcp(i+1, energy)
2017-12-15 16:21:04 +01:00
!$OMP END PARALLEL
print *, 'dress done'
endif
end do
end
subroutine dress_slave_tcp(i,energy)
implicit none
double precision, intent(in) :: energy(N_states_diag)
integer, intent(in) :: i
logical :: lstop
lstop = .False.
2018-04-04 11:32:27 +02:00
call run_dress_slave(0,i,energy)
2017-12-15 16:21:04 +01:00
end