From 16135a724812f75d169284c6cb800c0860794be0 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 1 Jan 2016 11:47:17 +0100 Subject: [PATCH] reduced RAM requirement --- plugins/Perturbation/perturbation.template.f | 69 +++++++++++------ src/Determinants/filter_connected.irp.f | 80 ++++++++++---------- 2 files changed, 88 insertions(+), 61 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 7fdd3435..e490ce07 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -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 diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 060e1547..8635d921 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -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