LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-03 10:05:57 +01:00
Code Issues Releases Wiki Activity

Fixed bug in u0Hu0

Browse Source
This commit is contained in:
Anthony Scemama 2017-05-15 12:33:41 +02:00
parent bdd1985ded
commit 1c3d8f6a09
6 changed files with 81 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
plugins/Full_CI_ZMQ/pt2_slave.irp.f
View File

@ -48,6 +48,11 @@ subroutine run_wf
print *, 'PT2'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call pt2_slave_tcp(i, energy)

5
plugins/Full_CI_ZMQ/run_selection_slave.irp.f
View File

@ -21,6 +21,11 @@ subroutine run_selection_slave(thread,iproc,energy)
logical :: done
double precision :: pt2(N_states)
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
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)

108
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -322,56 +322,60 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
call bitstring_to_list_ab(hole , hole_list , N_holes , N_int)
call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
! integer :: l_a, nmax
! integer, allocatable :: indices(:), exc_degree(:), iorder(:)
! allocate (indices(N_det), &
! exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
! k=1
! do i=1,N_det_alpha_unique
! call get_excitation_degree_spin(psi_det_alpha_unique(1,i), &
! psi_det_generators(1,1,i_generator), exc_degree(i), N_int)
! enddo
!
! do j=1,N_det_beta_unique
! call get_excitation_degree_spin(psi_det_beta_unique(1,j), &
! psi_det_generators(1,2,i_generator), nt, N_int)
! if (nt > 2) cycle
! do l_a=psi_bilinear_matrix_columns_loc(j), psi_bilinear_matrix_columns_loc(j+1)-1
! i = psi_bilinear_matrix_rows(l_a)
! if (nt + exc_degree(i) <= 4) then
! indices(k) = psi_det_sorted_order(psi_bilinear_matrix_order(l_a))
! k=k+1
! endif
! enddo
! enddo
!
! do i=1,N_det_beta_unique
! call get_excitation_degree_spin(psi_det_beta_unique(1,i), &
! psi_det_generators(1,2,i_generator), exc_degree(i), N_int)
! enddo
!
! do j=1,N_det_alpha_unique
! call get_excitation_degree_spin(psi_det_alpha_unique(1,j), &
! psi_det_generators(1,1,i_generator), nt, N_int)
! if (nt > 1) cycle
! do l_a=psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1
! i = psi_bilinear_matrix_transp_columns(l_a)
! if (exc_degree(i) < 3) cycle
! if (nt + exc_degree(i) <= 4) then
! indices(k) = psi_det_sorted_order( &
! psi_bilinear_matrix_order( &
! psi_bilinear_matrix_transp_order(l_a)))
! k=k+1
! endif
! enddo
! enddo
! nmax=k-1
! allocate(iorder(nmax))
! do i=1,nmax
! iorder(i) = i
! enddo
! call isort(indices,iorder,nmax)
integer :: l_a, nmax
integer, allocatable :: indices(:), exc_degree(:), iorder(:)
allocate (indices(N_det), &
exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
k=1
do i=1,N_det_alpha_unique
call get_excitation_degree_spin(psi_det_alpha_unique(1,i), &
psi_det_generators(1,1,i_generator), exc_degree(i), N_int)
enddo
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
do j=1,N_det_beta_unique
call get_excitation_degree_spin(psi_det_beta_unique(1,j), &
psi_det_generators(1,2,i_generator), nt, N_int)
if (nt > 2) cycle
do l_a=psi_bilinear_matrix_columns_loc(j), psi_bilinear_matrix_columns_loc(j+1)-1
i = psi_bilinear_matrix_rows(l_a)
if (nt + exc_degree(i) <= 4) then
indices(k) = psi_det_sorted_order(psi_bilinear_matrix_order(l_a))
k=k+1
endif
enddo
enddo
do i=1,N_det_beta_unique
call get_excitation_degree_spin(psi_det_beta_unique(1,i), &
psi_det_generators(1,2,i_generator), exc_degree(i), N_int)
enddo
do j=1,N_det_alpha_unique
call get_excitation_degree_spin(psi_det_alpha_unique(1,j), &
psi_det_generators(1,1,i_generator), nt, N_int)
if (nt > 1) cycle
do l_a=psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1
i = psi_bilinear_matrix_transp_columns(l_a)
if (exc_degree(i) < 3) cycle
if (nt + exc_degree(i) <= 4) then
indices(k) = psi_det_sorted_order( &
psi_bilinear_matrix_order( &
psi_bilinear_matrix_transp_order(l_a)))
k=k+1
endif
enddo
enddo
nmax=k-1
allocate(iorder(nmax))
do i=1,nmax
iorder(i) = i
enddo
call isort(indices,iorder,nmax)
preinteresting(0) = 0
prefullinteresting(0) = 0
@ -381,9 +385,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
negMask(i,2) = not(psi_det_generators(i,2,i_generator))
end do
! do k=1,nmax
! i = indices(k)
do i=1,N_det
do k=1,nmax
i = indices(k)
! do i=1,N_det
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i))
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))

8
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -17,8 +17,12 @@ subroutine ZMQ_selection(N_in, pt2)
N = max(N_in,1)
if (.True.) then
PROVIDE pt2_e0_denominator
provide nproc
PROVIDE pt2_e0_denominator nproc
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
call new_parallel_job(zmq_to_qp_run_socket,"selection")
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
call create_selection_buffer(N, N*2, b)

9
src/Davidson/u0Hu0.irp.f
View File

@ -270,7 +270,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
! Loop inside the beta column to gather all the connected alphas
l_a = k_a+1
nmax = min(N_det_alpha_unique, N_det - l_a)
nmax = min(N_det_alpha_unique, N_det - l_a+1)
do i=1,nmax
lcol = psi_bilinear_matrix_columns(l_a)
if (lcol /= kcol) exit
@ -288,6 +288,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
! Compute Hij for all alpha singles
! ----------------------------------
if (.False.) then
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol)
do i=1,n_singles_a
l_a = singles_a(i)
@ -300,6 +301,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
! single => sij = 0
enddo
enddo
endif
! Compute Hij for all alpha doubles
@ -317,7 +319,6 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
enddo
! Single and double beta excitations
! ==================================
@ -340,7 +341,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
! Loop inside the alpha row to gather all the connected betas
l_b = k_b+1
nmax = min(N_det_beta_unique, N_det - l_b)
nmax = min(N_det_beta_unique, N_det - l_b+1)
do i=1,nmax
lrow = psi_bilinear_matrix_transp_rows(l_b)
if (lrow /= krow) exit
@ -358,6 +359,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
! Compute Hij for all beta singles
! ----------------------------------
!if(.False.)then
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
do i=1,n_singles_b
l_b = singles_b(i)
@ -371,6 +373,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_0,s_0,u_t,N_st,sze,istart,iend,
! single => sij = 0
enddo
enddo
!endif
! Compute Hij for all beta doubles
! ----------------------------------

3
src/Davidson/u0Hu0_old.irp.f
View File

@ -496,10 +496,11 @@ subroutine H_S2_u_0_nstates_test(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze
! endif
! if ((degree == 2).and.(exc(0,1,1)==1)) cycle
! if ((degree > 1)) cycle
! if ((degree == 1)) cycle
! if (exc(0,1,2) /= 0) cycle
! if (exc(0,1,1) == 2) cycle
! if (exc(0,1,2) == 2) cycle
! if ((degree==1).and.(exc(0,1,2) == 1)) cycle
if ((degree==1).and.(exc(0,1,1) == 1)) cycle
call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij)
do l=1,N_st
!$OMP ATOMIC