mirror of
https://github.com/LCPQ/quantum_package
synced 2024-07-23 11:17:33 +02:00
fixed custom buffers
This commit is contained in:
Yann Garniron
parent
4aa4c6c96e
commit
2e3c54e278
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -11,7 +11,7 @@ program shifted_bk
|
||||
PROVIDE psi_bilinear_matrix_transp_order
|
||||
|
||||
|
||||
call diagonalize_CI()
|
||||
!call diagonalize_CI()
|
||||
call dress_zmq()
|
||||
end
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user