mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Accelerated diag_h_mat_elem
This commit is contained in:
parent
007e234997
commit
5d253ea84b
@ -186,10 +186,8 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
|||||||
particle(j,1) = iand(xor(particl_1(j,1),key_in(j,1)),particl_1(j,1))
|
particle(j,1) = iand(xor(particl_1(j,1),key_in(j,1)),particl_1(j,1))
|
||||||
particle(j,2) = iand(xor(particl_1(j,2),key_in(j,2)),particl_1(j,2))
|
particle(j,2) = iand(xor(particl_1(j,2),key_in(j,2)),particl_1(j,2))
|
||||||
enddo
|
enddo
|
||||||
call bitstring_to_list(particle(1,1),occ_particle(1,1),N_elec_in_key_part_1(1),N_int)
|
call bitstring_to_list_ab(particle,occ_particle,N_elec_in_key_part_1,N_int)
|
||||||
call bitstring_to_list(particle(1,2),occ_particle(1,2),N_elec_in_key_part_1(2),N_int)
|
call bitstring_to_list_ab(hole,occ_hole,N_elec_in_key_hole_1,N_int)
|
||||||
call bitstring_to_list(hole(1,1),occ_hole(1,1),N_elec_in_key_hole_1(1),N_int)
|
|
||||||
call bitstring_to_list(hole(1,2),occ_hole(1,2),N_elec_in_key_hole_1(2),N_int)
|
|
||||||
allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_tot_num,2), &
|
allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_tot_num,2), &
|
||||||
ib_jb_pairs(2,0:(elec_alpha_num)*mo_tot_num))
|
ib_jb_pairs(2,0:(elec_alpha_num)*mo_tot_num))
|
||||||
|
|
||||||
@ -252,10 +250,8 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
|||||||
particle_tmp(j,2) = iand(xor(particl_2(j,2),hole(j,2)),particl_2(j,2))
|
particle_tmp(j,2) = iand(xor(particl_2(j,2),hole(j,2)),particl_2(j,2))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call bitstring_to_list(particle_tmp(1,1),occ_particle_tmp(1,1),N_elec_in_key_part_2(1),N_int)
|
call bitstring_to_list_ab(particle_tmp,occ_particle_tmp,N_elec_in_key_part_2,N_int)
|
||||||
call bitstring_to_list(particle_tmp(1,2),occ_particle_tmp(1,2),N_elec_in_key_part_2(2),N_int)
|
call bitstring_to_list_ab(hole_tmp,occ_hole_tmp,N_elec_in_key_hole_2,N_int)
|
||||||
call bitstring_to_list(hole_tmp (1,1),occ_hole_tmp (1,1),N_elec_in_key_hole_2(1),N_int)
|
|
||||||
call bitstring_to_list(hole_tmp (1,2),occ_hole_tmp (1,2),N_elec_in_key_hole_2(2),N_int)
|
|
||||||
|
|
||||||
! hole = a^(+)_j_a(ispin) a_i_a(ispin)|key_in> : mono exc :: orb(i_a,ispin) --> orb(j_a,ispin)
|
! hole = a^(+)_j_a(ispin) a_i_a(ispin)|key_in> : mono exc :: orb(i_a,ispin) --> orb(j_a,ispin)
|
||||||
hole_save = hole
|
hole_save = hole
|
||||||
@ -447,10 +443,8 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc_in $pa
|
|||||||
particle(j,2) = iand(xor(particl_1(j,2),key_in(j,2)),particl_1(j,2))
|
particle(j,2) = iand(xor(particl_1(j,2),key_in(j,2)),particl_1(j,2))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call bitstring_to_list(particle(1,1),occ_particle(1,1),N_elec_in_key_part_1(1),N_int)
|
call bitstring_to_list_ab(particle,occ_particle,N_elec_in_key_part_1,N_int)
|
||||||
call bitstring_to_list(particle(1,2),occ_particle(1,2),N_elec_in_key_part_1(2),N_int)
|
call bitstring_to_list_ab(hole,occ_hole,N_elec_in_key_hole_1,N_int)
|
||||||
call bitstring_to_list(hole (1,1),occ_hole (1,1),N_elec_in_key_hole_1(1),N_int)
|
|
||||||
call bitstring_to_list(hole (1,2),occ_hole (1,2),N_elec_in_key_hole_1(2),N_int)
|
|
||||||
allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_tot_num,2))
|
allocate (ia_ja_pairs(2,0:(elec_alpha_num)*mo_tot_num,2))
|
||||||
|
|
||||||
do ispin=1,2
|
do ispin=1,2
|
||||||
|
@ -361,6 +361,44 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint)
|
|||||||
integer, intent(out) :: list(Nint*bit_kind_size,2)
|
integer, intent(out) :: list(Nint*bit_kind_size,2)
|
||||||
integer, intent(out) :: n_elements(2)
|
integer, intent(out) :: n_elements(2)
|
||||||
|
|
||||||
|
integer :: i, j, ishift
|
||||||
|
integer(bit_kind) :: l
|
||||||
|
|
||||||
|
n_elements(1) = 0
|
||||||
|
n_elements(2) = 0
|
||||||
|
ishift = 1
|
||||||
|
do i=1,Nint
|
||||||
|
l = string(i,1)
|
||||||
|
do while (l /= 0_bit_kind)
|
||||||
|
n_elements(1) = n_elements(1)+1
|
||||||
|
j = trailz(l)
|
||||||
|
list(n_elements(1),1) = ishift+j
|
||||||
|
l = ibclr(l,j)
|
||||||
|
enddo
|
||||||
|
l = string(i,2)
|
||||||
|
do while (l /= 0_bit_kind)
|
||||||
|
n_elements(2) = n_elements(2)+1
|
||||||
|
j = trailz(l)
|
||||||
|
list(n_elements(2),2) = ishift+j
|
||||||
|
l = ibclr(l,j)
|
||||||
|
enddo
|
||||||
|
ishift = ishift + bit_kind_size
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine bitstring_to_list_ab_old( string, list, n_elements, Nint)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gives the inidices(+1) of the bits set to 1 in the bit string
|
||||||
|
! For alpha/beta determinants
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: string(Nint,2)
|
||||||
|
integer, intent(out) :: list(Nint*bit_kind_size,2)
|
||||||
|
integer, intent(out) :: n_elements(2)
|
||||||
|
|
||||||
integer :: i, ishift
|
integer :: i, ishift
|
||||||
integer(bit_kind) :: l
|
integer(bit_kind) :: l
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user