LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 12:56:14 +01:00
Code Issues Releases Wiki Activity

better microlist

Browse Source
This commit is contained in:
Yann Garniron 2015-12-17 22:06:57 +01:00
parent 424682a7a1
commit 9a515ed0b6
4 changed files with 85 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/gfortran.cfg
View File

@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32
# 0 : Deactivate # 0 : Deactivate
# #
[OPTION] [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 CACHE : 1 ; Enable cache_compile.py
OPENMP : 1 ; Append OpenMP flags OPENMP : 1 ; Append OpenMP flags

29
plugins/Perturbation/perturbation.template.f
View File

@ -56,10 +56,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
deallocate( minilist, minilist_gen, idx_minilist ) deallocate( minilist, minilist_gen, idx_minilist )
return return
end if end if
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint)
allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), & allocate( microlist(Nint,2,N_minilist, 0:mo_tot_num*2), &
idx_microlist(N_minilist, mo_tot_num*2), & idx_microlist(N_minilist, 0:mo_tot_num*2), &
N_microlist(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 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 if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
smallerlist = mobiles(1) smallerlist = mobiles(1)
else else
smallerlist = mobiles(2) smallerlist = mobiles(2)
end if 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, & 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 else
call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & 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) c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist)
end if 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 ; !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ;

18
src/Determinants/H_apply.template.f
View File

@ -97,24 +97,30 @@ end subroutine
subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) 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) 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) 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(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(bit_kind) :: miniList(N_int, 2, N_det)
integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni
$declarations $declarations
integer(bit_kind), parameter :: one = 1_8
p1_mask(:,:) = 0_bit_kind p1_mask(:,:) = 0_bit_kind
p2_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)) p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(one,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)) 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(:,:) = key_in(:,:)
key_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) -= ishft(1,iand(fh1-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,-bit_kind_shift) + 1, fs2) -= ishft(1,iand(fh2-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 ) 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 end subroutine

88
src/Determinants/filter_connected.irp.f
View File

@ -104,27 +104,39 @@ subroutine getMobiles(key,key_mask, mobiles,Nint)
integer,intent(out) :: mobiles(2) integer,intent(out) :: mobiles(2)
integer,intent(in) :: Nint 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 do j=1,Nint
print *, "GETMOBILES UNIMPLEMENTED" mobileMask(j,1) = xor(key(j,1), key_mask(j,1))
stop mobileMask(j,2) = xor(key(j,2), key_mask(j,2))
end if ! print '(3(B70))', mobileMask(j,1), mobileMask(j,2)
end do
! print *, "=="
call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint)
mobileMask(1) = xor(key(1,1), key_mask(1,1)) if(nel == 2) then
mobileMask(2) = xor(key(1,2), key_mask(1,2)) mobiles(1) = list(1)
mobiles(2) = list(2)
if(mobileMask(1) /= 0 .and. mobileMask(2) /= 0) then else if(nel == 1) then
mobiles(1) = trailz(mobileMask(1)) + 1 mobiles(1) = list(1)
mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint)
else if(mobileMask(1) /= 0) then mobiles(2) = list(1) + mo_tot_num
mobiles(1) = trailz(mobileMask(1)) + 1
mobiles(2) = bit_kind*8 - leadz(mobileMask(1))
else else
mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint)
mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num mobiles(1) = list(1) + mo_tot_num
mobiles(2) = list(2) + mo_tot_num
end if 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 end subroutine
@ -133,19 +145,14 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
integer, intent(in) :: Nint, N_minilist integer, intent(in) :: Nint, N_minilist
integer(bit_kind), intent(in) :: minilist(Nint,2,N_minilist), key_mask(Nint,2) 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, 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, 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 :: i,j,k,nt,n_element(2)
integer :: list(Nint*bit_kind_size,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 do i=1,Nint
key_mask_neg(i,1) = not(key_mask(i,1)) key_mask_neg(i,1) = not(key_mask(i,1))
key_mask_neg(i,2) = not(key_mask(i,2)) 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 N_microlist(:) = 0
do i=1, N_minilist 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) do j=1,Nint
call bitstring_to_list(iand(key_mask_neg(1,2), minilist(1,2,i)), list(:,2), n_element(2), 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 call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint)
print *, "WTF???" call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint)
stop
end if ! if(n_element(1) + n_element(2) > 4) then
! print *, "WTF???"
! stop
! end if
if(n_element(1) + n_element(2) /= 4) then if(n_element(1) + n_element(2) /= 4) then
do j=1,mo_tot_num*2 N_microlist(0) = N_microlist(0) + 1
N_microlist(j) = N_microlist(j) + 1 idx_microlist(N_microlist(0),0) = i
idx_microlist(N_microlist(j),j) = i microlist(:,:,N_microlist(0),0) = minilist(:,:,i)
microlist(:,:,N_microlist(j),j) = minilist(:,:,i) !do j=1,mo_tot_num*2
end do ! N_microlist(j) = N_microlist(j) + 1
! idx_microlist(N_microlist(j),j) = i
! microlist(:,:,N_microlist(j),j) = minilist(:,:,i)
!end do
else else
do j=1,n_element(1) do j=1,n_element(1)
nt = list(j,1) nt = list(j,1)