mirror of
https://github.com/LCPQ/quantum_package
synced 2024-11-19 04:22:36 +01:00
apparently working microlist
This commit is contained in:
parent
786e2989d1
commit
424682a7a1
@ -21,7 +21,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
integer :: i,k, c_ref, ni, ex
|
integer :: i,k, c_ref, ni, ex
|
||||||
integer, external :: connected_to_ref
|
integer, external :: connected_to_ref
|
||||||
logical, external :: is_in_wavefunction
|
logical, external :: is_in_wavefunction
|
||||||
external :: commoner
|
|
||||||
|
|
||||||
integer(bit_kind), allocatable :: minilist(:,:,:)
|
integer(bit_kind), allocatable :: minilist(:,:,:)
|
||||||
integer, allocatable :: idx_minilist(:)
|
integer, allocatable :: idx_minilist(:)
|
||||||
@ -49,7 +48,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
ASSERT (minval(sum_norm_pert) >= 0.d0)
|
ASSERT (minval(sum_norm_pert) >= 0.d0)
|
||||||
ASSERT (N_st > 0)
|
ASSERT (N_st > 0)
|
||||||
|
|
||||||
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ??
|
|
||||||
call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint)
|
call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint)
|
||||||
|
|
||||||
|
|
||||||
@ -57,20 +56,21 @@ 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 ??
|
||||||
allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), &
|
allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), &
|
||||||
idx_microlist(N_minilist, mo_tot_num*2), &
|
idx_microlist(N_minilist, mo_tot_num*2), &
|
||||||
N_microlist(mo_tot_num*2) )
|
N_microlist(mo_tot_num*2) )
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
if(key_mask(1,1) /= 0) then
|
||||||
call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint)
|
call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint)
|
||||||
|
|
||||||
|
|
||||||
do i=1,mo_tot_num*2
|
do i=1,mo_tot_num*2
|
||||||
do k=1,N_microlist(i)
|
do k=1,N_microlist(i)
|
||||||
idx_microlist(k,i) = idx_minilist(idx_microlist(k,i))
|
idx_microlist(k,i) = idx_minilist(idx_microlist(k,i))
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
end if
|
||||||
|
|
||||||
do i=1,buffer_size
|
do i=1,buffer_size
|
||||||
|
|
||||||
@ -82,7 +82,8 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
cycle
|
cycle
|
||||||
endif
|
endif
|
||||||
|
|
||||||
! create_microlist
|
|
||||||
|
if(key_mask(1,1) /= 0) then
|
||||||
call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint)
|
call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint)
|
||||||
|
|
||||||
if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
|
if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
|
||||||
@ -90,9 +91,14 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
else
|
else
|
||||||
smallerlist = mobiles(2)
|
smallerlist = mobiles(2)
|
||||||
end if
|
end if
|
||||||
|
|
||||||
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_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist))
|
||||||
|
|
||||||
|
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 ;
|
!det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ;
|
||||||
|
|
||||||
! 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, &
|
||||||
@ -109,7 +115,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
enddo
|
enddo
|
||||||
deallocate( minilist, minilist_gen, idx_minilist )
|
deallocate( minilist, minilist_gen, idx_minilist )
|
||||||
deallocate( microlist, idx_microlist, N_microlist )
|
deallocate( microlist, idx_microlist, N_microlist )
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -136,14 +136,54 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
integer, intent(out) :: N_microlist(mo_tot_num*2), idx_microlist(N_minilist, mo_tot_num*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(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, mo_tot_num*2)
|
||||||
|
|
||||||
integer :: i,j,k
|
integer :: i,j,k,nt,n_element(2)
|
||||||
|
integer :: list(Nint*bit_kind_size,2)
|
||||||
|
integer(bit_kind) :: key_mask_neg(Nint,2)
|
||||||
|
|
||||||
N_microlist(:) = N_minilist
|
|
||||||
do i=1,mo_tot_num*2
|
if(Nint /= 1) then
|
||||||
microlist(:,:,:,i) = minilist(:,:,:)
|
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))
|
||||||
end do
|
end do
|
||||||
do i=1,N_minilist
|
|
||||||
idx_microlist(i,:) = i
|
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)
|
||||||
|
|
||||||
|
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
|
||||||
|
else
|
||||||
|
do j=1,n_element(1)
|
||||||
|
nt = list(j,1)
|
||||||
|
N_microlist(nt) = N_microlist(nt) + 1
|
||||||
|
idx_microlist(N_microlist(nt),nt) = i
|
||||||
|
microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i)
|
||||||
|
end do
|
||||||
|
|
||||||
|
do j=1,n_element(2)
|
||||||
|
nt = list(j,2) + mo_tot_num
|
||||||
|
N_microlist(nt) = N_microlist(nt) + 1
|
||||||
|
idx_microlist(N_microlist(nt),nt) = i
|
||||||
|
microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i)
|
||||||
|
end do
|
||||||
|
end if
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user