LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-04-25 17:54:44 +02:00
Code Releases Activity

Simplified hij_cache in pt2

Browse Source
This commit is contained in:
Anthony Scemama 2025-02-13 16:06:05 +01:00
parent 96e2783d1e
commit bce68e7461
1 changed files with 9 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/cipsi/selection.irp.f
View File

@ -1478,19 +1478,17 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
integer, parameter :: bant=1
! double precision, allocatable :: hij_cache1(:), hij_cache2(:)
double precision, allocatable :: hij_cache1(:,:), hij_cache2(:,:)
! allocate (hij_cache1(mo_num),hij_cache2(mo_num))
double precision, allocatable :: hij_cache(:,:)
PROVIDE mo_integrals_threshold
if(sp == 3) then ! AB
allocate(hij_cache(mo_num,mo_num))
allocate(hij_cache1(mo_num,mo_num))
if(sp == 3) then ! AB
h1 = p(1,1)
h2 = p(1,2)
call get_mo_two_e_integrals_ij(h2,h1,mo_num,hij_cache1,mo_integrals_map)
call get_mo_two_e_integrals_ij(h2,h1,mo_num,hij_cache,mo_integrals_map)
do p1=1, mo_num
if(bannedOrb(p1, 1)) cycle
do p2=1, mo_num
@ -1501,7 +1499,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
call i_h_j(gen, det, N_int, hij)
else
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
hij = hij_cache1(p2,p1) * phase
hij = hij_cache(p2,p1) * phase
end if
if (dabs(hij) < mo_integrals_threshold) cycle
!DIR$ LOOP COUNT AVG(4)
@ -1511,16 +1509,11 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
end do
end do
deallocate(hij_cache1)
else ! AA BB
allocate(hij_cache1(mo_num,mo_num),hij_cache2(mo_num,mo_num))
p1 = p(1,sp)
p2 = p(2,sp)
call get_mo_two_e_integrals_ij(p2,p1,mo_num,hij_cache1,mo_integrals_map)
call get_mo_two_e_integrals_ij(p1,p2,mo_num,hij_cache2,mo_integrals_map)
call get_mo_two_e_integrals_ij(p2,p1,mo_num,hij_cache,mo_integrals_map)
do puti=1, mo_num
if (bannedOrb(puti, sp)) cycle
do putj=puti+1, mo_num
@ -1531,7 +1524,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
call i_h_j(gen, det, N_int, hij)
if (dabs(hij) < mo_integrals_threshold) cycle
else
hij = hij_cache1(putj,puti) - hij_cache2(putj,puti)
hij = hij_cache(putj,puti) - hij_cache(puti,putj)
if (dabs(hij) < mo_integrals_threshold) cycle
hij = hij * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
end if
@ -1542,11 +1535,10 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
end do
end do
deallocate(hij_cache1,hij_cache2)
end if
! deallocate(hij_cache1,hij_cache2)
deallocate(hij_cache)
end