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

reduced RAM requirement

Browse Source
This commit is contained in:
Yann Garniron 2016-01-01 11:47:17 +01:00
parent d48ff4c00e
commit 16135a7248
2 changed files with 88 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -31,13 +31,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
logical :: fullMatch logical :: fullMatch
logical, external :: is_connected_to logical, external :: is_connected_to
integer(bit_kind), allocatable :: microlist(:,:,:,:) integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:)
integer, allocatable :: idx_microlist(:,:), N_microlist(:) integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:)
integer :: mobiles(2), smallerlist integer :: mobiles(2), smallerlist
integer(bit_kind), allocatable :: microlist_gen(:,:,:,:) integer(bit_kind), allocatable :: microlist_gen(:,:,:)
integer, allocatable :: idx_microlist_gen(:,:), N_microlist_gen(:) integer, allocatable :: idx_microlist_gen(:), N_microlist_gen(:), ptr_microlist_gen(:)
allocate( minilist(Nint,2,N_det_selectors), & allocate( minilist(Nint,2,N_det_selectors), &
minilist_gen(Nint,2,N_det_generators), & 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 return
end if end if
call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) 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), & allocate( microlist(Nint,2,N_minilist*4), &
idx_microlist(N_minilist, 0:mo_tot_num*2), & idx_microlist(N_minilist*4), &
ptr_microlist(0:mo_tot_num*2+1), &
N_microlist(0:mo_tot_num*2) ) N_microlist(0:mo_tot_num*2) )
allocate( microlist_gen(Nint,2,N_minilist_gen, 0:mo_tot_num*2), & allocate( microlist_gen(Nint,2,N_minilist_gen*4), &
idx_microlist_gen(N_minilist_gen, 0:mo_tot_num*2), & idx_microlist_gen(N_minilist_gen*4 ), &
ptr_microlist_gen(0:mo_tot_num*2+1), &
N_microlist_gen(0:mo_tot_num*2) ) N_microlist_gen(0:mo_tot_num*2) )
if(key_mask(1,1) /= 0) then if(key_mask(1,1) /= 0) then
call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) ! ptr_microlist(0) = 1
call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,Nint) ! 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 i=0,mo_tot_num*2
do k=1,N_microlist(i) do k=ptr_microlist(i),ptr_microlist(i+1)-1
idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) idx_microlist(k) = idx_minilist(idx_microlist(k))
end do end do
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 end if
do i=1,buffer_size 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) smallerlist = mobiles(2)
end if end if
if(N_microlist(smallerlist) > 0) then if(N_microlist_gen(smallerlist) > 0) then
if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,smallerlist), Nint, N_microlist_gen(smallerlist))) 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 cycle
end if end if
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 if(N_microlist(smallerlist) > 0) then
microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = 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(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) 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)) ! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0))
end if end if
!if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size !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, & ! 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))
! 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, & 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 else
if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then
cycle cycle

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

@ -110,9 +110,7 @@ subroutine getMobiles(key,key_mask, mobiles,Nint)
do j=1,Nint do j=1,Nint
mobileMask(j,1) = xor(key(j,1), key_mask(j,1)) mobileMask(j,1) = xor(key(j,1), key_mask(j,1))
mobileMask(j,2) = xor(key(j,2), key_mask(j,2)) mobileMask(j,2) = xor(key(j,2), key_mask(j,2))
! print '(3(B70))', mobileMask(j,1), mobileMask(j,2)
end do end do
! print *, "=="
call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint) call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint)
if(nel == 2) then if(nel == 2) then
@ -127,29 +125,19 @@ subroutine getMobiles(key,key_mask, mobiles,Nint)
mobiles(1) = list(1) + mo_tot_num mobiles(1) = list(1) + mo_tot_num
mobiles(2) = list(2) + 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
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 use bitmasks
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(0:mo_tot_num*2), idx_microlist(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, 0:mo_tot_num*2) integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist*4)
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), cur_microlist(0:mo_tot_num*2+1)
integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2) 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(:,1), list(:,1), n_element(1), Nint)
call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), 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 if(n_element(1) + n_element(2) /= 4) then
N_microlist(0) = N_microlist(0) + 1 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 else
do j=1,n_element(1) do j=1,n_element(1)
nt = list(j,1) nt = list(j,1)
N_microlist(nt) = N_microlist(nt) + 1 N_microlist(nt) = N_microlist(nt) + 1
idx_microlist(N_microlist(nt),nt) = i
microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i)
end do end do
do j=1,n_element(2) do j=1,n_element(2)
nt = list(j,2) + mo_tot_num nt = list(j,2) + mo_tot_num
N_microlist(nt) = N_microlist(nt) + 1 N_microlist(nt) = N_microlist(nt) + 1
idx_microlist(N_microlist(nt),nt) = i
microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i)
end do end do
end if end if
end do end do
!
! do j=1,mo_tot_num*2 ptr_microlist(0) = 1
! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0) do i=1,mo_tot_num*2+1
! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0) ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1)
! N_microlist(j) += N_microlist(0) end do
! 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 end subroutine