10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-25 05:43:47 +01:00

fixed custom buffers

This commit is contained in:
Yann Garniron 2018-04-04 11:32:27 +02:00
parent 4aa4c6c96e
commit 2e3c54e278
9 changed files with 142 additions and 100 deletions

View File

@ -45,7 +45,7 @@ subroutine run_dressing(N_st,energy)
do i=1,N_st
if(.true.) call write_double(6,ci_energy_dressed(i),"Energy")
enddo
call diagonalize_ci_dressed
if(.true.) call diagonalize_ci_dressed
E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
delta_E = (E_new - E_old)/dble(N_states)

View File

@ -6,6 +6,10 @@ subroutine dress_slave
read_wf = .False.
distributed_davidson = .False.
SOFT_TOUCH read_wf distributed_davidson
threshold_selectors = 1.d0
threshold_generators = 1d0
call provide_everything
call switch_qp_run_to_master
call run_wf
@ -67,6 +71,6 @@ subroutine dress_slave_tcp(i,energy)
integer, intent(in) :: i
logical :: lstop
lstop = .False.
call run_dress_slave(0,i,energy,lstop)
call run_dress_slave(0,i,energy)
end

View File

@ -211,7 +211,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
felem = N_det+1
pullLoop : do while (loop)
call pull_dress_results(zmq_socket_pull, ind, delta_loc(1,1,1,delta_loc_cur), int_buf, double_buf, det_buf, N_buf, task_id, felem_loc)
call dress_pulled(int_buf, double_buf, det_buf, N_buf)
call dress_pulled(ind, int_buf, double_buf, det_buf, N_buf)
felem = min(felem_loc, felem)
dress_mwen(:) = 0d0

View File

@ -2,6 +2,8 @@ subroutine dress_zmq()
implicit none
double precision, allocatable :: energy(:)
allocate (energy(N_states))
threshold_selectors = 1.d0
threshold_generators = 1d0
read_wf = .True.
SOFT_TOUCH read_wf

View File

@ -93,8 +93,8 @@ BEGIN_PROVIDER [ double precision, delta_ij_tmp, (N_states,N_det_delta_ij,2) ]
delta_ij_tmp = 0d0
E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion
threshold_selectors = 1.d0
threshold_generators = 1d0
!threshold_selectors = 1.d0
!:threshold_generators = 1d0
! if(errr /= 0d0) then
! errr = errr / 2d0
! else

View File

@ -36,6 +36,15 @@ subroutine run_dress_slave(thread,iproc,energy)
integer :: h,p,n,i_state
logical :: ok
integer, allocatable :: int_buf(:)
double precision, allocatable :: double_buf(:)
integer(bit_kind), allocatable :: det_buf(:,:,:)
integer :: N_buf(3)
allocate(int_buf(N_dress_int_buffer))
allocate(double_buf(N_dress_double_buffer))
allocate(det_buf(N_int, 2, N_dress_det_buffer))
allocate(delta_ij_loc(N_states,N_det,2))
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
@ -55,10 +64,11 @@ subroutine run_dress_slave(thread,iproc,energy)
if(task_id /= 0) then
read (task,*) subset, i_generator
delta_ij_loc = 0d0
call generator_start(i_generator, iproc)
call alpha_callback(delta_ij_loc, i_generator, subset, iproc)
call generator_done(i_generator)
call generator_done(i_generator, int_buf, double_buf, det_buf, N_buf, iproc)
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, task_id)
call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, int_buf, double_buf, det_buf, N_buf, task_id)
else
exit
end if
@ -69,23 +79,28 @@ subroutine run_dress_slave(thread,iproc,energy)
end subroutine
BEGIN_PROVIDER [ integer, dress_int_buffer, (N_dress_int_buffer) ]
&BEGIN_PROVIDER [ double precision, dress_double_buffer, (N_dress_double_buffer) ]
&BEGIN_PROVIDER [ integer(bit_kind), dress_det_buffer, (N_int, 2, N_dress_det_buffer) ]
implicit none
dress_int_buffer = 0
dress_double_buffer = 0d0
dress_det_buffer = 0_bit_kind
END_PROVIDER
! BEGIN_PROVIDER [ integer, dress_int_buffer, (N_dress_int_buffer) ]
!&BEGIN_PROVIDER [ double precision, dress_double_buffer, (N_dress_double_buffer) ]
!&BEGIN_PROVIDER [ integer(bit_kind), dress_det_buffer, (N_int, 2, N_dress_det_buffer) ]
! implicit none
!
! dress_int_buffer = 0
! dress_double_buffer = 0d0
! dress_det_buffer = 0_bit_kind
!END_PROVIDER
subroutine push_dress_results(zmq_socket_push, ind, delta_loc, task_id)
!subroutine pull_dress_results(zmq_socket_pull, ind, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, felem)
subroutine push_dress_results(zmq_socket_push, ind, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id)
use f77_zmq
implicit none
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
double precision, intent(in) :: delta_loc(N_states, N_det, 2)
double precision, intent(in) :: double_buf(*)
integer, intent(in) :: int_buf(*)
integer(bit_kind), intent(in) :: det_buf(N_int, 2, *)
integer, intent(in) :: N_buf(3)
integer, intent(in) :: ind, task_id
integer :: rc, i, j, felem
@ -115,28 +130,31 @@ subroutine push_dress_results(zmq_socket_push, ind, delta_loc, task_id)
rc = f77_zmq_send( zmq_socket_push, N_dress_int_buffer, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "push"
rc = f77_zmq_send( zmq_socket_push, N_buf, 4*3, ZMQ_SNDMORE)
if(rc /= 4*3) stop "push5"
rc = f77_zmq_send( zmq_socket_push, dress_int_buffer, 4*N_dress_int_buffer, ZMQ_SNDMORE)
if(rc /= 4*N_dress_int_buffer) stop "push"
if(N_buf(1) > N_dress_int_buffer) stop "run_dress_slave N_buf bad size?"
if(N_buf(2) > N_dress_double_buffer) stop "run_dress_slave N_buf bad size?"
if(N_buf(3) > N_dress_det_buffer) stop "run_dress_slave N_buf bad size?"
rc = f77_zmq_send( zmq_socket_push, N_dress_double_buffer, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "push"
rc = f77_zmq_send( zmq_socket_push, dress_double_buffer, 8*N_dress_double_buffer, ZMQ_SNDMORE)
if(rc /= 8*N_dress_double_buffer) stop "push"
rc = f77_zmq_send( zmq_socket_push, N_dress_det_buffer, 4, ZMQ_SNDMORE)
if(rc /= 4) stop "push"
if(N_buf(1) > 0) then
rc = f77_zmq_send( zmq_socket_push, int_buf, 4*N_buf(1), ZMQ_SNDMORE)
if(rc /= 4*N_buf(1)) stop "push6"
end if
rc = f77_zmq_send( zmq_socket_push, dress_det_buffer, 2*N_int*bit_kind*N_dress_det_buffer, ZMQ_SNDMORE)
if(rc /= 2*N_int*bit_kind*N_dress_det_buffer) stop "push"
if(N_buf(2) > 0) then
rc = f77_zmq_send( zmq_socket_push, double_buf, 8*N_buf(2), ZMQ_SNDMORE)
if(rc /= 8*N_buf(2)) stop "push8"
end if
if(N_buf(3) > 0) then
rc = f77_zmq_send( zmq_socket_push, det_buf, 2*N_int*bit_kind*N_buf(3), ZMQ_SNDMORE)
if(rc /= 2*N_int*bit_kind*N_buf(3)) stop "push10"
end if
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
if(rc /= 4) stop "push"
if(rc /= 4) stop "push11"
! Activate is zmq_socket_push is a REQ
IRP_IF ZMQ_PUSH
@ -164,49 +182,44 @@ subroutine pull_dress_results(zmq_socket_pull, ind, delta_loc, int_buf, double_b
rc = f77_zmq_recv( zmq_socket_pull, ind, 4, 0)
if(rc /= 4) stop "pull"
if(rc /= 4) stop "pulla"
rc = f77_zmq_recv( zmq_socket_pull, felem, 4, 0)
if(rc /= 4) stop "pull"
if(rc /= 4) stop "pullb"
delta_loc(:,:felem,:) = 0d0
rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,felem,1), N_states*8*(N_det+1-felem), 0)
if(rc /= 8*N_states*(N_det+1-felem)) stop "pull"
if(rc /= 8*N_states*(N_det+1-felem)) stop "pullc"
rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,felem,2), N_states*8*(N_det+1-felem), 0)
if(rc /= 8*N_states*(N_det+1-felem)) stop "pull"
if(rc /= 8*N_states*(N_det+1-felem)) stop "pulld"
rc = f77_zmq_recv( zmq_socket_pull, N_buf(1), 4, 0)
if(rc /= 4) stop "pull"
rc = f77_zmq_recv( zmq_socket_pull, N_buf, 4*3, 0)
if(rc /= 4*3) stop "pull"
if(N_buf(1) > N_dress_int_buffer) stop "run_dress_slave N_buf bad size?"
rc = f77_zmq_recv( zmq_socket_pull, int_buf, 4*N_buf(1), 0)
if(rc /= 4*N_buf(1)) stop "pull1"
rc = f77_zmq_recv( zmq_socket_pull, N_buf(2), 4, 0)
if(rc /= 4) stop "pull"
if(N_buf(2) > N_dress_double_buffer) stop "run_dress_slave N_buf bad size?"
rc = f77_zmq_recv( zmq_socket_pull, double_buf, 8*N_buf(2), 0)
if(rc /= 8*N_buf(2)) stop "pull2"
rc = f77_zmq_recv( zmq_socket_pull, N_buf(3), 4, 0)
if(rc /= 4) stop "pull"
if(N_buf(3) > N_dress_det_buffer) stop "run_dress_slave N_buf bad size?"
rc = f77_zmq_recv( zmq_socket_pull, det_buf, 2*N_int*bit_kind*N_buf(3), 0)
if(rc /= 2*N_int*bit_kind*N_buf(3)) stop "pull3"
if(N_buf(1) > 0) then
rc = f77_zmq_recv( zmq_socket_pull, int_buf, 4*N_buf(1), 0)
if(rc /= 4*N_buf(1)) stop "pull1"
end if
if(N_buf(2) > 0) then
rc = f77_zmq_recv( zmq_socket_pull, double_buf, 8*N_buf(2), 0)
if(rc /= 8*N_buf(2)) stop "pull2"
end if
if(N_buf(3) > 0) then
rc = f77_zmq_recv( zmq_socket_pull, det_buf, 2*N_int*bit_kind*N_buf(3), 0)
if(rc /= 2*N_int*bit_kind*N_buf(3)) stop "pull3"
end if
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
if(rc /= 4) stop "pull"
if(rc /= 4) stop "pull4"
! Activate is zmq_socket_pull is a REP
IRP_IF ZMQ_PUSH

View File

@ -11,7 +11,7 @@ program shifted_bk
PROVIDE psi_bilinear_matrix_transp_order
call diagonalize_CI()
!call diagonalize_CI()
call dress_zmq()
end

View File

@ -1,30 +1,21 @@
use selection_types
BEGIN_PROVIDER [ integer, N_dress_int_buffer ]
&BEGIN_PROVIDER [ integer, N_dress_double_buffer ]
&BEGIN_PROVIDER [ integer, N_dress_det_buffer ]
implicit none
N_dress_int_buffer = 1
N_dress_double_buffer = 1
N_dress_det_buffer = 1
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ]
&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ]
&BEGIN_PROVIDER [ integer, n_det_add ]
&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ]
&BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ]
&BEGIN_PROVIDER [ type(selection_buffer), sb, (Nproc) ]
&BEGIN_PROVIDER [ type(selection_buffer), global_sb ]
&BEGIN_PROVIDER [ type(selection_buffer), mini_sb ]
&BEGIN_PROVIDER [ double precision, N_det_increase_factor ]
implicit none
integer :: i
integer :: n_det_add
N_det_increase_factor = 1d0
current_generator_(:) = 0
n_det_add = max(1, int(float(N_det) * N_det_increase_factor))
call create_selection_buffer(n_det_add, n_det_add*2, global_sb)
call create_selection_buffer(n_det_add, n_det_add*2, mini_sb)
do i=1,Nproc
call create_selection_buffer(n_det_add, n_det_add*2, sb(i))
end do
@ -32,46 +23,82 @@ END_PROVIDER
a_s2_i = 0d0
END_PROVIDER
subroutine generator_done(i_gen)
BEGIN_PROVIDER [ integer, N_dress_int_buffer ]
&BEGIN_PROVIDER [ integer, N_dress_double_buffer ]
&BEGIN_PROVIDER [ integer, N_dress_det_buffer ]
implicit none
integer, intent(in) :: i_gen
N_dress_int_buffer = 1
N_dress_double_buffer = n_det_add
N_dress_det_buffer = n_det_add
END_PROVIDER
subroutine generator_done(i_gen, int_buf, double_buf, det_buf, N_buf, iproc)
implicit none
integer, intent(in) :: i_gen, iproc
integer, intent(out) :: int_buf(N_dress_int_buffer), N_buf(3)
double precision, intent(out) :: double_buf(N_dress_double_buffer)
integer(bit_kind), intent(out) :: det_buf(N_int, 2, N_dress_det_buffer)
integer :: i
!dress_int_buffer = ...
call sort_selection_buffer(sb(iproc))
det_buf(:,:,:sb(iproc)%cur) = sb(iproc)%det(:,:,:sb(iproc)%cur)
double_buf(:sb(iproc)%cur) = sb(iproc)%val(:sb(iproc)%cur)
if(sb(iproc)%cur > 0) then
!$OMP CRITICAL
call merge_selection_buffers(sb(iproc), mini_sb)
call sort_selection_buffer(mini_sb)
do i=1,Nproc
sb(i)%mini = min(sb(i)%mini, mini_sb%mini)
end do
!$OMP END CRITICAL
end if
N_buf(1) = 1
N_buf(2) = sb(iproc)%cur
N_buf(3) = sb(iproc)%cur
sb(iproc)%cur = 0
end subroutine
subroutine dress_pulled(int_buf, double_buf, det_buf, N_buf)
subroutine generator_start(i_gen, iproc)
implicit none
integer, intent(in) :: i_gen, iproc
integer :: i
call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int)
end subroutine
subroutine dress_pulled(ind, int_buf, double_buf, det_buf, N_buf)
use bitmasks
implicit none
integer, intent(in) :: N_buf(3)
integer, intent(in) :: ind, N_buf(3)
integer, intent(in) :: int_buf(*)
double precision, intent(in) :: double_buf(*)
integer(bit_kind), intent(in) :: det_buf(N_int,2,*)
integer :: i
do i=1,N_buf(2)
call add_to_selection_buffer(global_sb, det_buf(1,1,i), double_buf(i))
end do
end subroutine
subroutine delta_ij_done()
use bitmasks
implicit none
integer :: i, n_det_add, old_det_gen
integer :: i, old_det_gen
integer(bit_kind), allocatable :: old_generators(:,:,:)
allocate(old_generators(N_int, 2, N_det_generators))
old_generators(:,:,:) = psi_det_generators(:,:,:N_det_generators)
old_det_gen = N_det_generators
call sort_selection_buffer(sb(1))
do i=2,Nproc
call sort_selection_buffer(sb(i))
call merge_selection_buffers(sb(i), sb(1))
end do
call sort_selection_buffer(sb(1))
call fill_H_apply_buffer_no_selection(sb(1)%cur,sb(1)%det,N_int,0)
call sort_selection_buffer(global_sb)
call fill_H_apply_buffer_no_selection(global_sb%cur,global_sb%det,N_int,0)
call copy_H_apply_buffer_to_wf()
if (s2_eig.or.(N_states > 1) ) then
@ -226,17 +253,13 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
if(current_generator_(iproc) /= i_gen) then
current_generator_(iproc) = i_gen
call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int)
end if
haa = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int)
call dress_with_alpha_(Nstates, Ndet, Nint, delta_ij_loc, minilist, det_minilist, n_minilist, alpha, haa, contrib, iproc)
call add_to_selection_buffer(sb(iproc), alpha, contrib)
if(contrib < sb(iproc)%mini) then
call add_to_selection_buffer(sb(iproc), alpha, contrib)
end if
end subroutine

View File

@ -10,7 +10,7 @@ program shifted_bk
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
call diagonalize_CI()
!call diagonalize_CI()
call dress_slave()
end