mirror of
https://github.com/LCPQ/quantum_package
synced 2024-06-25 22:52:15 +02:00
reduced RAM requirement
This commit is contained in:
Yann Garniron
parent
d48ff4c00e
commit
16135a7248
|
|
@ -31,13 +31,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||
logical :: fullMatch
|
||||
logical, external :: is_connected_to
|
||||
|
||||
integer(bit_kind), allocatable :: microlist(:,:,:,:)
|
||||
integer, allocatable :: idx_microlist(:,:), N_microlist(:)
|
||||
integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:)
|
||||
integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:)
|
||||
integer :: mobiles(2), smallerlist
|
||||
|
||||
|
||||
integer(bit_kind), allocatable :: microlist_gen(:,:,:,:)
|
||||
integer, allocatable :: idx_microlist_gen(:,:), N_microlist_gen(:)
|
||||
integer(bit_kind), allocatable :: microlist_gen(:,:,:)
|
||||
integer, allocatable :: idx_microlist_gen(:), N_microlist_gen(:), ptr_microlist_gen(:)
|
||||
|
||||
allocate( minilist(Nint,2,N_det_selectors), &
|
||||
minilist_gen(Nint,2,N_det_generators), &
|
||||
|
|
@ -60,22 +60,43 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||
return
|
||||
end if
|
||||
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), &
|
||||
allocate( microlist(Nint,2,N_minilist*4), &
|
||||
idx_microlist(N_minilist*4), &
|
||||
ptr_microlist(0:mo_tot_num*2+1), &
|
||||
N_microlist(0:mo_tot_num*2) )
|
||||
|
||||
allocate( microlist_gen(Nint,2,N_minilist_gen, 0:mo_tot_num*2), &
|
||||
idx_microlist_gen(N_minilist_gen, 0:mo_tot_num*2), &
|
||||
allocate( microlist_gen(Nint,2,N_minilist_gen*4), &
|
||||
idx_microlist_gen(N_minilist_gen*4 ), &
|
||||
ptr_microlist_gen(0:mo_tot_num*2+1), &
|
||||
N_microlist_gen(0: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_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,Nint)
|
||||
! ptr_microlist(0) = 1
|
||||
! ptr_microlist_gen(0) = 1
|
||||
! do i=1,mo_tot_num*2+1
|
||||
! ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1)
|
||||
! ptr_microlist_gen(i) = ptr_microlist_gen(i-1) + N_microlist_gen(i-1)
|
||||
! end do
|
||||
|
||||
call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint)
|
||||
call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,ptr_microlist_gen,Nint)
|
||||
|
||||
allocate(microlist_zero(Nint,2,N_minilist))
|
||||
allocate(idx_microlist_zero(N_minilist))
|
||||
|
||||
|
||||
do i=0,mo_tot_num*2
|
||||
do k=1,N_microlist(i)
|
||||
idx_microlist(k,i) = idx_minilist(idx_microlist(k,i))
|
||||
do k=ptr_microlist(i),ptr_microlist(i+1)-1
|
||||
idx_microlist(k) = idx_minilist(idx_microlist(k))
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
if(N_microlist(0) > 0) then
|
||||
microlist_zero(:,:,1:N_microlist(0)) = microlist(:,:,1:N_microlist(0))
|
||||
idx_microlist_zero(1:N_microlist(0)) = idx_microlist(1:N_microlist(0))
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
do i=1,buffer_size
|
||||
|
|
@ -92,28 +113,30 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||
smallerlist = mobiles(2)
|
||||
end if
|
||||
|
||||
if(N_microlist(smallerlist) > 0) then
|
||||
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,smallerlist), Nint, N_microlist_gen(smallerlist))) then
|
||||
if(N_microlist_gen(smallerlist) > 0) then
|
||||
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,ptr_microlist_gen(smallerlist):ptr_microlist_gen(smallerlist+1)-1), Nint, N_microlist_gen(smallerlist))) then
|
||||
cycle
|
||||
end if
|
||||
end if
|
||||
if(N_microlist_gen(0) > 0) then
|
||||
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,1:ptr_microlist_gen(1)-1), Nint, N_microlist_gen(0))) then
|
||||
cycle
|
||||
end if
|
||||
end if
|
||||
|
||||
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,0), Nint, N_microlist_gen(0))) then
|
||||
cycle
|
||||
end if
|
||||
|
||||
|
||||
if(N_microlist(smallerlist) > 0) then
|
||||
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)
|
||||
microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1)
|
||||
idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1)
|
||||
!idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist)) = idx_microlist(1:N_microlist(smallerlist))
|
||||
! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0))
|
||||
end if
|
||||
!if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size
|
||||
! 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_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0))
|
||||
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_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0))
|
||||
|
||||
c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist_zero(:,:,:),idx_microlist_zero(:),N_microlist(smallerlist)+N_microlist(0))
|
||||
else
|
||||
if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then
|
||||
cycle
|
||||
|
|
|
|||
|
|
@ -110,9 +110,7 @@ subroutine getMobiles(key,key_mask, mobiles,Nint)
|
|||
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 *, "=="
|
||||
|
||||
call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint)
|
||||
if(nel == 2) then
|
||||
|
|
@ -127,29 +125,19 @@ subroutine getMobiles(key,key_mask, mobiles,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
|
||||
|
||||
|
||||
subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, Nint)
|
||||
subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint)
|
||||
use bitmasks
|
||||
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(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, intent(out) :: N_microlist(0:mo_tot_num*2), ptr_microlist(0:mo_tot_num*2+1), idx_microlist(N_minilist*4)
|
||||
integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist*4)
|
||||
|
||||
integer :: i,j,k,nt,n_element(2)
|
||||
integer :: list(Nint*bit_kind_size,2)
|
||||
integer :: list(Nint*bit_kind_size,2), cur_microlist(0:mo_tot_num*2+1)
|
||||
integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2)
|
||||
|
||||
|
||||
|
|
@ -169,42 +157,58 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||
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
|
||||
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)
|
||||
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
|
||||
!
|
||||
! do j=1,mo_tot_num*2
|
||||
! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0)
|
||||
! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0)
|
||||
! N_microlist(j) += N_microlist(0)
|
||||
! end do
|
||||
|
||||
ptr_microlist(0) = 1
|
||||
do i=1,mo_tot_num*2+1
|
||||
ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1)
|
||||
end do
|
||||
|
||||
cur_microlist(:) = ptr_microlist(:)
|
||||
|
||||
do i=1, N_minilist
|
||||
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
|
||||
|
||||
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
|
||||
idx_microlist(cur_microlist(0)) = i
|
||||
microlist(:,:,cur_microlist(0)) = minilist(:,:,i)
|
||||
cur_microlist(0) = cur_microlist(0) + 1
|
||||
else
|
||||
do j=1,n_element(1)
|
||||
nt = list(j,1)
|
||||
idx_microlist(cur_microlist(nt)) = i
|
||||
microlist(:,:,cur_microlist(nt)) = minilist(:,:,i)
|
||||
cur_microlist(nt) = cur_microlist(nt) + 1
|
||||
end do
|
||||
|
||||
do j=1,n_element(2)
|
||||
nt = list(j,2) + mo_tot_num
|
||||
idx_microlist(cur_microlist(nt)) = i
|
||||
microlist(:,:,cur_microlist(nt)) = minilist(:,:,i)
|
||||
cur_microlist(nt) = cur_microlist(nt) + 1
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end subroutine
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user