9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00

Fixed Schwartz and added banned-excitations

This commit is contained in:
Anthony Scemama 2020-09-25 15:14:56 +02:00
parent 161517e0ea
commit e838868181
4 changed files with 36 additions and 21 deletions

View File

@ -4,8 +4,8 @@ type units =
| Angstrom | Angstrom
;; ;;
let angstrom_to_bohr = 1. /. 0.52917721092 let angstrom_to_bohr = 1. /. 0.52917721067121
let bohr_to_angstrom = 0.52917721092 let bohr_to_angstrom = 0.52917721067121
;; ;;

View File

@ -436,7 +436,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
!$OMP SCHEDULE(dynamic) !$OMP SCHEDULE(dynamic)
do i=1,ao_num do i=1,ao_num
do k=1,i do k=1,i
ao_two_e_integral_schwartz(i,k) = dsqrt(ao_two_e_integral(i,k,i,k)) ao_two_e_integral_schwartz(i,k) = dsqrt(ao_two_e_integral(i,i,k,k))
ao_two_e_integral_schwartz(k,i) = ao_two_e_integral_schwartz(i,k) ao_two_e_integral_schwartz(k,i) = ao_two_e_integral_schwartz(i,k)
enddo enddo
enddo enddo

View File

@ -143,24 +143,6 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ logical, banned_excitation, (mo_num,mo_num) ]
implicit none
BEGIN_DOC
! If true, the excitation is banned in the selection. Useful with local MOs.
END_DOC
banned_excitation = .False.
integer :: i,j
double precision :: buffer(mo_num)
do j=1,mo_num
call get_mo_two_e_integrals_exch_ii(j,j,mo_num,buffer,mo_integrals_map)
buffer = dabs(buffer)
do i=1,mo_num
banned_excitation(i,j) = buffer(i) < 1.d-15
enddo
enddo
END_PROVIDER
subroutine get_mask_phase(det1, pm, Nint) subroutine get_mask_phase(det1, pm, Nint)
use bitmasks use bitmasks
implicit none implicit none

View File

@ -99,6 +99,10 @@ double precision function get_two_e_integral(i,j,k,l,map)
type(map_type), intent(inout) :: map type(map_type), intent(inout) :: map
real(integral_kind) :: tmp real(integral_kind) :: tmp
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
if (banned_excitation(i,k) .or. banned_excitation(j,l)) then
get_two_e_integral = 0.d0
return
endif
ii = l-mo_integrals_cache_min ii = l-mo_integrals_cache_min
ii = ior(ii, k-mo_integrals_cache_min) ii = ior(ii, k-mo_integrals_cache_min)
ii = ior(ii, j-mo_integrals_cache_min) ii = ior(ii, j-mo_integrals_cache_min)
@ -159,6 +163,11 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
! return ! return
!DEBUG !DEBUG
out_val(1:sze) = 0.d0
if (banned_excitation(j,l)) then
return
endif
ii0 = l-mo_integrals_cache_min ii0 = l-mo_integrals_cache_min
ii0 = ior(ii0, k-mo_integrals_cache_min) ii0 = ior(ii0, k-mo_integrals_cache_min)
ii0 = ior(ii0, j-mo_integrals_cache_min) ii0 = ior(ii0, j-mo_integrals_cache_min)
@ -172,6 +181,7 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
q = q+shiftr(s*s-s,1) q = q+shiftr(s*s-s,1)
do i=1,sze do i=1,sze
if (banned_excitation(i,k)) cycle
ii = ior(ii0, i-mo_integrals_cache_min) ii = ior(ii0, i-mo_integrals_cache_min)
if (iand(ii, -128) == 0) then if (iand(ii, -128) == 0) then
ii_8 = ior( shiftl(ii0_8,7), int(i,8)-mo_integrals_cache_min_8) ii_8 = ior( shiftl(ii0_8,7), int(i,8)-mo_integrals_cache_min_8)
@ -272,6 +282,29 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
end end
BEGIN_PROVIDER [ logical, banned_excitation, (mo_num,mo_num) ]
implicit none
use map_module
BEGIN_DOC
! If true, the excitation is banned in the selection. Useful with local MOs.
END_DOC
banned_excitation = .False.
integer :: i,j
integer(key_kind) :: idx
double precision :: tmp
! double precision :: buffer(mo_num)
do j=1,mo_num
do i=1,j-1
call two_e_integrals_index(i,j,j,i,idx)
!DIR$ FORCEINLINE
call map_get(mo_integrals_map,idx,tmp)
banned_excitation(i,j) = dabs(tmp) < 1.d-15
banned_excitation(j,i) = banned_excitation(i,j)
enddo
enddo
END_PROVIDER
integer*8 function get_mo_map_size() integer*8 function get_mo_map_size()
implicit none implicit none