LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-09-01 05:33:40 +02:00
Code Releases Activity

Compare commits

base: LCPQ:e3779e3c634d8485f59c6ad7b38c7e45e3b881bd
Branches Tags
LCPQ:master
LCPQ:torus
LCPQ:dev-stable
LCPQ:dev-spher_harm
LCPQ:macos
LCPQ:dev-stable-tc-scf
LCPQ:dev-stable-rdm
LCPQ:bugfix
LCPQ:dev-stable-pt-charges
LCPQ:dev-broken
LCPQ:good-dev-tc
LCPQ:guix
LCPQ:dev-tc
LCPQ:cleaning_dft
LCPQ:trexio
LCPQ:dev-pbc
LCPQ:csf
LCPQ:v1j4y-patch-2
LCPQ:TApplencourt-patch-1
LCPQ:kpts-patch-1
LCPQ:cleaning_kpts
LCPQ:features_kpts
LCPQ:kgasperich-patch-2
LCPQ:kgasperich-patch-1
LCPQ:features_periodic
LCPQ:features_spack
LCPQ:daily-test
LCPQ:biblio
LCPQ:features_casscf
LCPQ:gh-pages
LCPQ:v2.2.2
LCPQ:v2.1.1
LCPQ:v0.10-kpts
LCPQ:v0.9-kpts
LCPQ:v0.8-kpts
LCPQ:v0.7-kpts
LCPQ:v0.6-kpts
LCPQ:v0.5-kpts
LCPQ:v0.4-kpts
LCPQ:v0.3-kpts
LCPQ:v0.2-kpts
LCPQ:v0.1-kpts
LCPQ:v0.0-kpts
LCPQ:2.1.2
LCPQ:2.1.1
LCPQ:2.1.0
LCPQ:2.0.0
LCPQ:v2.0.0-beta
..
compare: LCPQ:919662ee0b64abb6a20a3e61c1d1bb261fcb05c4
Branches Tags
LCPQ:torus
LCPQ:dev-stable
LCPQ:master
LCPQ:dev-spher_harm
LCPQ:macos
LCPQ:dev-stable-tc-scf
LCPQ:dev-stable-rdm
LCPQ:bugfix
LCPQ:dev-stable-pt-charges
LCPQ:dev-broken
LCPQ:good-dev-tc
LCPQ:guix
LCPQ:dev-tc
LCPQ:cleaning_dft
LCPQ:trexio
LCPQ:dev-pbc
LCPQ:csf
LCPQ:v1j4y-patch-2
LCPQ:TApplencourt-patch-1
LCPQ:kpts-patch-1
LCPQ:cleaning_kpts
LCPQ:features_kpts
LCPQ:kgasperich-patch-2
LCPQ:kgasperich-patch-1
LCPQ:features_periodic
LCPQ:features_spack
LCPQ:daily-test
LCPQ:biblio
LCPQ:features_casscf
LCPQ:gh-pages
LCPQ:v2.2.2
LCPQ:v2.1.1
LCPQ:v0.10-kpts
LCPQ:v0.9-kpts
LCPQ:v0.8-kpts
LCPQ:v0.7-kpts
LCPQ:v0.6-kpts
LCPQ:v0.5-kpts
LCPQ:v0.4-kpts
LCPQ:v0.3-kpts
LCPQ:v0.2-kpts
LCPQ:v0.1-kpts
LCPQ:v0.0-kpts
LCPQ:2.1.2
LCPQ:2.1.1
LCPQ:2.1.0
LCPQ:2.0.0
LCPQ:v2.0.0-beta

No commits in common. "e3779e3c634d8485f59c6ad7b38c7e45e3b881bd" and "919662ee0b64abb6a20a3e61c1d1bb261fcb05c4" have entirely different histories.
e3779e3c63 ... 919662ee0b

7 changed files with 466 additions and 605 deletions
Show Stats Expand all files Collapse all files

1
src/bitmask/core_inact_act_virt.irp.f
View File

@ -322,7 +322,6 @@ END_PROVIDER
enddo enddo
print *, 'Active MOs:' print *, 'Active MOs:'
print *, list_act(1:n_act_orb) print *, list_act(1:n_act_orb)
print*, list_act_reverse(1:n_act_orb)
END_PROVIDER END_PROVIDER

2
src/two_body_rdm/all_2rdm_routines.irp.f
View File

@ -392,7 +392,7 @@ subroutine all_two_rdm_dm_nstates_work_$N_int(big_array_aa,big_array_bb,big_arra
c_1(l) = u_t(l,l_a) c_1(l) = u_t(l,l_a)
c_2(l) = u_t(l,k_a) c_2(l) = u_t(l,k_a)
enddo enddo
call off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_1,c_2,big_array_bb,dim1,dim2,dim3,dim4) call off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_1,c_2,big_array_bb,dim1,dim2,dim3,dim4)
ASSERT (l_a <= N_det) ASSERT (l_a <= N_det)
enddo enddo

2
src/two_body_rdm/all_states_routines.irp.f
View File

@ -442,7 +442,7 @@ subroutine orb_range_all_states_two_rdm_work_$N_int(big_array,dim1,norb,list_orb
c_2(l) = u_t(l,k_a) c_2(l) = u_t(l,k_a)
c_contrib(l) = c_1(l) * c_2(l) c_contrib(l) = c_1(l) * c_2(l)
enddo enddo
call orb_range_off_diagonal_double_to_two_rdm_bb_dm_all_states(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_double_to_two_rdm_bb_dm_all_states(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
ASSERT (l_a <= N_det) ASSERT (l_a <= N_det)
enddo enddo

4
src/two_body_rdm/orb_range_routines.irp.f
View File

@ -30,7 +30,6 @@ subroutine orb_range_two_rdm_state_av(big_array,dim1,norb,list_orb,list_orb_reve
u_t, & u_t, &
size(u_t, 1), & size(u_t, 1), &
N_det, N_st) N_det, N_st)
call orb_range_two_rdm_state_av_work(big_array,dim1,norb,list_orb,list_orb_reverse,state_weights,ispin,u_t,N_st,sze,1,N_det,0,1) call orb_range_two_rdm_state_av_work(big_array,dim1,norb,list_orb,list_orb_reverse,state_weights,ispin,u_t,N_st,sze,1,N_det,0,1)
deallocate(u_t) deallocate(u_t)
@ -136,7 +135,6 @@ subroutine orb_range_two_rdm_state_av_work_$N_int(big_array,dim1,norb,list_orb,l
stop stop
endif endif
PROVIDE N_int PROVIDE N_int
call list_to_bitstring( orb_bitmask, list_orb, norb, N_int) call list_to_bitstring( orb_bitmask, list_orb, norb, N_int)
@ -445,7 +443,7 @@ subroutine orb_range_two_rdm_state_av_work_$N_int(big_array,dim1,norb,list_orb,l
c_2(l) = u_t(l,k_a) c_2(l) = u_t(l,k_a)
c_average += c_1(l) * c_2(l) * state_weights(l) c_average += c_1(l) * c_2(l) * state_weights(l)
enddo enddo
call orb_range_off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
ASSERT (l_a <= N_det) ASSERT (l_a <= N_det)
enddo enddo

56
src/two_body_rdm/orb_range_routines_openmp.irp.f
View File

@ -93,9 +93,11 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1) double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
integer :: i,j,k,l integer :: i,j,k,l
integer :: k_a, k_b, l_a, l_b integer :: k_a, k_b, l_a, l_b, m_a, m_b
integer :: krow, kcol integer :: istate
integer :: krow, kcol, krow_b, kcol_b
integer :: lrow, lcol integer :: lrow, lcol
integer :: mrow, mcol
integer(bit_kind) :: spindet($N_int) integer(bit_kind) :: spindet($N_int)
integer(bit_kind) :: tmp_det($N_int,2) integer(bit_kind) :: tmp_det($N_int,2)
integer(bit_kind) :: tmp_det2($N_int,2) integer(bit_kind) :: tmp_det2($N_int,2)
@ -107,6 +109,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
integer, allocatable :: singles_b(:) integer, allocatable :: singles_b(:)
integer, allocatable :: idx(:), idx0(:) integer, allocatable :: idx(:), idx0(:)
integer :: maxab, n_singles_a, n_singles_b, kcol_prev integer :: maxab, n_singles_a, n_singles_b, kcol_prev
integer*8 :: k8
double precision :: c_average double precision :: c_average
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
@ -133,11 +136,16 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
stop stop
endif endif
!do i = 1, N_int
! det_1_act(i,1) = iand(det_1(i,1),orb_bitmask(i))
! det_1_act(i,2) = iand(det_1(i,2),orb_bitmask(i))
!enddo
PROVIDE N_int PROVIDE N_int
call list_to_bitstring( orb_bitmask, list_orb, norb, N_int) call list_to_bitstring( orb_bitmask, list_orb, norb, N_int)
sze_buff = norb ** 3 + 6 * norb sze_buff = norb ** 3
list_orb_reverse = -1000 list_orb_reverse = -1000
do i = 1, norb do i = 1, norb
list_orb_reverse(list_orb(i)) = i list_orb_reverse(list_orb(i)) = i
@ -165,13 +173,13 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
! !$OMP psi_bilinear_matrix_columns_loc, & ! !$OMP psi_bilinear_matrix_columns_loc, &
! !$OMP psi_bilinear_matrix_transp_rows_loc, & ! !$OMP psi_bilinear_matrix_transp_rows_loc, &
! !$OMP istart, iend, istep, irp_here, v_t, s_t, & ! !$OMP istart, iend, istep, irp_here, v_t, s_t, &
! !$OMP ishift, idx0, u_t, maxab, alpha_alpha,beta_beta,alpha_beta,spin_trace,ispin) & ! !$OMP ishift, idx0, u_t, maxab) &
! !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i,& ! !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i,&
! !$OMP lcol, lrow, l_a, l_b, & ! !$OMP lcol, lrow, l_a, l_b, &
! !$OMP buffer, doubles, n_doubles, & ! !$OMP buffer, doubles, n_doubles, &
! !$OMP tmp_det2, idx, l, kcol_prev, & ! !$OMP tmp_det2, idx, l, kcol_prev, &
! !$OMP singles_a, n_singles_a, singles_b, & ! !$OMP singles_a, n_singles_a, singles_b, &
! !$OMP n_singles_b, nkeys, keys, valus, c_average) ! !$OMP n_singles_b, k8)
! Alpha/Beta double excitations ! Alpha/Beta double excitations
! ============================= ! =============================
@ -345,17 +353,9 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
enddo enddo
if(alpha_beta.or.spin_trace.or.alpha_alpha)then if(alpha_beta.or.spin_trace.or.alpha_alpha)then
! increment the alpha/beta part for single excitations ! increment the alpha/beta part for single excitations
if (nkeys+ 2 * norb .ge. size(values)) then !!!! call orb_range_off_diagonal_single_to_two_rdm_ab_dm(tmp_det, tmp_det2,c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
endif
call orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
! increment the alpha/alpha part for single excitations ! increment the alpha/alpha part for single excitations
if (nkeys+4 * norb .ge. size(values)) then !!!! call orb_range_off_diagonal_single_to_two_rdm_aa_dm(tmp_det,tmp_det2,c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
endif
call orb_range_off_diag_single_to_two_rdm_aa_dm_buffer(tmp_det,tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
endif endif
enddo enddo
@ -378,11 +378,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
c_2(l) = u_t(l,k_a) c_2(l) = u_t(l,k_a)
c_average += c_1(l) * c_2(l) * state_weights(l) c_average += c_1(l) * c_2(l) * state_weights(l)
enddo enddo
if (nkeys+4 .ge. size(values)) then !!!! call orb_range_off_diagonal_double_to_two_rdm_aa_dm(tmp_det(1,1),psi_det_alpha_unique(1, lrow),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
endif
call orb_range_off_diag_double_to_two_rdm_aa_dm_buffer(tmp_det(1,1),psi_det_alpha_unique(1, lrow),c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
enddo enddo
endif endif
@ -449,17 +445,9 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
enddo enddo
if(alpha_beta.or.spin_trace.or.beta_beta)then if(alpha_beta.or.spin_trace.or.beta_beta)then
! increment the alpha/beta part for single excitations ! increment the alpha/beta part for single excitations
if (nkeys+2 * norb .ge. size(values)) then !!!! call orb_range_off_diagonal_single_to_two_rdm_ab_dm(tmp_det, tmp_det2,c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
endif
call orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
! increment the beta /beta part for single excitations ! increment the beta /beta part for single excitations
if (nkeys+4 * norb .ge. size(values)) then !!!! call orb_range_off_diagonal_single_to_two_rdm_bb_dm(tmp_det, tmp_det2,c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
endif
call orb_range_off_diag_single_to_two_rdm_bb_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
endif endif
enddo enddo
@ -481,11 +469,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
c_2(l) = u_t(l,k_a) c_2(l) = u_t(l,k_a)
c_average += c_1(l) * c_2(l) * state_weights(l) c_average += c_1(l) * c_2(l) * state_weights(l)
enddo enddo
if (nkeys+4 .ge. size(values)) then !!!! call orb_range_off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
endif
call orb_range_off_diag_double_to_two_rdm_bb_dm_buffer(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
ASSERT (l_a <= N_det) ASSERT (l_a <= N_det)
enddo enddo
@ -525,7 +509,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
end do end do
!!$OMP END DO !!$OMP END DO
deallocate(buffer, singles_a, singles_b, doubles, idx, keys, values) deallocate(buffer, singles_a, singles_b, doubles, idx)
!!$OMP END PARALLEL !!$OMP END PARALLEL
end end

38
src/two_body_rdm/routines_compute_2rdm_orb_range.irp.f
View File

@ -13,7 +13,7 @@
double precision, intent(in) :: c_1 double precision, intent(in) :: c_1
integer :: occ(N_int*bit_kind_size,2) integer :: occ(N_int*bit_kind_size,2)
integer :: n_occ_ab(2) integer :: n_occ_ab(2)
integer :: i,j,h1,h2 integer :: i,j,h1,h2,istate
call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int) call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int)
do i = 1, n_occ_ab(1) do i = 1, n_occ_ab(1)
h1 = occ(i,1) h1 = occ(i,1)
@ -53,7 +53,7 @@
integer :: occ(N_int*bit_kind_size,2) integer :: occ(N_int*bit_kind_size,2)
integer :: n_occ_ab(2) integer :: n_occ_ab(2)
integer :: i,j,h1,h2 integer :: i,j,h1,h2,istate
integer(bit_kind) :: det_1_act(N_int,2) integer(bit_kind) :: det_1_act(N_int,2)
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
do i = 1, N_int do i = 1, N_int
@ -193,7 +193,7 @@
integer(bit_kind), intent(in) :: orb_bitmask(N_int) integer(bit_kind), intent(in) :: orb_bitmask(N_int)
integer, intent(in) :: list_orb_reverse(mo_num) integer, intent(in) :: list_orb_reverse(mo_num)
double precision, intent(in) :: c_1 double precision, intent(in) :: c_1
integer :: i,j,h1,h2,p1,p2 integer :: i,j,h1,h2,p1,p2,istate
integer :: exc(0:2,2,2) integer :: exc(0:2,2,2)
double precision :: phase double precision :: phase
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
@ -278,7 +278,7 @@
integer :: occ(N_int*bit_kind_size,2) integer :: occ(N_int*bit_kind_size,2)
integer :: n_occ_ab(2) integer :: n_occ_ab(2)
integer :: i,j,h1,h2,p1 integer :: i,j,h1,h2,istate,p1
integer :: exc(0:2,2,2) integer :: exc(0:2,2,2)
double precision :: phase double precision :: phase
@ -397,7 +397,7 @@
integer :: occ(N_int*bit_kind_size,2) integer :: occ(N_int*bit_kind_size,2)
integer :: n_occ_ab(2) integer :: n_occ_ab(2)
integer :: i,j,h1,h2,p1 integer :: i,j,h1,h2,istate,p1
integer :: exc(0:2,2,2) integer :: exc(0:2,2,2)
double precision :: phase double precision :: phase
@ -477,7 +477,7 @@
integer :: occ(N_int*bit_kind_size,2) integer :: occ(N_int*bit_kind_size,2)
integer :: n_occ_ab(2) integer :: n_occ_ab(2)
integer :: i,j,h1,h2,p1 integer :: i,j,h1,h2,istate,p1
integer :: exc(0:2,2,2) integer :: exc(0:2,2,2)
double precision :: phase double precision :: phase
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
@ -510,16 +510,18 @@
p1 = exc(1,2,2) p1 = exc(1,2,2)
if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
p1 = list_orb_reverse(p1) p1 = list_orb_reverse(p1)
do i = 1, n_occ_ab(2) do istate = 1, N_states
h2 = occ(i,2) do i = 1, n_occ_ab(2)
if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle h2 = occ(i,2)
h2 = list_orb_reverse(h2) if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
big_array(h1,h2,p1,h2) += 0.5d0 * c_1 * phase h2 = list_orb_reverse(h2)
big_array(h1,h2,h2,p1) -= 0.5d0 * c_1 * phase big_array(h1,h2,p1,h2) += 0.5d0 * c_1 * phase
big_array(h1,h2,h2,p1) -= 0.5d0 * c_1 * phase
big_array(h2,h1,h2,p1) += 0.5d0 * c_1 * phase big_array(h2,h1,h2,p1) += 0.5d0 * c_1 * phase
big_array(h2,h1,p1,h2) -= 0.5d0 * c_1 * phase big_array(h2,h1,p1,h2) -= 0.5d0 * c_1 * phase
enddo enddo
enddo
endif endif
endif endif
end end
@ -555,7 +557,7 @@
integer, intent(in) :: list_orb_reverse(mo_num) integer, intent(in) :: list_orb_reverse(mo_num)
double precision, intent(in) :: c_1 double precision, intent(in) :: c_1
integer :: i,j,h1,h2,p1,p2 integer :: i,j,h1,h2,p1,p2,istate
integer :: exc(0:2,2) integer :: exc(0:2,2)
double precision :: phase double precision :: phase
@ -588,11 +590,13 @@
if(.not.is_integer_in_string(p2,orb_bitmask,N_int))return if(.not.is_integer_in_string(p2,orb_bitmask,N_int))return
p2 = list_orb_reverse(p2) p2 = list_orb_reverse(p2)
if(alpha_alpha.or.spin_trace)then if(alpha_alpha.or.spin_trace)then
do istate = 1, N_states
big_array(h1,h2,p1,p2) += 0.5d0 * c_1 * phase big_array(h1,h2,p1,p2) += 0.5d0 * c_1 * phase
big_array(h1,h2,p2,p1) -= 0.5d0 * c_1 * phase big_array(h1,h2,p2,p1) -= 0.5d0 * c_1 * phase
big_array(h2,h1,p2,p1) += 0.5d0 * c_1 * phase big_array(h2,h1,p2,p1) += 0.5d0 * c_1 * phase
big_array(h2,h1,p1,p2) -= 0.5d0 * c_1 * phase big_array(h2,h1,p1,p2) -= 0.5d0 * c_1 * phase
enddo
endif endif
end end
@ -627,7 +631,7 @@
integer, intent(in) :: list_orb_reverse(mo_num) integer, intent(in) :: list_orb_reverse(mo_num)
double precision, intent(in) :: c_1 double precision, intent(in) :: c_1
integer :: i,j,h1,h2,p1,p2 integer :: i,j,h1,h2,p1,p2,istate
integer :: exc(0:2,2) integer :: exc(0:2,2)
double precision :: phase double precision :: phase
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace

968
src/two_body_rdm/routines_compute_2rdm_orb_range_openmp.irp.f
View File

@ -26,7 +26,7 @@
integer :: occ(N_int*bit_kind_size,2) integer :: occ(N_int*bit_kind_size,2)
integer :: n_occ_ab(2) integer :: n_occ_ab(2)
integer :: i,j,h1,h2 integer :: i,j,h1,h2,istate
integer(bit_kind) :: det_1_act(N_int,2) integer(bit_kind) :: det_1_act(N_int,2)
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
do i = 1, N_int do i = 1, N_int
@ -201,7 +201,7 @@
double precision, intent(out) :: values(sze_buff) double precision, intent(out) :: values(sze_buff)
integer , intent(out) :: keys(4,sze_buff) integer , intent(out) :: keys(4,sze_buff)
integer , intent(inout):: nkeys integer , intent(inout):: nkeys
integer :: i,j,h1,h2,p1,p2 integer :: i,j,h1,h2,p1,p2,istate
integer :: exc(0:2,2,2) integer :: exc(0:2,2,2)
double precision :: phase double precision :: phase
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
@ -255,553 +255,429 @@
endif endif
end end
subroutine orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(det_1,det_2,c_1,list_orb_reverse,ispin,sze_buff,nkeys,keys,values) ! subroutine orb_range_off_diagonal_single_to_two_rdm_ab_dm(det_1,det_2,c_1,gorb_bitmask,list_orb_reverse,ispin)
use bitmasks ! use bitmasks
BEGIN_DOC ! BEGIN_DOC
! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for !! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for
! !!
! a given couple of determinant det_1, det_2 being a SINGLE excitation with respect to one another !! a given couple of determinant det_1, det_2 being a SINGLE excitation with respect to one another
! !!
! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1 !! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1
! !!
! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation !! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation
! !!
! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals !! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals
! !!
! ispin determines which spin-spin component of the two-rdm you will update !! ispin determines which spin-spin component of the two-rdm you will update
! !!
! ispin == 1 :: alpha/ alpha !! ispin == 1 :: alpha/ alpha
! ispin == 2 :: beta / beta !! ispin == 2 :: beta / beta
! ispin == 3 :: alpha/ beta !! ispin == 3 :: alpha/ beta
! ispin == 4 :: spin traced <=> total two-rdm !! ispin == 4 :: spin traced <=> total two-rdm
! !!
! here, only ispin == 3 or 4 will do something !! here, only ispin == 3 or 4 will do something
END_DOC ! END_DOC
implicit none ! implicit none
integer, intent(in) :: ispin,sze_buff ! integer, intent(in) :: dim1,ispin
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2) ! double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
integer, intent(in) :: list_orb_reverse(mo_num) ! integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
double precision, intent(in) :: c_1 ! integer(bit_kind), intent(in) :: orb_bitmask(N_int)
double precision, intent(out) :: values(sze_buff) ! integer, intent(in) :: list_orb_reverse(mo_num)
integer , intent(out) :: keys(4,sze_buff) ! double precision, intent(in) :: c_1
integer , intent(inout):: nkeys !
! integer :: occ(N_int*bit_kind_size,2)
integer :: occ(N_int*bit_kind_size,2) ! integer :: n_occ_ab(2)
integer :: n_occ_ab(2) ! integer :: i,j,h1,h2,istate,p1
integer :: i,j,h1,h2,p1 ! integer :: exc(0:2,2,2)
integer :: exc(0:2,2,2) ! double precision :: phase
double precision :: phase !
! logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace ! logical :: is_integer_in_string
logical :: is_integer_in_string ! alpha_alpha = .False.
alpha_alpha = .False. ! beta_beta = .False.
beta_beta = .False. ! alpha_beta = .False.
alpha_beta = .False. ! spin_trace = .False.
spin_trace = .False. ! if( ispin == 1)then
if( ispin == 1)then ! alpha_alpha = .True.
alpha_alpha = .True. ! else if(ispin == 2)then
else if(ispin == 2)then ! beta_beta = .True.
beta_beta = .True. ! else if(ispin == 3)then
else if(ispin == 3)then ! alpha_beta = .True.
alpha_beta = .True. ! else if(ispin == 4)then
else if(ispin == 4)then ! spin_trace = .True.
spin_trace = .True. ! endif
endif !
! call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int)
call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int) ! call get_single_excitation(det_1,det_2,exc,phase,N_int)
call get_single_excitation(det_1,det_2,exc,phase,N_int) ! if(alpha_beta)then
if(alpha_beta)then ! if (exc(0,1,1) == 1) then
if (exc(0,1,1) == 1) then ! ! Mono alpha
! Mono alpha ! h1 = exc(1,1,1)
h1 = exc(1,1,1) ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
if(list_orb_reverse(h1).lt.0)return ! h1 = list_orb_reverse(h1)
h1 = list_orb_reverse(h1) ! p1 = exc(1,2,1)
p1 = exc(1,2,1) ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
if(list_orb_reverse(p1).lt.0)return ! p1 = list_orb_reverse(p1)
p1 = list_orb_reverse(p1) ! do i = 1, n_occ_ab(2)
do i = 1, n_occ_ab(2) ! h2 = occ(i,2)
h2 = occ(i,2) ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
if(list_orb_reverse(h2).lt.0)return ! h2 = list_orb_reverse(h2)
h2 = list_orb_reverse(h2) ! big_array(h1,h2,p1,h2) += c_1 * phase
nkeys += 1 ! enddo
values(nkeys) = c_1 * phase ! else
keys(1,nkeys) = h1 ! ! Mono beta
keys(2,nkeys) = h2 ! h1 = exc(1,1,2)
keys(3,nkeys) = p1 ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
keys(4,nkeys) = h2 ! h1 = list_orb_reverse(h1)
enddo ! p1 = exc(1,2,2)
else ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
! Mono beta ! p1 = list_orb_reverse(p1)
h1 = exc(1,1,2) ! do i = 1, n_occ_ab(1)
if(list_orb_reverse(h1).lt.0)return ! h2 = occ(i,1)
h1 = list_orb_reverse(h1) ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
p1 = exc(1,2,2) ! h2 = list_orb_reverse(h2)
if(list_orb_reverse(p1).lt.0)return ! big_array(h2,h1,h2,p1) += c_1 * phase
p1 = list_orb_reverse(p1) ! enddo
do i = 1, n_occ_ab(1) ! endif
h2 = occ(i,1) ! else if(spin_trace)then
if(list_orb_reverse(h2).lt.0)return ! if (exc(0,1,1) == 1) then
h2 = list_orb_reverse(h2) ! ! Mono alpha
nkeys += 1 ! h1 = exc(1,1,1)
values(nkeys) = c_1 * phase ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
keys(1,nkeys) = h1 ! h1 = list_orb_reverse(h1)
keys(2,nkeys) = h2 ! p1 = exc(1,2,1)
keys(3,nkeys) = p1 ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
keys(4,nkeys) = h2 ! p1 = list_orb_reverse(p1)
enddo ! do i = 1, n_occ_ab(2)
endif ! h2 = occ(i,2)
else if(spin_trace)then ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
if (exc(0,1,1) == 1) then ! h2 = list_orb_reverse(h2)
! Mono alpha ! big_array(h1,h2,p1,h2) += 0.5d0 * c_1 * phase
h1 = exc(1,1,1) ! big_array(h2,h1,h2,p1) += 0.5d0 * c_1 * phase
if(list_orb_reverse(h1).lt.0)return ! enddo
h1 = list_orb_reverse(h1) ! else
p1 = exc(1,2,1) ! ! Mono beta
if(list_orb_reverse(p1).lt.0)return ! h1 = exc(1,1,2)
p1 = list_orb_reverse(p1) ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
do i = 1, n_occ_ab(2) ! h1 = list_orb_reverse(h1)
h2 = occ(i,2) ! p1 = exc(1,2,2)
if(list_orb_reverse(h2).lt.0)return ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
h2 = list_orb_reverse(h2) ! p1 = list_orb_reverse(p1)
nkeys += 1 ! do i = 1, n_occ_ab(1)
values(nkeys) = 0.5d0 * c_1 * phase ! h2 = occ(i,1)
keys(1,nkeys) = h1 ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
keys(2,nkeys) = h2 ! h2 = list_orb_reverse(h2)
keys(3,nkeys) = p1 ! big_array(h1,h2,p1,h2) += 0.5d0 * c_1 * phase
keys(4,nkeys) = h2 ! big_array(h2,h1,h2,p1) += 0.5d0 * c_1 * phase
nkeys += 1 ! enddo
values(nkeys) = 0.5d0 * c_1 * phase ! endif
keys(1,nkeys) = h2 ! endif
keys(2,nkeys) = h1 ! end
keys(3,nkeys) = h2
keys(4,nkeys) = p1
enddo
else
! Mono beta
h1 = exc(1,1,2)
if(list_orb_reverse(h1).lt.0)return
h1 = list_orb_reverse(h1)
p1 = exc(1,2,2)
if(list_orb_reverse(p1).lt.0)return
p1 = list_orb_reverse(p1)
!print*,'****************'
!print*,'****************'
!print*,'h1,p1',h1,p1
do i = 1, n_occ_ab(1)
h2 = occ(i,1)
if(list_orb_reverse(h2).lt.0)return
h2 = list_orb_reverse(h2)
! print*,'h2 = ',h2
nkeys += 1
values(nkeys) = 0.5d0 * c_1 * phase
keys(1,nkeys) = h1
keys(2,nkeys) = h2
keys(3,nkeys) = p1
keys(4,nkeys) = h2
nkeys += 1
values(nkeys) = 0.5d0 * c_1 * phase
keys(1,nkeys) = h2
keys(2,nkeys) = h1
keys(3,nkeys) = h2
keys(4,nkeys) = p1
enddo
endif
endif
end
subroutine orb_range_off_diag_single_to_two_rdm_aa_dm_buffer(det_1,det_2,c_1,list_orb_reverse,ispin,sze_buff,nkeys,keys,values) ! subroutine orb_range_off_diagonal_single_to_two_rdm_aa_dm(det_1,det_2,c_1,gorb_bitmask,list_orb_reverse,ispin)
BEGIN_DOC ! BEGIN_DOC
! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for !! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for
! !!
! a given couple of determinant det_1, det_2 being a ALPHA SINGLE excitation with respect to one another !! a given couple of determinant det_1, det_2 being a ALPHA SINGLE excitation with respect to one another
! !!
! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1 !! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1
! !!
! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation !! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation
! !!
! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals !! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals
! !!
! ispin determines which spin-spin component of the two-rdm you will update !! ispin determines which spin-spin component of the two-rdm you will update
! !!
! ispin == 1 :: alpha/ alpha !! ispin == 1 :: alpha/ alpha
! ispin == 2 :: beta / beta !! ispin == 2 :: beta / beta
! ispin == 3 :: alpha/ beta !! ispin == 3 :: alpha/ beta
! ispin == 4 :: spin traced <=> total two-rdm !! ispin == 4 :: spin traced <=> total two-rdm
! !!
! here, only ispin == 1 or 4 will do something !! here, only ispin == 1 or 4 will do something
END_DOC ! END_DOC
use bitmasks ! use bitmasks
implicit none ! implicit none
integer, intent(in) :: ispin,sze_buff ! integer, intent(in) :: dim1,ispin
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2) ! double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
integer, intent(in) :: list_orb_reverse(mo_num) ! integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
double precision, intent(in) :: c_1 ! integer(bit_kind), intent(in) :: orb_bitmask(N_int)
double precision, intent(out) :: values(sze_buff) ! integer, intent(in) :: list_orb_reverse(mo_num)
integer , intent(out) :: keys(4,sze_buff) ! double precision, intent(in) :: c_1
integer , intent(inout):: nkeys !
! integer :: occ(N_int*bit_kind_size,2)
integer :: occ(N_int*bit_kind_size,2) ! integer :: n_occ_ab(2)
integer :: n_occ_ab(2) ! integer :: i,j,h1,h2,istate,p1
integer :: i,j,h1,h2,p1 ! integer :: exc(0:2,2,2)
integer :: exc(0:2,2,2) ! double precision :: phase
double precision :: phase !
! logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace ! logical :: is_integer_in_string
logical :: is_integer_in_string ! alpha_alpha = .False.
alpha_alpha = .False. ! beta_beta = .False.
beta_beta = .False. ! alpha_beta = .False.
alpha_beta = .False. ! spin_trace = .False.
spin_trace = .False. ! if( ispin == 1)then
if( ispin == 1)then ! alpha_alpha = .True.
alpha_alpha = .True. ! else if(ispin == 2)then
else if(ispin == 2)then ! beta_beta = .True.
beta_beta = .True. ! else if(ispin == 3)then
else if(ispin == 3)then ! alpha_beta = .True.
alpha_beta = .True. ! else if(ispin == 4)then
else if(ispin == 4)then ! spin_trace = .True.
spin_trace = .True. ! endif
endif !
! call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int)
call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int) ! call get_single_excitation(det_1,det_2,exc,phase,N_int)
call get_single_excitation(det_1,det_2,exc,phase,N_int) ! if(alpha_alpha.or.spin_trace)then
if(alpha_alpha.or.spin_trace)then ! if (exc(0,1,1) == 1) then
if (exc(0,1,1) == 1) then ! ! Mono alpha
! Mono alpha ! h1 = exc(1,1,1)
h1 = exc(1,1,1) ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
if(list_orb_reverse(h1).lt.0)return ! h1 = list_orb_reverse(h1)
h1 = list_orb_reverse(h1) ! p1 = exc(1,2,1)
p1 = exc(1,2,1) ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
if(list_orb_reverse(p1).lt.0)return ! p1 = list_orb_reverse(p1)
p1 = list_orb_reverse(p1) ! do i = 1, n_occ_ab(1)
do i = 1, n_occ_ab(1) ! h2 = occ(i,1)
h2 = occ(i,1) ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
if(list_orb_reverse(h2).lt.0)return ! h2 = list_orb_reverse(h2)
h2 = list_orb_reverse(h2) ! big_array(h1,h2,p1,h2) += 0.5d0 * c_1 * phase
! big_array(h1,h2,h2,p1) -= 0.5d0 * c_1 * phase
!
! big_array(h2,h1,h2,p1) += 0.5d0 * c_1 * phase
! big_array(h2,h1,p1,h2) -= 0.5d0 * c_1 * phase
! enddo
! else
! return
! endif
! endif
! end
nkeys += 1 ! subroutine orb_range_off_diagonal_single_to_two_rdm_bb_dm(det_1,det_2,c_1,gorb_bitmask,list_orb_reverse,ispin)
values(nkeys) = 0.5d0 * c_1 * phase ! use bitmasks
keys(1,nkeys) = h1 ! BEGIN_DOC
keys(2,nkeys) = h2 !! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for
keys(3,nkeys) = p1 !!
keys(4,nkeys) = h2 !! a given couple of determinant det_1, det_2 being a BETA SINGLE excitation with respect to one another
!!
nkeys += 1 !! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1
values(nkeys) = - 0.5d0 * c_1 * phase !!
keys(1,nkeys) = h1 !! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation
keys(2,nkeys) = h2 !!
keys(3,nkeys) = h2 !! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals
keys(4,nkeys) = p1 !!
!! ispin determines which spin-spin component of the two-rdm you will update
nkeys += 1 !!
values(nkeys) = 0.5d0 * c_1 * phase !! ispin == 1 :: alpha/ alpha
keys(1,nkeys) = h2 !! ispin == 2 :: beta / beta
keys(2,nkeys) = h1 !! ispin == 3 :: alpha/ beta
keys(3,nkeys) = h2 !! ispin == 4 :: spin traced <=> total two-rdm
keys(4,nkeys) = p1 !!
!! here, only ispin == 2 or 4 will do something
nkeys += 1 ! END_DOC
values(nkeys) = - 0.5d0 * c_1 * phase ! implicit none
keys(1,nkeys) = h2 ! integer, intent(in) :: dim1,ispin
keys(2,nkeys) = h1 ! double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
keys(3,nkeys) = p1 ! integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
keys(4,nkeys) = h2 ! integer(bit_kind), intent(in) :: orb_bitmask(N_int)
enddo ! integer, intent(in) :: list_orb_reverse(mo_num)
else ! double precision, intent(in) :: c_1
return !
endif !
endif ! integer :: occ(N_int*bit_kind_size,2)
end ! integer :: n_occ_ab(2)
! integer :: i,j,h1,h2,istate,p1
subroutine orb_range_off_diag_single_to_two_rdm_bb_dm_buffer(det_1,det_2,c_1,list_orb_reverse,ispin,sze_buff,nkeys,keys,values) ! integer :: exc(0:2,2,2)
use bitmasks ! double precision :: phase
BEGIN_DOC ! logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for ! logical :: is_integer_in_string
! ! alpha_alpha = .False.
! a given couple of determinant det_1, det_2 being a BETA SINGLE excitation with respect to one another ! beta_beta = .False.
! ! alpha_beta = .False.
! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1 ! spin_trace = .False.
! ! if( ispin == 1)then
! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation ! alpha_alpha = .True.
! ! else if(ispin == 2)then
! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals ! beta_beta = .True.
! ! else if(ispin == 3)then
! ispin determines which spin-spin component of the two-rdm you will update ! alpha_beta = .True.
! ! else if(ispin == 4)then
! ispin == 1 :: alpha/ alpha ! spin_trace = .True.
! ispin == 2 :: beta / beta ! endif
! ispin == 3 :: alpha/ beta !
! ispin == 4 :: spin traced <=> total two-rdm !
! ! call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int)
! here, only ispin == 2 or 4 will do something ! call get_single_excitation(det_1,det_2,exc,phase,N_int)
END_DOC ! if(beta_beta.or.spin_trace)then
implicit none ! if (exc(0,1,1) == 1) then
integer, intent(in) :: ispin,sze_buff ! return
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2) ! else
integer, intent(in) :: list_orb_reverse(mo_num) ! ! Mono beta
double precision, intent(in) :: c_1 ! h1 = exc(1,1,2)
double precision, intent(out) :: values(sze_buff) ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
integer , intent(out) :: keys(4,sze_buff) ! h1 = list_orb_reverse(h1)
integer , intent(inout):: nkeys ! p1 = exc(1,2,2)
! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
integer :: occ(N_int*bit_kind_size,2) ! p1 = list_orb_reverse(p1)
integer :: n_occ_ab(2) ! do istate = 1, N_states
integer :: i,j,h1,h2,p1 ! do i = 1, n_occ_ab(2)
integer :: exc(0:2,2,2) ! h2 = occ(i,2)
double precision :: phase ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))cycle
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace ! h2 = list_orb_reverse(h2)
logical :: is_integer_in_string ! big_array(h1,h2,p1,h2) += 0.5d0 * c_1 * phase
alpha_alpha = .False. ! big_array(h1,h2,h2,p1) -= 0.5d0 * c_1 * phase
beta_beta = .False. !
alpha_beta = .False. ! big_array(h2,h1,h2,p1) += 0.5d0 * c_1 * phase
spin_trace = .False. ! big_array(h2,h1,p1,h2) -= 0.5d0 * c_1 * phase
if( ispin == 1)then ! enddo
alpha_alpha = .True. ! enddo
else if(ispin == 2)then ! endif
beta_beta = .True. ! endif
else if(ispin == 3)then ! end
alpha_beta = .True.
else if(ispin == 4)then
spin_trace = .True.
endif
call bitstring_to_list_ab(det_1, occ, n_occ_ab, N_int)
call get_single_excitation(det_1,det_2,exc,phase,N_int)
if(beta_beta.or.spin_trace)then
if (exc(0,1,1) == 1) then
return
else
! Mono beta
h1 = exc(1,1,2)
if(list_orb_reverse(h1).lt.0)return
h1 = list_orb_reverse(h1)
p1 = exc(1,2,2)
if(list_orb_reverse(p1).lt.0)return
p1 = list_orb_reverse(p1)
do i = 1, n_occ_ab(2)
h2 = occ(i,2)
if(list_orb_reverse(h2).lt.0)return
h2 = list_orb_reverse(h2)
nkeys += 1
values(nkeys) = 0.5d0 * c_1 * phase
keys(1,nkeys) = h1
keys(2,nkeys) = h2
keys(3,nkeys) = p1
keys(4,nkeys) = h2
nkeys += 1
values(nkeys) = - 0.5d0 * c_1 * phase
keys(1,nkeys) = h1
keys(2,nkeys) = h2
keys(3,nkeys) = h2
keys(4,nkeys) = p1
nkeys += 1
values(nkeys) = 0.5d0 * c_1 * phase
keys(1,nkeys) = h2
keys(2,nkeys) = h1
keys(3,nkeys) = h2
keys(4,nkeys) = p1
nkeys += 1
values(nkeys) = - 0.5d0 * c_1 * phase
keys(1,nkeys) = h2
keys(2,nkeys) = h1
keys(3,nkeys) = p1
keys(4,nkeys) = h2
enddo
endif
endif
end
subroutine orb_range_off_diag_double_to_two_rdm_aa_dm_buffer(det_1,det_2,c_1,list_orb_reverse,ispin,sze_buff,nkeys,keys,values) ! subroutine orb_range_off_diagonal_double_to_two_rdm_aa_dm(det_1,det_2,c_1,gorb_bitmask,list_orb_reverse,ispin)
use bitmasks ! use bitmasks
BEGIN_DOC ! BEGIN_DOC
! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for !! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for
! !!
! a given couple of determinant det_1, det_2 being a ALPHA/ALPHA DOUBLE excitation with respect to one another !! a given couple of determinant det_1, det_2 being a ALPHA/ALPHA DOUBLE excitation with respect to one another
! !!
! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1 !! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1
! !!
! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation !! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation
! !!
! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals !! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals
! !!
! ispin determines which spin-spin component of the two-rdm you will update !! ispin determines which spin-spin component of the two-rdm you will update
! !!
! ispin == 1 :: alpha/ alpha !! ispin == 1 :: alpha/ alpha
! ispin == 2 :: beta / beta !! ispin == 2 :: beta / beta
! ispin == 3 :: alpha/ beta !! ispin == 3 :: alpha/ beta
! ispin == 4 :: spin traced <=> total two-rdm !! ispin == 4 :: spin traced <=> total two-rdm
! !!
! here, only ispin == 1 or 4 will do something !! here, only ispin == 1 or 4 will do something
END_DOC ! END_DOC
implicit none ! implicit none
integer, intent(in) :: ispin,sze_buff ! integer, intent(in) :: dim1,ispin
integer(bit_kind), intent(in) :: det_1(N_int),det_2(N_int) ! double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
integer, intent(in) :: list_orb_reverse(mo_num) ! integer(bit_kind), intent(in) :: det_1(N_int),det_2(N_int)
double precision, intent(in) :: c_1 ! integer(bit_kind), intent(in) :: orb_bitmask(N_int)
double precision, intent(out) :: values(sze_buff) ! integer, intent(in) :: list_orb_reverse(mo_num)
integer , intent(out) :: keys(4,sze_buff) ! double precision, intent(in) :: c_1
integer , intent(inout):: nkeys !
! integer :: i,j,h1,h2,p1,p2,istate
! integer :: exc(0:2,2)
integer :: i,j,h1,h2,p1,p2 ! double precision :: phase
integer :: exc(0:2,2) !
double precision :: phase ! logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
! logical :: is_integer_in_string
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace ! alpha_alpha = .False.
logical :: is_integer_in_string ! beta_beta = .False.
alpha_alpha = .False. ! alpha_beta = .False.
beta_beta = .False. ! spin_trace = .False.
alpha_beta = .False. ! if( ispin == 1)then
spin_trace = .False. ! alpha_alpha = .True.
if( ispin == 1)then ! else if(ispin == 2)then
alpha_alpha = .True. ! beta_beta = .True.
else if(ispin == 2)then ! else if(ispin == 3)then
beta_beta = .True. ! alpha_beta = .True.
else if(ispin == 3)then ! else if(ispin == 4)then
alpha_beta = .True. ! spin_trace = .True.
else if(ispin == 4)then ! endif
spin_trace = .True. ! call get_double_excitation_spin(det_1,det_2,exc,phase,N_int)
endif ! h1 =exc(1,1)
call get_double_excitation_spin(det_1,det_2,exc,phase,N_int) ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
h1 =exc(1,1) ! h1 = list_orb_reverse(h1)
if(list_orb_reverse(h1).lt.0)return ! h2 =exc(2,1)
h1 = list_orb_reverse(h1) ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))return
h2 =exc(2,1) ! h2 = list_orb_reverse(h2)
if(list_orb_reverse(h2).lt.0)return ! p1 =exc(1,2)
h2 = list_orb_reverse(h2) ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
p1 =exc(1,2) ! p1 = list_orb_reverse(p1)
if(list_orb_reverse(p1).lt.0)return ! p2 =exc(2,2)
p1 = list_orb_reverse(p1) ! if(.not.is_integer_in_string(p2,orb_bitmask,N_int))return
p2 =exc(2,2) ! p2 = list_orb_reverse(p2)
if(list_orb_reverse(p2).lt.0)return ! if(alpha_alpha.or.spin_trace)then
p2 = list_orb_reverse(p2) ! do istate = 1, N_states
if(alpha_alpha.or.spin_trace)then ! big_array(h1,h2,p1,p2) += 0.5d0 * c_1 * phase
nkeys += 1 ! big_array(h1,h2,p2,p1) -= 0.5d0 * c_1 * phase
values(nkeys) = 0.5d0 * c_1 * phase !
keys(1,nkeys) = h1 ! big_array(h2,h1,p2,p1) += 0.5d0 * c_1 * phase
keys(2,nkeys) = h2 ! big_array(h2,h1,p1,p2) -= 0.5d0 * c_1 * phase
keys(3,nkeys) = p1 ! enddo
keys(4,nkeys) = p2 ! endif
! end
nkeys += 1 ! subroutine orb_range_off_diagonal_double_to_two_rdm_bb_dm(det_1,det_2,c_1,gorb_bitmask,list_orb_reverse,ispin)
values(nkeys) = - 0.5d0 * c_1 * phase ! use bitmasks
keys(1,nkeys) = h1 ! BEGIN_DOC
keys(2,nkeys) = h2 !! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for
keys(3,nkeys) = p2 !!
keys(4,nkeys) = p1 !! a given couple of determinant det_1, det_2 being a BETA /BETA DOUBLE excitation with respect to one another
!!
nkeys += 1 !! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1
values(nkeys) = 0.5d0 * c_1 * phase !!
keys(1,nkeys) = h2 !! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation
keys(2,nkeys) = h1 !!
keys(3,nkeys) = p2 !! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals
keys(4,nkeys) = p1 !!
!! ispin determines which spin-spin component of the two-rdm you will update
nkeys += 1 !!
values(nkeys) = - 0.5d0 * c_1 * phase !! ispin == 1 :: alpha/ alpha
keys(1,nkeys) = h2 !! ispin == 2 :: beta / beta
keys(2,nkeys) = h1 !! ispin == 3 :: alpha/ beta
keys(3,nkeys) = p1 !! ispin == 4 :: spin traced <=> total two-rdm
keys(4,nkeys) = p2 !!
endif !! here, only ispin == 2 or 4 will do something
end ! END_DOC
! implicit none
subroutine orb_range_off_diag_double_to_two_rdm_bb_dm_buffer(det_1,det_2,c_1,list_orb_reverse,ispin,sze_buff,nkeys,keys,values) !
use bitmasks ! integer, intent(in) :: dim1,ispin
BEGIN_DOC ! double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
! routine that update the OFF DIAGONAL PART of the two body rdms in a specific range of orbitals for ! integer(bit_kind), intent(in) :: det_1(N_int),det_2(N_int)
! ! integer(bit_kind), intent(in) :: orb_bitmask(N_int)
! a given couple of determinant det_1, det_2 being a BETA /BETA DOUBLE excitation with respect to one another ! integer, intent(in) :: list_orb_reverse(mo_num)
! ! double precision, intent(in) :: c_1
! c_1 is supposed to be a scalar quantity, such as state averaged coef of the determinant det_1 !
! ! integer :: i,j,h1,h2,p1,p2,istate
! big_array(dim1,dim1,dim1,dim1) is the two-body rdm to be updated in physicist notation ! integer :: exc(0:2,2)
! ! double precision :: phase
! orb_bitmask(N_int) is the bitmask for the orbital range, list_orb_reverse(mo_num) is the inverse range of orbitals ! logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
! ! logical :: is_integer_in_string
! ispin determines which spin-spin component of the two-rdm you will update ! alpha_alpha = .False.
! ! beta_beta = .False.
! ispin == 1 :: alpha/ alpha ! alpha_beta = .False.
! ispin == 2 :: beta / beta ! spin_trace = .False.
! ispin == 3 :: alpha/ beta ! if( ispin == 1)then
! ispin == 4 :: spin traced <=> total two-rdm ! alpha_alpha = .True.
! ! else if(ispin == 2)then
! here, only ispin == 2 or 4 will do something ! beta_beta = .True.
END_DOC ! else if(ispin == 3)then
implicit none ! alpha_beta = .True.
! else if(ispin == 4)then
integer, intent(in) :: ispin,sze_buff ! spin_trace = .True.
integer(bit_kind), intent(in) :: det_1(N_int),det_2(N_int) ! endif
integer, intent(in) :: list_orb_reverse(mo_num) !
double precision, intent(in) :: c_1 ! call get_double_excitation_spin(det_1,det_2,exc,phase,N_int)
double precision, intent(out) :: values(sze_buff) ! h1 =exc(1,1)
integer , intent(out) :: keys(4,sze_buff) ! if(.not.is_integer_in_string(h1,orb_bitmask,N_int))return
integer , intent(inout):: nkeys ! h1 = list_orb_reverse(h1)
! h2 =exc(2,1)
integer :: i,j,h1,h2,p1,p2 ! if(.not.is_integer_in_string(h2,orb_bitmask,N_int))return
integer :: exc(0:2,2) ! h2 = list_orb_reverse(h2)
double precision :: phase ! p1 =exc(1,2)
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace ! if(.not.is_integer_in_string(p1,orb_bitmask,N_int))return
logical :: is_integer_in_string ! p1 = list_orb_reverse(p1)
alpha_alpha = .False. ! p2 =exc(2,2)
beta_beta = .False. ! if(.not.is_integer_in_string(p2,orb_bitmask,N_int))return
alpha_beta = .False. ! p2 = list_orb_reverse(p2)
spin_trace = .False. ! if(beta_beta.or.spin_trace)then
if( ispin == 1)then ! big_array(h1,h2,p1,p2) += 0.5d0 * c_1* phase
alpha_alpha = .True. ! big_array(h1,h2,p2,p1) -= 0.5d0 * c_1* phase
else if(ispin == 2)then !
beta_beta = .True. ! big_array(h2,h1,p2,p1) += 0.5d0 * c_1* phase
else if(ispin == 3)then ! big_array(h2,h1,p1,p2) -= 0.5d0 * c_1* phase
alpha_beta = .True. ! endif
else if(ispin == 4)then ! end
spin_trace = .True.
endif
call get_double_excitation_spin(det_1,det_2,exc,phase,N_int)
h1 =exc(1,1)
if(list_orb_reverse(h1).lt.0)return
h1 = list_orb_reverse(h1)
h2 =exc(2,1)
if(list_orb_reverse(h2).lt.0)return
h2 = list_orb_reverse(h2)
p1 =exc(1,2)
if(list_orb_reverse(p1).lt.0)return
p1 = list_orb_reverse(p1)
p2 =exc(2,2)
if(list_orb_reverse(p2).lt.0)return
p2 = list_orb_reverse(p2)
if(beta_beta.or.spin_trace)then
nkeys += 1
values(nkeys) = 0.5d0 * c_1 * phase
keys(1,nkeys) = h1
keys(2,nkeys) = h2
keys(3,nkeys) = p1
keys(4,nkeys) = p2
nkeys += 1
values(nkeys) = - 0.5d0 * c_1 * phase
keys(1,nkeys) = h1
keys(2,nkeys) = h2
keys(3,nkeys) = p2
keys(4,nkeys) = p1
nkeys += 1
values(nkeys) = 0.5d0 * c_1 * phase
keys(1,nkeys) = h2
keys(2,nkeys) = h1
keys(3,nkeys) = p2
keys(4,nkeys) = p1
nkeys += 1
values(nkeys) = - 0.5d0 * c_1 * phase
keys(1,nkeys) = h2
keys(2,nkeys) = h1
keys(3,nkeys) = p1
keys(4,nkeys) = p2
endif
end