LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 12:23:48 +01:00
Code Issues Releases Wiki Activity

Fixed CAS_SD

Browse Source
This commit is contained in:
Anthony Scemama 2017-11-28 18:16:44 +01:00
parent ff8fcfa42b
commit e4080ce676
3 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
plugins/CAS_SD_ZMQ/selection.irp.f
View File

@ -1193,7 +1193,7 @@ subroutine ZMQ_selection(N_in, pt2)
implicit none implicit none
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
integer, intent(in) :: N_in integer, intent(in) :: N_in
type(selection_buffer) :: b type(selection_buffer) :: b
integer :: i, N integer :: i, N
@ -1204,12 +1204,17 @@ subroutine ZMQ_selection(N_in, pt2)
N = max(N_in,1) N = max(N_in,1)
if (.True.) then if (.True.) then
PROVIDE pt2_e0_denominator PROVIDE pt2_e0_denominator nproc
provide nproc PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
call new_parallel_job(zmq_to_qp_run_socket,"selection") PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator)) PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
call zmq_put_psi(zmq_to_qp_run_socket,1)
call zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) call zmq_put_N_det_generators(zmq_to_qp_run_socket, 1)
call zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) call zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1)
call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator))
call create_selection_buffer(N, N*2, b) call create_selection_buffer(N, N*2, b)
endif endif
@ -1234,20 +1239,25 @@ subroutine ZMQ_selection(N_in, pt2)
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
i = omp_get_thread_num() i = omp_get_thread_num()
if (i==0) then if (i==0) then
call selection_collector(b, pt2) call selection_collector(zmq_socket_pull, b, pt2)
else else
call selection_slave_inproc(i) call selection_slave_inproc(i)
endif endif
!$OMP END PARALLEL !$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, 'selection') call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection')
do i=N_det+1,N_states
pt2(i) = 0.d0
enddo
if (N_in > 0) then if (N_in > 0) then
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
call copy_H_apply_buffer_to_wf() call copy_H_apply_buffer_to_wf()
if (s2_eig) then if (s2_eig .or. (N_states > 1) ) then
call make_s2_eigenfunction call make_s2_eigenfunction
endif endif
call save_wavefunction call save_wavefunction
endif endif
call delete_selection_buffer(b)
end subroutine end subroutine
@ -1258,7 +1268,7 @@ subroutine selection_slave_inproc(i)
call run_selection_slave(1,i,pt2_e0_denominator) call run_selection_slave(1,i,pt2_e0_denominator)
end end
subroutine selection_collector(b, pt2) subroutine selection_collector(zmq_socket_pull, b, pt2)
use f77_zmq use f77_zmq
use selection_types use selection_types
use bitmasks use bitmasks
@ -1272,7 +1282,7 @@ subroutine selection_collector(b, pt2)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer(ZMQ_PTR) :: zmq_socket_pull integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
integer :: msg_size, rc, more integer :: msg_size, rc, more
integer :: acc, i, j, robin, N, ntask integer :: acc, i, j, robin, N, ntask
@ -1282,7 +1292,6 @@ subroutine selection_collector(b, pt2)
integer :: done integer :: done
real :: time, time0 real :: time, time0
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()
allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det)) allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det))
done = 0 done = 0
more = 1 more = 1
@ -1306,9 +1315,7 @@ subroutine selection_collector(b, pt2)
! print *, "DONE" , done, time - time0 ! print *, "DONE" , done, time - time0
end do end do
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_pull_socket(zmq_socket_pull)
call sort_selection_buffer(b) call sort_selection_buffer(b)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end subroutine end subroutine

12
plugins/CAS_SD_ZMQ/selection_buffer.irp.f
View File

@ -15,6 +15,18 @@ subroutine create_selection_buffer(N, siz, res)
res%cur = 0 res%cur = 0
end subroutine end subroutine
subroutine delete_selection_buffer(b)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
if (allocated(b%det)) then
deallocate(b%det)
endif
if (allocated(b%val)) then
deallocate(b%val)
endif
end
subroutine add_to_selection_buffer(b, det, val) subroutine add_to_selection_buffer(b, det, val)
use selection_types use selection_types

2
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -23,7 +23,7 @@ subroutine ZMQ_selection(N_in, pt2)
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order PROVIDE psi_bilinear_matrix_transp_order
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,"selection") call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
call zmq_put_psi(zmq_to_qp_run_socket,1) call zmq_put_psi(zmq_to_qp_run_socket,1)
call zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) call zmq_put_N_det_generators(zmq_to_qp_run_socket, 1)
call zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) call zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1)