LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-03 10:05:57 +01:00
Code Issues Releases Wiki Activity

minilist simple pour epstein 2x2

Browse Source
This commit is contained in:
Yann Garniron 2015-11-19 14:38:41 +01:00
parent 150b0f3a13
commit 132c74e60b
6 changed files with 156 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/gfortran.cfg
View File

@ -10,7 +10,7 @@
# #
# #
[COMMON] [COMMON]
FC : gfortran -g -ffree-line-length-none -I . FC : gfortran -g -ffree-line-length-none -mavx -I .
LAPACK_LIB : -llapack -lblas LAPACK_LIB : -llapack -lblas
IRPF90 : irpf90 IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 IRPF90_FLAGS : --ninja --align=32

92
plugins/MRCC_Utils/mrcc_dress.irp.f
View File

@ -14,52 +14,52 @@ BEGIN_PROVIDER [ integer(omp_lock_kind), psi_ref_lock, (psi_det_size) ]
END_PROVIDER END_PROVIDER
subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, Nint) ! subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, Nint)
use bitmasks ! use bitmasks
implicit none ! implicit none
!
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList) ! integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
integer, intent(in) :: N_fullList ! integer, intent(in) :: N_fullList
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList) ! integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
integer,intent(out) :: idx_miniList(N_fullList), N_miniList ! integer,intent(out) :: idx_miniList(N_fullList), N_miniList
integer, intent(in) :: Nint ! integer, intent(in) :: Nint
integer(bit_kind) :: key_mask(Nint, 2) ! integer(bit_kind) :: key_mask(Nint, 2)
integer :: ni, i, n_a, n_b, e_a, e_b ! integer :: ni, i, n_a, n_b, e_a, e_b
!
!
n_a = 0 ! n_a = 0
n_b = 0 ! n_b = 0
do ni=1,nint ! do ni=1,nint
n_a = n_a + popcnt(key_mask(ni,1)) ! n_a = n_a + popcnt(key_mask(ni,1))
n_b = n_b + popcnt(key_mask(ni,2)) ! n_b = n_b + popcnt(key_mask(ni,2))
end do ! end do
!
if(n_a == 0) then ! if(n_a == 0) then
N_miniList = N_fullList ! N_miniList = N_fullList
miniList(:,:,:) = fullList(:,:,:) ! miniList(:,:,:) = fullList(:,:,:)
do i=1,N_fullList ! do i=1,N_fullList
idx_miniList(i) = i ! idx_miniList(i) = i
end do ! end do
return ! return
end if ! end if
!
N_miniList = 0 ! N_miniList = 0
!
do i=1,N_fullList ! do i=1,N_fullList
e_a = n_a ! e_a = n_a
e_b = n_b ! e_b = n_b
do ni=1,nint ! do ni=1,nint
e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1))) ! e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1)))
e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2))) ! e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2)))
end do ! end do
!
if(e_a + e_b <= 2) then ! if(e_a + e_b <= 2) then
N_miniList = N_miniList + 1 ! N_miniList = N_miniList + 1
miniList(:,:,N_miniList) = fullList(:,:,i) ! miniList(:,:,N_miniList) = fullList(:,:,i)
idx_miniList(N_miniList) = i ! idx_miniList(N_miniList) = i
end if ! end if
end do ! end do
end subroutine ! end subroutine
subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask) subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask)

10
plugins/Perturbation/epstein_nesbet.irp.f
View File

@ -42,11 +42,11 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s
end end
subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st integer, intent(in) :: Nint,ndet,N_st, idx_minilist(0:N_det_selectors), N_minilist
integer(bit_kind), intent(in) :: det_pert(Nint,2) integer(bit_kind), intent(in) :: det_pert(Nint,2), minilist(Nint,2,N_det_selectors)
double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st) double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
@ -67,7 +67,9 @@ subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet
ASSERT (Nint > 0) ASSERT (Nint > 0)
PROVIDE CI_electronic_energy PROVIDE CI_electronic_energy
call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
h = diag_H_mat_elem(det_pert,Nint) h = diag_H_mat_elem(det_pert,Nint)
do i =1,N_st do i =1,N_st
if (i_H_psi_array(i) /= 0.d0) then if (i_H_psi_array(i) /= 0.d0) then

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

@ -2,7 +2,7 @@ BEGIN_SHELL [ /usr/bin/env python ]
import perturbation import perturbation
END_SHELL END_SHELL
subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint) subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask)
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply ! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply
@ -11,25 +11,51 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
integer, intent(in) :: Nint, N_st, buffer_size, i_generator integer, intent(in) :: Nint, N_st, buffer_size, i_generator
integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size) integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size)
integer(bit_kind),intent(in) :: key_mask(Nint,2)
double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st) double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st)
double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st) double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st)
double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st) double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
integer :: i,k, c_ref 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
integer(bit_kind) :: minilist(Nint,2,N_det_selectors)
integer :: idx_minilist(N_det_selectors), N_minilist
integer(bit_kind) :: minilist_gen(Nint,2,N_det_generators)
integer :: idx_minilist_gen(N_det_generators), N_minilist_gen
call create_minilist(key_mask, psi_selectors, miniList, idx_miniList, N_det_selectors, N_minilist, Nint)
call create_minilist(key_mask, psi_det_generators, miniList_gen, idx_miniList_gen, N_det_generators, N_minilist_gen, Nint)
ASSERT (Nint > 0) ASSERT (Nint > 0)
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (buffer_size >= 0) ASSERT (buffer_size >= 0)
ASSERT (minval(sum_norm_pert) >= 0.d0) ASSERT (minval(sum_norm_pert) >= 0.d0)
ASSERT (N_st > 0) ASSERT (N_st > 0)
do i = 1,buffer_size
buffer_loop : do i = 1,buffer_size
c_ref = connected_to_ref(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det_generators)
do k=1,N_minilist_gen
if (c_ref /= 0) then if(idx_minilist_gen(k) >= i_generator) then
cycle exit
endif end if
ex = 0
do ni=1,Nint
ex += popcnt(xor(minilist_gen(ni,1,k), buffer(ni,1,i))) + popcnt(xor(minilist_gen(ni,2,k), buffer(ni,2,i)))
end do
if(ex <= 4) then
cycle buffer_loop
end if
end do
! c_ref = connected_to_ref(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det_generators)
!
! if (c_ref /= 0) then
! cycle
! endif
if (is_in_wavefunction(buffer(1,1,i),Nint)) then if (is_in_wavefunction(buffer(1,1,i),Nint)) then
cycle cycle
@ -37,8 +63,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
integer :: degree integer :: degree
call get_excitation_degree(HF_bitmask,buffer(1,1,i),degree,N_int) call get_excitation_degree(HF_bitmask,buffer(1,1,i),degree,N_int)
! call pt2_$PERT(buffer(1,1,i), &
! c_pert,e_2_pert,H_pert_diag,Nint,N_det_selectors,n_st,minilist,idx_minilist)
call pt2_$PERT(buffer(1,1,i), & call pt2_$PERT(buffer(1,1,i), &
c_pert,e_2_pert,H_pert_diag,Nint,N_det_selectors,n_st) c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) !!!!!!!!!!!!!!!!! MAUVAISE SIGNATURE PR LES AUTRES PT2_* !!!!!
do k = 1,N_st do k = 1,N_st
e_2_pert_buffer(k,i) = e_2_pert(k) e_2_pert_buffer(k,i) = e_2_pert(k)
@ -48,7 +76,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
sum_H_pert_diag(k) += H_pert_diag(k) sum_H_pert_diag(k) += H_pert_diag(k)
enddo enddo
enddo enddo buffer_loop
end end

2
scripts/generate_h_apply.py
View File

@ -205,7 +205,7 @@ class H_apply(object):
""" """
self.data["keys_work"] = """ self.data["keys_work"] = """
call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, & call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
sum_norm_pert,sum_H_pert_diag,N_st,N_int) sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask)
"""%(pert,) """%(pert,)
self.data["finalization"] = """ self.data["finalization"] = """
""" """

71
src/Determinants/slater_rules.irp.f
View File

@ -763,17 +763,65 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble)
end end
subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, Nint)
subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate
integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList)
integer, intent(in) :: N_fullList
integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList)
integer,intent(out) :: idx_miniList(N_fullList), N_miniList
integer, intent(in) :: Nint
integer(bit_kind) :: key_mask(Nint, 2)
integer :: ni, i, n_a, n_b, e_a, e_b
n_a = 0
n_b = 0
do ni=1,nint
n_a = n_a + popcnt(key_mask(ni,1))
n_b = n_b + popcnt(key_mask(ni,2))
end do
if(n_a == 0) then
N_miniList = N_fullList
miniList(:,:,:) = fullList(:,:,:)
do i=1,N_fullList
idx_miniList(i) = i
end do
return
end if
N_miniList = 0
do i=1,N_fullList
e_a = n_a
e_b = n_b
do ni=1,nint
e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1)))
e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2)))
end do
if(e_a + e_b <= 2) then
N_miniList = N_miniList + 1
miniList(:,:,N_miniList) = fullList(:,:,i)
idx_miniList(N_miniList) = i
end if
end do
end subroutine
!call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
subroutine i_H_psi(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
use bitmasks
implicit none
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2) integer(bit_kind), intent(in) :: key(Nint,2)
double precision, intent(in) :: coef(Ndet_max,Nstate) double precision, intent(in) :: coef(Ndet_max,Nstate)
double precision, intent(out) :: i_H_psi_array(Nstate) double precision, intent(out) :: i_H_psi_array(Nstate)
integer :: i, ii,j integer :: i, ii,j, i_in_key, i_in_coef
double precision :: phase double precision :: phase
integer :: exc(0:2,2,2) integer :: exc(0:2,2,2)
double precision :: hij double precision :: hij
@ -789,13 +837,20 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
ASSERT (Ndet_max >= Ndet) ASSERT (Ndet_max >= Ndet)
i_H_psi_array = 0.d0 i_H_psi_array = 0.d0
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) !call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx)
do ii=1,idx(0) do ii=1,idx(0)
i = idx(ii) !i = idx_key(idx(ii))
i_in_key = idx(ii)
i_in_coef = idx_key(idx(ii))
!DEC$ FORCEINLINE !DEC$ FORCEINLINE
call i_H_j(keys(1,1,i),key,Nint,hij) ! ! call i_H_j(keys(1,1,i),key,Nint,hij)
! ! do j = 1, Nstate
! ! i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
! ! enddo
call i_H_j(keys(1,1,i_in_key),key,Nint,hij)
do j = 1, Nstate do j = 1, Nstate
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij
enddo enddo
enddo enddo
end end