mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-24 13:23:41 +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,&
|
call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,&
|
||||||
size(CI_eigenvectors_dressed,1), CI_electronic_energy_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)
|
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
|
else if (diag_algorithm == "Lapack") then
|
||||||
|
|
||||||
@ -159,6 +156,7 @@ subroutine diagonalize_CI_dressed
|
|||||||
! eigenstates of the CI matrix
|
! eigenstates of the CI matrix
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
PROVIDE delta_ij
|
||||||
do j=1,N_states
|
do j=1,N_states
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
psi_coef(i,j) = CI_eigenvectors_dressed(i,j)
|
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))
|
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,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))
|
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
|
enddo
|
||||||
|
|
||||||
integer :: N_holes(2), N_particles(2)
|
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
|
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'
|
stop 'Unable to put state_average_weight on ZMQ server'
|
||||||
endif
|
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'
|
stop 'Unable to put dress_stoch_istate on ZMQ server'
|
||||||
endif
|
endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) then
|
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
|
integer, external :: zmq_delete_tasks, dress_find_sample
|
||||||
logical :: found
|
logical :: found
|
||||||
integer :: worker_id
|
integer :: worker_id
|
||||||
|
worker_id=1
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
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.
|
found = .false.
|
||||||
delta = 0d0
|
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
|
if(dabs(error / avg) <= relative_error) then
|
||||||
integer, external :: zmq_put_dvector
|
integer, external :: zmq_put_dvector
|
||||||
integer, external :: zmq_put_int
|
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.
|
found = .true.
|
||||||
end if
|
end if
|
||||||
else
|
else
|
||||||
@ -607,7 +607,6 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
|
|||||||
!end do
|
!end do
|
||||||
!print *, "SUM", E(1)+sum(edi(:))
|
!print *, "SUM", E(1)+sum(edi(:))
|
||||||
!print *, "DOT", E(1)+tmp
|
!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)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
@ -62,6 +62,7 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
cp_done = 0
|
cp_done = 0
|
||||||
cp_sent = 0
|
cp_sent = 0
|
||||||
will_send = 0
|
will_send = 0
|
||||||
|
cp_max(:) = 0
|
||||||
|
|
||||||
double precision :: hij, sij, tmp
|
double precision :: hij, sij, tmp
|
||||||
purge_task_id = 0
|
purge_task_id = 0
|
||||||
@ -76,7 +77,11 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
!$OMP PRIVATE(task_buf, ntask_buf,time, time0)
|
!$OMP PRIVATE(task_buf, ntask_buf,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_push = new_zmq_push_socket(thread)
|
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
|
if(worker_id == -1) then
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
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)
|
call push_dress_results(zmq_socket_push, 0, 0, edI_task, edI_index, breve_delta_m, task_buf, ntask_buf)
|
||||||
end if
|
end if
|
||||||
|
|
||||||
cp_max(:) = 0
|
!$OMP FLUSH
|
||||||
do while(cp_done > cp_sent .or. m /= dress_N_cp+1)
|
do while( (cp_done > cp_sent) .or. (m /= dress_N_cp+1) )
|
||||||
!$OMP CRITICAL (send)
|
!$OMP CRITICAL (send)
|
||||||
if(ntask_tbd == 0) then
|
if(ntask_tbd == 0) then
|
||||||
ntask_tbd = size(task_tbd)
|
ntask_tbd = size(task_tbd)
|
||||||
@ -233,7 +238,12 @@ subroutine run_dress_slave(thread,iproce,energy)
|
|||||||
end if
|
end if
|
||||||
|
|
||||||
!$OMP END SINGLE
|
!$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_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
!$OMP END PARALLEL
|
!$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)
|
call ezfio_set_determinants_mo_label(mo_label)
|
||||||
|
|
||||||
allocate (psi_det_save(N_int,2,ndet))
|
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 i=1,ndet
|
||||||
do j=1,2
|
do j=1,2
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
|
@ -62,17 +62,6 @@ subroutine occ_pattern_to_dets(o,d,sze,n_alpha,Nint)
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
call bitstring_to_list(o(1,1), list_todo, nt, Nint)
|
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
|
na = 0
|
||||||
nd = 0
|
nd = 0
|
||||||
|
Loading…
Reference in New Issue
Block a user