From 9a515ed0b699ac0d9a122ed4c0682f38f9c236b8 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 17 Dec 2015 22:06:57 +0100 Subject: [PATCH] better microlist --- config/gfortran.cfg | 2 +- plugins/Perturbation/perturbation.template.f | 29 +++++-- src/Determinants/H_apply.template.f | 20 +++-- src/Determinants/filter_connected.irp.f | 88 ++++++++++++-------- 4 files changed, 85 insertions(+), 54 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 396f8a45..6e69033c 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32 # 0 : Deactivate # [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 OPENMP : 1 ; Append OpenMP flags diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index d505efdb..37f7840e 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -56,10 +56,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c deallocate( minilist, minilist_gen, idx_minilist ) return 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), & - idx_microlist(N_minilist, mo_tot_num*2), & - N_microlist(mo_tot_num*2) ) + 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), & + 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 - 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 smallerlist = mobiles(1) else smallerlist = mobiles(2) 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, & - 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 - 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) + 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 ; diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index 58ae8b08..d9131936 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -97,25 +97,31 @@ end subroutine 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) 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,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 :: n_minilist, n_alpha, n_beta, deg(2), i, ni $declarations + integer(bit_kind), parameter :: one = 1_8 p1_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)) - p2_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) = ishft(1,iand(fh2-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-1,-bit_kind_shift) + 1, fs2) = ishft(one,iand(fh2-1,bit_kind_size-1)) 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(fh2,-bit_kind_shift) + 1, fs2) -= ishft(1,iand(fh2-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-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 ) end subroutine diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 081fb548..22a3ec92 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -104,27 +104,39 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) integer,intent(out) :: mobiles(2) 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 - print *, "GETMOBILES UNIMPLEMENTED" - stop - end if + 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 *, "==" - - mobileMask(1) = xor(key(1,1), key_mask(1,1)) - mobileMask(2) = xor(key(1,2), key_mask(1,2)) - - if(mobileMask(1) /= 0 .and. mobileMask(2) /= 0) then - mobiles(1) = trailz(mobileMask(1)) + 1 - mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num - else if(mobileMask(1) /= 0) then - mobiles(1) = trailz(mobileMask(1)) + 1 - mobiles(2) = bit_kind*8 - leadz(mobileMask(1)) + call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint) + if(nel == 2) then + mobiles(1) = list(1) + mobiles(2) = list(2) + else if(nel == 1) then + mobiles(1) = list(1) + call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint) + mobiles(2) = list(1) + mo_tot_num else - mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num - mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num + call bitstring_to_list(mobileMask(:,2), list(:), nel, 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 @@ -133,19 +145,14 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro 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(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, 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 :: i,j,k,nt,n_element(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 key_mask_neg(i,1) = not(key_mask(i,1)) 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 - 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) + 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 - if(n_element(1) + n_element(2) > 4) then - print *, "WTF???" - stop - end if + 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 - 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 + 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)