10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-08-25 05:51:46 +02:00

Introduce PT2 by generator in ZMQ

This commit is contained in:
Anthony Scemama 2016-05-29 23:24:18 +02:00
parent e2f4857b83
commit fbd2b11fc9
2 changed files with 36 additions and 14 deletions

View File

@ -400,6 +400,15 @@ class H_apply_zmq(H_apply):
norm_pert(k) = 0.d0 norm_pert(k) = 0.d0
H_pert_diag(k) = 0.d0 H_pert_diag(k) = 0.d0
norm_psi(k) = 0.d0 norm_psi(k) = 0.d0
enddo
"""
self.data["copy_buffer"] = """
do i=1,N_det_generators
do k=1,N_st
pt2(k) = pt2(k) + pt2_generators(k,i)
norm_pert(k) = norm_pert(k) + norm_pert_generators(k,i)
H_pert_diag(k) = H_pert_diag(k) + H_pert_diag_generators(k,i)
enddo
enddo enddo
""" """
@ -416,3 +425,4 @@ class H_apply_zmq(H_apply):
select_max(i_generator) = 0.d0 select_max(i_generator) = 0.d0
endif endif
""" """

View File

@ -27,6 +27,9 @@ subroutine $subroutine($params_main)
integer(ZMQ_PTR) :: zmq_socket_pair integer(ZMQ_PTR) :: zmq_socket_pair
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket
double precision, allocatable :: pt2_generators(:,:), norm_pert_generators(:,:)
double precision, allocatable :: H_pert_diag_generators(:,:)
call new_parallel_job(zmq_to_qp_run_socket,'$subroutine') call new_parallel_job(zmq_to_qp_run_socket,'$subroutine')
zmq_socket_pair = new_zmq_pair_socket(.True.) zmq_socket_pair = new_zmq_pair_socket(.True.)
@ -38,16 +41,20 @@ subroutine $subroutine($params_main)
call add_task_to_taskserver(zmq_to_qp_run_socket,task) call add_task_to_taskserver(zmq_to_qp_run_socket,task)
enddo enddo
allocate ( pt2_generators(N_states,N_det_generators), &
norm_pert_generators(N_states,N_det_generators), &
H_pert_diag_generators(N_states,N_det_generators) )
PROVIDE nproc N_states PROVIDE nproc N_states
!$OMP PARALLEL DEFAULT(NONE) & !$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE(i) & !$OMP PRIVATE(i) &
!$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id, i_generator) & !$OMP SHARED(zmq_socket_pair,N_states, pt2_generators, norm_pert_generators, H_pert_diag_generators, n, task_id, i_generator) &
!$OMP num_threads(nproc+1) !$OMP num_threads(nproc+1)
i = omp_get_thread_num() i = omp_get_thread_num()
if (i == 0) then if (i == 0) then
call $subroutine_collector() call $subroutine_collector()
integer :: n, task_id integer :: n, task_id
call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id) call pull_pt2(zmq_socket_pair, pt2_generators, norm_pert_generators, H_pert_diag_generators, i_generator, size(pt2_generators), n, task_id)
else else
call $subroutine_slave_inproc(i) call $subroutine_slave_inproc(i)
endif endif
@ -61,6 +68,7 @@ subroutine $subroutine($params_main)
$copy_buffer $copy_buffer
$generate_psi_guess $generate_psi_guess
deallocate ( pt2_generators, norm_pert_generators, H_pert_diag_generators)
end end
subroutine $subroutine_slave_tcp(iproc) subroutine $subroutine_slave_tcp(iproc)
@ -185,7 +193,7 @@ subroutine $subroutine_collector
use f77_zmq use f77_zmq
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Collects results from the selection ! Collects results from the selection in an array of generators
END_DOC END_DOC
integer :: k, rc integer :: k, rc
@ -201,12 +209,15 @@ subroutine $subroutine_collector
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
zmq_socket_pull = new_zmq_pull_socket() zmq_socket_pull = new_zmq_pull_socket()
double precision, allocatable :: pt2(:,:), norm_pert(:,:), H_pert_diag(:,:) double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
allocate ( pt2(N_states,2), norm_pert(N_states,2), H_pert_diag(N_states,2)) double precision, allocatable :: pt2_result(:,:), norm_pert_result(:,:), H_pert_diag_result(:,:)
allocate (pt2(N_states), norm_pert(N_states), H_pert_diag(N_states))
allocate (pt2_result(N_states,N_det_generators), norm_pert_result(N_states,N_det_generators), &
H_pert_diag_result(N_states,N_det_generators))
pt2 = 0.d0 pt2_result = 0.d0
norm_pert = 0.d0 norm_pert_result = 0.d0
H_pert_diag = 0.d0 H_pert_diag_result = 0.d0
accu = 0_8 accu = 0_8
more = 1 more = 1
do while (more == 1) do while (more == 1)
@ -214,9 +225,9 @@ subroutine $subroutine_collector
call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id) call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id)
if (n > 0) then if (n > 0) then
do k=1,N_states do k=1,N_states
pt2(k,2) = pt2(k,1) + pt2(k,2) pt2_result(k,i_generator) = pt2(k)
norm_pert(k,2) = norm_pert(k,1) + norm_pert(k,2) norm_pert_result(k,i_generator) = norm_pert(k)
H_pert_diag(k,2) = H_pert_diag(k,1) + H_pert_diag(k,2) H_pert_diag_result(k,i_generator) = H_pert_diag(k)
enddo enddo
accu = accu + 1_8 accu = accu + 1_8
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
@ -233,9 +244,10 @@ subroutine $subroutine_collector
socket_result = new_zmq_pair_socket(.False.) socket_result = new_zmq_pair_socket(.False.)
call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), i_generator, N_states,0) call push_pt2(socket_result, pt2_result, norm_pert_result, H_pert_diag_result, i_generator, &
N_states*N_det_generators,0)
deallocate ( pt2, norm_pert, H_pert_diag) deallocate (pt2, norm_pert, H_pert_diag, pt2_result, norm_pert_result, H_pert_diag_result)
call end_zmq_pair_socket(socket_result) call end_zmq_pair_socket(socket_result)