mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 21:03:56 +01:00
Fixed shiftedBk
This commit is contained in:
parent
2058af1af5
commit
4a48a6b94f
@ -63,9 +63,6 @@ END_PROVIDER
|
||||
call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,&
|
||||
size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,&
|
||||
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1)
|
||||
! call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,&
|
||||
! N_states_diag,size(CI_eigenvectors_dressed,1))
|
||||
|
||||
|
||||
else if (diag_algorithm == "Lapack") then
|
||||
|
||||
@ -159,6 +156,7 @@ subroutine diagonalize_CI_dressed
|
||||
! eigenstates of the CI matrix
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
PROVIDE delta_ij
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
psi_coef(i,j) = CI_eigenvectors_dressed(i,j)
|
||||
|
@ -81,10 +81,6 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index
|
||||
hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index))
|
||||
particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index))
|
||||
particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index))
|
||||
!hole (k,1) = iand(psi_det_generators(k,1,i_generator), full_ijkl_bitmask(k))
|
||||
!hole (k,2) = iand(psi_det_generators(k,2,i_generator), full_ijkl_bitmask(k))
|
||||
!particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), full_ijkl_bitmask(k))
|
||||
!particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), full_ijkl_bitmask(k))
|
||||
enddo
|
||||
|
||||
integer :: N_holes(2), N_particles(2)
|
||||
|
@ -284,7 +284,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,"state_average_weight",state_average_weight,N_states) == -1) then
|
||||
stop 'Unable to put state_average_weight on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_int(zmq_to_qp_run_socket,1,"dress_stoch_istate",dress_stoch_istate) == -1) then
|
||||
if (zmq_put_int(zmq_to_qp_run_socket,1,'dress_stoch_istate',dress_stoch_istate) == -1) then
|
||||
stop 'Unable to put dress_stoch_istate on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) then
|
||||
@ -483,9 +483,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
||||
integer, external :: zmq_delete_tasks, dress_find_sample
|
||||
logical :: found
|
||||
integer :: worker_id
|
||||
worker_id=1
|
||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||
|
||||
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,1)
|
||||
|
||||
found = .false.
|
||||
delta = 0d0
|
||||
@ -542,7 +542,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
||||
if(dabs(error / avg) <= relative_error) then
|
||||
integer, external :: zmq_put_dvector
|
||||
integer, external :: zmq_put_int
|
||||
i= zmq_put_int(zmq_to_qp_run_socket, worker_id, "ending", (m-1))
|
||||
i= zmq_put_int(zmq_to_qp_run_socket, worker_id, 'ending', (m-1))
|
||||
found = .true.
|
||||
end if
|
||||
else
|
||||
@ -607,7 +607,6 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
||||
!end do
|
||||
!print *, "SUM", E(1)+sum(edi(:))
|
||||
!print *, "DOT", E(1)+tmp
|
||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id)
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
end subroutine
|
||||
|
||||
|
@ -62,6 +62,7 @@ subroutine run_dress_slave(thread,iproce,energy)
|
||||
cp_done = 0
|
||||
cp_sent = 0
|
||||
will_send = 0
|
||||
cp_max(:) = 0
|
||||
|
||||
double precision :: hij, sij, tmp
|
||||
purge_task_id = 0
|
||||
@ -76,7 +77,11 @@ subroutine run_dress_slave(thread,iproce,energy)
|
||||
!$OMP PRIVATE(task_buf, ntask_buf,time, time0)
|
||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||
zmq_socket_push = new_zmq_push_socket(thread)
|
||||
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||
integer, external :: connect_to_taskserver
|
||||
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
|
||||
print *, irp_here, ': Unable to connect to task server'
|
||||
stop -1
|
||||
endif
|
||||
if(worker_id == -1) then
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||
@ -91,8 +96,8 @@ subroutine run_dress_slave(thread,iproce,energy)
|
||||
call push_dress_results(zmq_socket_push, 0, 0, edI_task, edI_index, breve_delta_m, task_buf, ntask_buf)
|
||||
end if
|
||||
|
||||
cp_max(:) = 0
|
||||
do while(cp_done > cp_sent .or. m /= dress_N_cp+1)
|
||||
!$OMP FLUSH
|
||||
do while( (cp_done > cp_sent) .or. (m /= dress_N_cp+1) )
|
||||
!$OMP CRITICAL (send)
|
||||
if(ntask_tbd == 0) then
|
||||
ntask_tbd = size(task_tbd)
|
||||
@ -233,7 +238,12 @@ subroutine run_dress_slave(thread,iproce,energy)
|
||||
end if
|
||||
|
||||
!$OMP END SINGLE
|
||||
call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id)
|
||||
|
||||
integer, external :: disconnect_from_taskserver
|
||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||
print *, irp_here, ': Unable to disconnect from task server'
|
||||
stop -1
|
||||
endif
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||
!$OMP END PARALLEL
|
||||
|
@ -1,9 +0,0 @@
|
||||
module selection_types
|
||||
type selection_buffer
|
||||
integer :: N, cur
|
||||
integer(8) , pointer :: det(:,:,:)
|
||||
double precision, pointer :: val(:)
|
||||
double precision :: mini
|
||||
endtype
|
||||
end module
|
||||
|
@ -536,7 +536,7 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
||||
call ezfio_set_determinants_mo_label(mo_label)
|
||||
|
||||
allocate (psi_det_save(N_int,2,ndet))
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k) SHARED(psi_det_save,psidet,ndet,N_int)
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k) SHARED(psi_det_save,psidet,ndet,N_int,accu_norm)
|
||||
do i=1,ndet
|
||||
do j=1,2
|
||||
do k=1,N_int
|
||||
|
@ -62,17 +62,6 @@ subroutine occ_pattern_to_dets(o,d,sze,n_alpha,Nint)
|
||||
enddo
|
||||
|
||||
call bitstring_to_list(o(1,1), list_todo, nt, Nint)
|
||||
! nt = 0
|
||||
! ishift = 2
|
||||
! do i=1,Nint
|
||||
! l = o(i,1)
|
||||
! do while (l /= 0_bit_kind)
|
||||
! nt = nt+1
|
||||
! list_todo(nt) = ishift+popcnt(l-1_bit_kind) - popcnt(l)
|
||||
! l = iand(l,l-1_bit_kind)
|
||||
! enddo
|
||||
! ishift = ishift + bit_kind_size
|
||||
! enddo
|
||||
|
||||
na = 0
|
||||
nd = 0
|
||||
|
Loading…
Reference in New Issue
Block a user