mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-26 14:31:44 +02:00
fixed custom buffers
This commit is contained in:
parent
4aa4c6c96e
commit
2e3c54e278
@ -45,7 +45,7 @@ subroutine run_dressing(N_st,energy)
|
|||||||
do i=1,N_st
|
do i=1,N_st
|
||||||
if(.true.) call write_double(6,ci_energy_dressed(i),"Energy")
|
if(.true.) call write_double(6,ci_energy_dressed(i),"Energy")
|
||||||
enddo
|
enddo
|
||||||
call diagonalize_ci_dressed
|
if(.true.) call diagonalize_ci_dressed
|
||||||
E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
||||||
|
|
||||||
delta_E = (E_new - E_old)/dble(N_states)
|
delta_E = (E_new - E_old)/dble(N_states)
|
||||||
|
@ -6,6 +6,10 @@ subroutine dress_slave
|
|||||||
read_wf = .False.
|
read_wf = .False.
|
||||||
distributed_davidson = .False.
|
distributed_davidson = .False.
|
||||||
SOFT_TOUCH read_wf distributed_davidson
|
SOFT_TOUCH read_wf distributed_davidson
|
||||||
|
|
||||||
|
threshold_selectors = 1.d0
|
||||||
|
threshold_generators = 1d0
|
||||||
|
|
||||||
call provide_everything
|
call provide_everything
|
||||||
call switch_qp_run_to_master
|
call switch_qp_run_to_master
|
||||||
call run_wf
|
call run_wf
|
||||||
@ -67,6 +71,6 @@ subroutine dress_slave_tcp(i,energy)
|
|||||||
integer, intent(in) :: i
|
integer, intent(in) :: i
|
||||||
logical :: lstop
|
logical :: lstop
|
||||||
lstop = .False.
|
lstop = .False.
|
||||||
call run_dress_slave(0,i,energy,lstop)
|
call run_dress_slave(0,i,energy)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -211,7 +211,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
felem = N_det+1
|
felem = N_det+1
|
||||||
pullLoop : do while (loop)
|
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 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)
|
felem = min(felem_loc, felem)
|
||||||
dress_mwen(:) = 0d0
|
dress_mwen(:) = 0d0
|
||||||
|
|
||||||
|
@ -2,6 +2,8 @@ subroutine dress_zmq()
|
|||||||
implicit none
|
implicit none
|
||||||
double precision, allocatable :: energy(:)
|
double precision, allocatable :: energy(:)
|
||||||
allocate (energy(N_states))
|
allocate (energy(N_states))
|
||||||
|
threshold_selectors = 1.d0
|
||||||
|
threshold_generators = 1d0
|
||||||
|
|
||||||
read_wf = .True.
|
read_wf = .True.
|
||||||
SOFT_TOUCH read_wf
|
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
|
delta_ij_tmp = 0d0
|
||||||
|
|
||||||
E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion
|
E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion
|
||||||
threshold_selectors = 1.d0
|
!threshold_selectors = 1.d0
|
||||||
threshold_generators = 1d0
|
!:threshold_generators = 1d0
|
||||||
! if(errr /= 0d0) then
|
! if(errr /= 0d0) then
|
||||||
! errr = errr / 2d0
|
! errr = errr / 2d0
|
||||||
! else
|
! else
|
||||||
|
@ -36,6 +36,15 @@ subroutine run_dress_slave(thread,iproc,energy)
|
|||||||
integer :: h,p,n,i_state
|
integer :: h,p,n,i_state
|
||||||
logical :: ok
|
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))
|
allocate(delta_ij_loc(N_states,N_det,2))
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
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
|
if(task_id /= 0) then
|
||||||
read (task,*) subset, i_generator
|
read (task,*) subset, i_generator
|
||||||
delta_ij_loc = 0d0
|
delta_ij_loc = 0d0
|
||||||
|
call generator_start(i_generator, iproc)
|
||||||
call alpha_callback(delta_ij_loc, i_generator, subset, 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 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
|
else
|
||||||
exit
|
exit
|
||||||
end if
|
end if
|
||||||
@ -69,23 +79,28 @@ subroutine run_dress_slave(thread,iproc,energy)
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, dress_int_buffer, (N_dress_int_buffer) ]
|
! BEGIN_PROVIDER [ integer, dress_int_buffer, (N_dress_int_buffer) ]
|
||||||
&BEGIN_PROVIDER [ double precision, dress_double_buffer, (N_dress_double_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) ]
|
!&BEGIN_PROVIDER [ integer(bit_kind), dress_det_buffer, (N_int, 2, N_dress_det_buffer) ]
|
||||||
implicit none
|
! implicit none
|
||||||
|
!
|
||||||
dress_int_buffer = 0
|
! dress_int_buffer = 0
|
||||||
dress_double_buffer = 0d0
|
! dress_double_buffer = 0d0
|
||||||
dress_det_buffer = 0_bit_kind
|
! dress_det_buffer = 0_bit_kind
|
||||||
END_PROVIDER
|
!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
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
double precision, intent(in) :: delta_loc(N_states, N_det, 2)
|
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, intent(in) :: ind, task_id
|
||||||
integer :: rc, i, j, felem
|
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)
|
rc = f77_zmq_send( zmq_socket_push, N_buf, 4*3, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) stop "push"
|
if(rc /= 4*3) stop "push5"
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, dress_int_buffer, 4*N_dress_int_buffer, ZMQ_SNDMORE)
|
if(N_buf(1) > N_dress_int_buffer) stop "run_dress_slave N_buf bad size?"
|
||||||
if(rc /= 4*N_dress_int_buffer) stop "push"
|
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(N_buf(1) > 0) then
|
||||||
if(rc /= 4) stop "push"
|
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(N_buf(2) > 0) then
|
||||||
if(rc /= 2*N_int*bit_kind*N_dress_det_buffer) stop "push"
|
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)
|
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
|
! Activate is zmq_socket_push is a REQ
|
||||||
IRP_IF ZMQ_PUSH
|
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)
|
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)
|
rc = f77_zmq_recv( zmq_socket_pull, felem, 4, 0)
|
||||||
if(rc /= 4) stop "pull"
|
if(rc /= 4) stop "pullb"
|
||||||
|
|
||||||
delta_loc(:,:felem,:) = 0d0
|
delta_loc(:,:felem,:) = 0d0
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,felem,1), N_states*8*(N_det+1-felem), 0)
|
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)
|
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)
|
rc = f77_zmq_recv( zmq_socket_pull, N_buf, 4*3, 0)
|
||||||
if(rc /= 4) stop "pull"
|
if(rc /= 4*3) stop "pull"
|
||||||
if(N_buf(1) > N_dress_int_buffer) stop "run_dress_slave N_buf bad size?"
|
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?"
|
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?"
|
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(N_buf(1) > 0) then
|
||||||
if(rc /= 2*N_int*bit_kind*N_buf(3)) stop "pull3"
|
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)
|
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
|
! Activate is zmq_socket_pull is a REP
|
||||||
IRP_IF ZMQ_PUSH
|
IRP_IF ZMQ_PUSH
|
||||||
|
@ -11,7 +11,7 @@ program shifted_bk
|
|||||||
PROVIDE psi_bilinear_matrix_transp_order
|
PROVIDE psi_bilinear_matrix_transp_order
|
||||||
|
|
||||||
|
|
||||||
call diagonalize_CI()
|
!call diagonalize_CI()
|
||||||
call dress_zmq()
|
call dress_zmq()
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1,30 +1,21 @@
|
|||||||
use selection_types
|
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 [ 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_h_i, (N_det, Nproc) ]
|
||||||
&BEGIN_PROVIDER [ double precision, a_s2_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), sb, (Nproc) ]
|
||||||
|
&BEGIN_PROVIDER [ type(selection_buffer), global_sb ]
|
||||||
|
&BEGIN_PROVIDER [ type(selection_buffer), mini_sb ]
|
||||||
&BEGIN_PROVIDER [ double precision, N_det_increase_factor ]
|
&BEGIN_PROVIDER [ double precision, N_det_increase_factor ]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i
|
integer :: i
|
||||||
integer :: n_det_add
|
|
||||||
|
|
||||||
N_det_increase_factor = 1d0
|
N_det_increase_factor = 1d0
|
||||||
|
|
||||||
current_generator_(:) = 0
|
|
||||||
n_det_add = max(1, int(float(N_det) * N_det_increase_factor))
|
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
|
do i=1,Nproc
|
||||||
call create_selection_buffer(n_det_add, n_det_add*2, sb(i))
|
call create_selection_buffer(n_det_add, n_det_add*2, sb(i))
|
||||||
end do
|
end do
|
||||||
@ -32,46 +23,82 @@ END_PROVIDER
|
|||||||
a_s2_i = 0d0
|
a_s2_i = 0d0
|
||||||
END_PROVIDER
|
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
|
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
|
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
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer, intent(in) :: N_buf(3)
|
integer, intent(in) :: ind, N_buf(3)
|
||||||
integer, intent(in) :: int_buf(*)
|
integer, intent(in) :: int_buf(*)
|
||||||
double precision, intent(in) :: double_buf(*)
|
double precision, intent(in) :: double_buf(*)
|
||||||
integer(bit_kind), intent(in) :: det_buf(N_int,2,*)
|
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
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine delta_ij_done()
|
subroutine delta_ij_done()
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i, n_det_add, old_det_gen
|
integer :: i, old_det_gen
|
||||||
integer(bit_kind), allocatable :: old_generators(:,:,:)
|
integer(bit_kind), allocatable :: old_generators(:,:,:)
|
||||||
|
|
||||||
allocate(old_generators(N_int, 2, N_det_generators))
|
allocate(old_generators(N_int, 2, N_det_generators))
|
||||||
old_generators(:,:,:) = psi_det_generators(:,:,:N_det_generators)
|
old_generators(:,:,:) = psi_det_generators(:,:,:N_det_generators)
|
||||||
old_det_gen = N_det_generators
|
old_det_gen = N_det_generators
|
||||||
|
|
||||||
call sort_selection_buffer(sb(1))
|
|
||||||
|
|
||||||
do i=2,Nproc
|
call sort_selection_buffer(global_sb)
|
||||||
call sort_selection_buffer(sb(i))
|
call fill_H_apply_buffer_no_selection(global_sb%cur,global_sb%det,N_int,0)
|
||||||
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 copy_H_apply_buffer_to_wf()
|
call copy_H_apply_buffer_to_wf()
|
||||||
|
|
||||||
if (s2_eig.or.(N_states > 1) ) then
|
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)
|
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 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
|
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_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
PROVIDE psi_bilinear_matrix_transp_order
|
PROVIDE psi_bilinear_matrix_transp_order
|
||||||
|
|
||||||
call diagonalize_CI()
|
!call diagonalize_CI()
|
||||||
call dress_slave()
|
call dress_slave()
|
||||||
end
|
end
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user