mirror of
https://github.com/LCPQ/quantum_package
synced 2024-06-17 18:55:26 +02:00
better microlist
This commit is contained in:
Yann Garniron
parent
424682a7a1
commit
9a515ed0b6
|
|
@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32
|
|||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 1 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
|
|
|
|||
|
|
@ -56,10 +56,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||
deallocate( minilist, minilist_gen, idx_minilist )
|
||||
return
|
||||
end if
|
||||
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ??
|
||||
allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), &
|
||||
idx_microlist(N_minilist, mo_tot_num*2), &
|
||||
N_microlist(mo_tot_num*2) )
|
||||
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint)
|
||||
allocate( microlist(Nint,2,N_minilist, 0:mo_tot_num*2), &
|
||||
idx_microlist(N_minilist, 0:mo_tot_num*2), &
|
||||
N_microlist(0:mo_tot_num*2) )
|
||||
|
||||
|
||||
|
||||
|
|
@ -84,19 +84,30 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||
|
||||
|
||||
if(key_mask(1,1) /= 0) then
|
||||
call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint)
|
||||
call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint)
|
||||
! if(popcnt(buffer(1,1,i)) + popcnt(buffer(2,1,i)) /= 16 .or. popcnt(buffer(1,2,i)) + popcnt(buffer(2,2,i)) /= 16 .or. popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) /= 30) then
|
||||
! print *, "wtf?"
|
||||
! print '(3(B70))', buffer(:,1,i)
|
||||
! print '(3(B70))', buffer(:,2,i)
|
||||
! print '(3(B70))', popcnt(key_mask(1,1))
|
||||
! print '(3(B70))', popcnt(key_mask(1,2))
|
||||
! end if
|
||||
|
||||
if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
|
||||
smallerlist = mobiles(1)
|
||||
else
|
||||
smallerlist = mobiles(2)
|
||||
end if
|
||||
microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist)
|
||||
idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist)
|
||||
! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
||||
! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist))
|
||||
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
||||
c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist))
|
||||
c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0))
|
||||
|
||||
else
|
||||
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
||||
c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist)
|
||||
else
|
||||
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
||||
c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist)
|
||||
end if
|
||||
|
||||
!det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ;
|
||||
|
|
|
|||
|
|
@ -97,25 +97,31 @@ end subroutine
|
|||
|
||||
|
||||
subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters )
|
||||
|
||||
implicit none
|
||||
integer(bit_kind), intent(in) :: key_in(N_int, 2), particl_1(N_int, 2), particl_2(N_int, 2)
|
||||
double precision, intent(in) :: fock_diag_tmp(2,mo_tot_num+1)
|
||||
integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), key_mask(N_int, 2)
|
||||
integer,intent(in) :: fh1,fh2,fs1,fs2,i_generator,iproc_in
|
||||
integer,intent(in) :: fs1,fs2,i_generator,iproc_in, fh1,fh2
|
||||
integer(bit_kind) :: miniList(N_int, 2, N_det)
|
||||
integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni
|
||||
$declarations
|
||||
integer(bit_kind), parameter :: one = 1_8
|
||||
|
||||
p1_mask(:,:) = 0_bit_kind
|
||||
p2_mask(:,:) = 0_bit_kind
|
||||
p1_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) = ishft(1,iand(fh1-1,bit_kind_size-1))
|
||||
p2_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) = ishft(1,iand(fh2-1,bit_kind_size-1))
|
||||
p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(one,iand(fh1-1,bit_kind_size-1))
|
||||
p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = ishft(one,iand(fh2-1,bit_kind_size-1))
|
||||
|
||||
key_mask(:,:) = key_in(:,:)
|
||||
|
||||
key_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) -= ishft(1,iand(fh1-1,bit_kind_size-1))
|
||||
key_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) -= ishft(1,iand(fh2-1,bit_kind_size-1))
|
||||
|
||||
key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1))
|
||||
key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1))
|
||||
|
||||
! if(popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) + popcnt(key_mask(2,1)) + popcnt(key_mask(2,2)) /= 30) then
|
||||
! print *, "wtf"
|
||||
! print *, fh1, fh2, fs1, fs2
|
||||
! end if
|
||||
|
||||
call $subroutine_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters )
|
||||
end subroutine
|
||||
|
||||
|
|
|
|||
|
|
@ -104,27 +104,39 @@ subroutine getMobiles(key,key_mask, mobiles,Nint)
|
|||
integer,intent(out) :: mobiles(2)
|
||||
integer,intent(in) :: Nint
|
||||
|
||||
integer(bit_kind) :: mobileMask(2)
|
||||
integer(bit_kind) :: mobileMask(Nint,2)
|
||||
integer :: list(Nint*bit_kind_size), nel
|
||||
|
||||
if(Nint /= 1) then
|
||||
print *, "GETMOBILES UNIMPLEMENTED"
|
||||
stop
|
||||
end if
|
||||
do j=1,Nint
|
||||
mobileMask(j,1) = xor(key(j,1), key_mask(j,1))
|
||||
mobileMask(j,2) = xor(key(j,2), key_mask(j,2))
|
||||
! print '(3(B70))', mobileMask(j,1), mobileMask(j,2)
|
||||
end do
|
||||
! print *, "=="
|
||||
|
||||
|
||||
mobileMask(1) = xor(key(1,1), key_mask(1,1))
|
||||
mobileMask(2) = xor(key(1,2), key_mask(1,2))
|
||||
|
||||
if(mobileMask(1) /= 0 .and. mobileMask(2) /= 0) then
|
||||
mobiles(1) = trailz(mobileMask(1)) + 1
|
||||
mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num
|
||||
else if(mobileMask(1) /= 0) then
|
||||
mobiles(1) = trailz(mobileMask(1)) + 1
|
||||
mobiles(2) = bit_kind*8 - leadz(mobileMask(1))
|
||||
call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint)
|
||||
if(nel == 2) then
|
||||
mobiles(1) = list(1)
|
||||
mobiles(2) = list(2)
|
||||
else if(nel == 1) then
|
||||
mobiles(1) = list(1)
|
||||
call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint)
|
||||
mobiles(2) = list(1) + mo_tot_num
|
||||
else
|
||||
mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num
|
||||
mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num
|
||||
call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint)
|
||||
mobiles(1) = list(1) + mo_tot_num
|
||||
mobiles(2) = list(2) + mo_tot_num
|
||||
end if
|
||||
! if(mobiles(1) > 218 .or. mobiles(2) > 218 .or. mobiles(1) < 0 .or. mobiles(2) < 0) then
|
||||
! print *," MOB", mobiles
|
||||
! print '(3(B70))', mobileMask(:,1)
|
||||
! print '(3(B70))', mobileMask(:,2)
|
||||
! print '(3(B70))', key(:,1)
|
||||
! print '(3(B70))', key(:,2)
|
||||
! print '(3(B70))', key_mask(:,1)
|
||||
! print '(3(B70))', key_mask(:,2)
|
||||
! stop
|
||||
! end if
|
||||
end subroutine
|
||||
|
||||
|
||||
|
|
@ -133,19 +145,14 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||
integer, intent(in) :: Nint, N_minilist
|
||||
integer(bit_kind), intent(in) :: minilist(Nint,2,N_minilist), key_mask(Nint,2)
|
||||
|
||||
integer, intent(out) :: N_microlist(mo_tot_num*2), idx_microlist(N_minilist, mo_tot_num*2)
|
||||
integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, mo_tot_num*2)
|
||||
integer, intent(out) :: N_microlist(0:mo_tot_num*2), idx_microlist(N_minilist, 0:mo_tot_num*2)
|
||||
integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, 0:mo_tot_num*2)
|
||||
|
||||
integer :: i,j,k,nt,n_element(2)
|
||||
integer :: list(Nint*bit_kind_size,2)
|
||||
integer(bit_kind) :: key_mask_neg(Nint,2)
|
||||
integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2)
|
||||
|
||||
|
||||
if(Nint /= 1) then
|
||||
print *, "UNIMPLEMENTed"
|
||||
stop
|
||||
end if
|
||||
|
||||
do i=1,Nint
|
||||
key_mask_neg(i,1) = not(key_mask(i,1))
|
||||
key_mask_neg(i,2) = not(key_mask(i,2))
|
||||
|
|
@ -153,22 +160,29 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||
|
||||
N_microlist(:) = 0
|
||||
|
||||
|
||||
do i=1, N_minilist
|
||||
call bitstring_to_list(iand(key_mask_neg(1,1), minilist(1,1,i)), list(:,1), n_element(1), Nint)
|
||||
call bitstring_to_list(iand(key_mask_neg(1,2), minilist(1,2,i)), list(:,2), n_element(2), Nint)
|
||||
do j=1,Nint
|
||||
mobileMask(j,1) = iand(key_mask_neg(j,1), minilist(j,1,i))
|
||||
mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i))
|
||||
end do
|
||||
|
||||
if(n_element(1) + n_element(2) > 4) then
|
||||
print *, "WTF???"
|
||||
stop
|
||||
end if
|
||||
call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint)
|
||||
call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint)
|
||||
|
||||
! if(n_element(1) + n_element(2) > 4) then
|
||||
! print *, "WTF???"
|
||||
! stop
|
||||
! end if
|
||||
|
||||
if(n_element(1) + n_element(2) /= 4) then
|
||||
do j=1,mo_tot_num*2
|
||||
N_microlist(j) = N_microlist(j) + 1
|
||||
idx_microlist(N_microlist(j),j) = i
|
||||
microlist(:,:,N_microlist(j),j) = minilist(:,:,i)
|
||||
end do
|
||||
N_microlist(0) = N_microlist(0) + 1
|
||||
idx_microlist(N_microlist(0),0) = i
|
||||
microlist(:,:,N_microlist(0),0) = minilist(:,:,i)
|
||||
!do j=1,mo_tot_num*2
|
||||
! N_microlist(j) = N_microlist(j) + 1
|
||||
! idx_microlist(N_microlist(j),j) = i
|
||||
! microlist(:,:,N_microlist(j),j) = minilist(:,:,i)
|
||||
!end do
|
||||
else
|
||||
do j=1,n_element(1)
|
||||
nt = list(j,1)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user