LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-18 11:23:38 +01:00
Code Releases Activity

providers for diag one elec mo ints

Browse Source
This commit is contained in:
Kevin Gasperich 2020-02-20 15:22:03 -06:00
parent 1c838a30d6
commit bcf824cc18
9 changed files with 93 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
src/determinants/fock_diag.irp.f
View File

@ -30,12 +30,11 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
stop -1 stop -1
endif endif
if (is_complex) then
! Occupied MOs ! Occupied MOs
do ii=1,elec_alpha_num do ii=1,elec_alpha_num
i = occ(ii,1) i = occ(ii,1)
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i)
E0 = E0 + dble(mo_one_e_integrals_complex(i,i)) E0 = E0 + mo_one_e_integrals_diag(i)
do jj=1,elec_alpha_num do jj=1,elec_alpha_num
j = occ(jj,1) j = occ(jj,1)
if (i==j) cycle if (i==j) cycle
@ -50,8 +49,8 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
enddo enddo
do ii=1,elec_beta_num do ii=1,elec_beta_num
i = occ(ii,2) i = occ(ii,2)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + dble(mo_one_e_integrals_complex(i,i)) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i)
E0 = E0 + dble(mo_one_e_integrals_complex(i,i)) E0 = E0 + mo_one_e_integrals_diag(i)
do jj=1,elec_beta_num do jj=1,elec_beta_num
j = occ(jj,2) j = occ(jj,2)
if (i==j) cycle if (i==j) cycle
@ -67,7 +66,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
! Virtual MOs ! Virtual MOs
do i=1,mo_num do i=1,mo_num
if (fock_diag_tmp(1,i) /= 0.d0) cycle if (fock_diag_tmp(1,i) /= 0.d0) cycle
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i)
do jj=1,elec_alpha_num do jj=1,elec_alpha_num
j = occ(jj,1) j = occ(jj,1)
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j) fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j)
@ -79,7 +78,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
enddo enddo
do i=1,mo_num do i=1,mo_num
if (fock_diag_tmp(2,i) /= 0.d0) cycle if (fock_diag_tmp(2,i) /= 0.d0) cycle
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + dble(mo_one_e_integrals_complex(i,i)) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i)
do jj=1,elec_beta_num do jj=1,elec_beta_num
j = occ(jj,2) j = occ(jj,2)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j)
@ -89,66 +88,6 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j) fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j)
enddo enddo
enddo enddo
else
! Occupied MOs
do ii=1,elec_alpha_num
i = occ(ii,1)
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals(i,i)
E0 = E0 + mo_one_e_integrals(i,i)
do jj=1,elec_alpha_num
j = occ(jj,1)
if (i==j) cycle
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j)
E0 = E0 + 0.5d0*mo_two_e_integrals_jj_anti(i,j)
enddo
do jj=1,elec_beta_num
j = occ(jj,2)
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj(i,j)
E0 = E0 + mo_two_e_integrals_jj(i,j)
enddo
enddo
do ii=1,elec_beta_num
i = occ(ii,2)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals(i,i)
E0 = E0 + mo_one_e_integrals(i,i)
do jj=1,elec_beta_num
j = occ(jj,2)
if (i==j) cycle
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j)
E0 = E0 + 0.5d0*mo_two_e_integrals_jj_anti(i,j)
enddo
do jj=1,elec_alpha_num
j = occ(jj,1)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j)
enddo
enddo
! Virtual MOs
do i=1,mo_num
if (fock_diag_tmp(1,i) /= 0.d0) cycle
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals(i,i)
do jj=1,elec_alpha_num
j = occ(jj,1)
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j)
enddo
do jj=1,elec_beta_num
j = occ(jj,2)
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj(i,j)
enddo
enddo
do i=1,mo_num
if (fock_diag_tmp(2,i) /= 0.d0) cycle
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals(i,i)
do jj=1,elec_beta_num
j = occ(jj,2)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j)
enddo
do jj=1,elec_alpha_num
j = occ(jj,1)
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj(i,j)
enddo
enddo
endif
fock_diag_tmp(1,mo_num+1) = E0 fock_diag_tmp(1,mo_num+1) = E0
fock_diag_tmp(2,mo_num+1) = E0 fock_diag_tmp(2,mo_num+1) = E0

12
src/determinants/ref_bitmask.irp.f
View File

@ -27,15 +27,15 @@
ref_bitmask_two_e_energy = 0.d0 ref_bitmask_two_e_energy = 0.d0
do i = 1, elec_beta_num do i = 1, elec_beta_num
ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1)) + mo_one_e_integrals(occ(i,2),occ(i,2)) ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1)) + mo_one_e_integrals_diag(occ(i,2))
ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) + mo_kinetic_integrals(occ(i,2),occ(i,2)) ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1)) + mo_kinetic_integrals_diag(occ(i,2))
ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1)) + mo_integrals_n_e(occ(i,2),occ(i,2)) ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1)) + mo_integrals_n_e_diag(occ(i,2))
enddo enddo
do i = elec_beta_num+1,elec_alpha_num do i = elec_beta_num+1,elec_alpha_num
ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1)) ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1))
ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1))
ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1)) ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1))
enddo enddo
do j= 1, elec_alpha_num do j= 1, elec_alpha_num

4
src/determinants/slater_rules.irp.f
View File

@ -1745,7 +1745,7 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb)
call bitstring_to_list_ab(key, occ, tmp, Nint) call bitstring_to_list_ab(key, occ, tmp, Nint)
na = na-1 na = na-1
hjj = hjj - mo_one_e_integrals(iorb,iorb) hjj = hjj - mo_one_e_integrals_diag(iorb)
! Same spin ! Same spin
do i=1,na do i=1,na
@ -1803,7 +1803,7 @@ subroutine ac_operator(iorb,ispin,key,hjj,Nint,na,nb)
key(k,ispin) = ibset(key(k,ispin),l) key(k,ispin) = ibset(key(k,ispin),l)
other_spin = iand(ispin,1)+1 other_spin = iand(ispin,1)+1
hjj = hjj + mo_one_e_integrals(iorb,iorb) hjj = hjj + mo_one_e_integrals_diag(iorb)
! Same spin ! Same spin
do i=1,na do i=1,na

2
src/determinants/slater_rules_wee_mono.irp.f
View File

@ -225,7 +225,7 @@ double precision function diag_H_mat_elem_one_e(det_in,Nint)
call bitstring_to_list_ab(det_in, occ_particle, tmp, Nint) call bitstring_to_list_ab(det_in, occ_particle, tmp, Nint)
do ispin = 1,2 do ispin = 1,2
do i = 1, tmp(ispin) do i = 1, tmp(ispin)
diag_H_mat_elem_one_e += mo_one_e_integrals(occ_particle(i,ispin),occ_particle(i,ispin)) diag_H_mat_elem_one_e += mo_one_e_integrals_diag(occ_particle(i,ispin))
enddo enddo
enddo enddo

19
src/mo_one_e_ints/kin_mo_ints.irp.f
View File

@ -22,3 +22,22 @@ BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_kinetic_integrals_diag,(mo_num)]
implicit none
integer :: i
BEGIN_DOC
! diagonal elements of mo_kinetic_integrals or mo_kinetic_integrals_complex
END_DOC
if (is_complex) then
PROVIDE mo_kinetic_integrals_complex
do i=1,mo_num
mo_kinetic_integrals_diag(i) = dble(mo_kinetic_integrals_complex(i,i))
enddo
else
PROVIDE mo_kinetic_integrals
do i=1,mo_num
mo_kinetic_integrals_diag(i) = mo_kinetic_integrals(i,i)
enddo
endif
END_PROVIDER

20
src/mo_one_e_ints/mo_one_e_ints.irp.f
View File

@ -24,3 +24,23 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)]
ENDIF ENDIF
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_one_e_integrals_diag,(mo_num)]
implicit none
integer :: i
BEGIN_DOC
! diagonal elements of mo_one_e_integrals or mo_one_e_integrals_complex
END_DOC
if (is_complex) then
PROVIDE mo_one_e_integrals_complex
do i=1,mo_num
mo_one_e_integrals_diag(i) = dble(mo_one_e_integrals_complex(i,i))
enddo
else
PROVIDE mo_one_e_integrals
do i=1,mo_num
mo_one_e_integrals_diag(i) = mo_one_e_integrals(i,i)
enddo
endif
END_PROVIDER

19
src/mo_one_e_ints/pot_mo_ints.irp.f
View File

@ -44,3 +44,22 @@ BEGIN_PROVIDER [double precision, mo_integrals_n_e_per_atom, (mo_num,mo_num,nucl
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_integrals_n_e_diag,(mo_num)]
implicit none
integer :: i
BEGIN_DOC
! diagonal elements of mo_integrals_n_e or mo_integrals_n_e_complex
END_DOC
if (is_complex) then
PROVIDE mo_integrals_n_e_complex
do i=1,mo_num
mo_integrals_n_e_diag(i) = dble(mo_integrals_n_e_complex(i,i))
enddo
else
PROVIDE mo_integrals_n_e
do i=1,mo_num
mo_integrals_n_e_diag(i) = mo_integrals_n_e(i,i)
enddo
endif
END_PROVIDER

19
src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f
View File

@ -25,4 +25,23 @@ BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_pseudo_integrals_diag,(mo_num)]
implicit none
integer :: i
BEGIN_DOC
! diagonal elements of mo_pseudo_integrals or mo_pseudo_integrals_complex
END_DOC
if (is_complex) then
PROVIDE mo_pseudo_integrals_complex
do i=1,mo_num
mo_pseudo_integrals_diag(i) = dble(mo_pseudo_integrals_complex(i,i))
enddo
else
PROVIDE mo_pseudo_integrals
do i=1,mo_num
mo_pseudo_integrals_diag(i) = mo_pseudo_integrals(i,i)
enddo
endif
END_PROVIDER

13
src/mo_two_e_ints/core_quantities.irp.f
View File

@ -5,25 +5,14 @@ BEGIN_PROVIDER [double precision, core_energy]
END_DOC END_DOC
integer :: i,j,k,l integer :: i,j,k,l
core_energy = 0.d0 core_energy = 0.d0
if (is_complex) then
do i = 1, n_core_orb do i = 1, n_core_orb
j = list_core(i) j = list_core(i)
core_energy += 2.d0 * dble(mo_one_e_integrals_complex(j,j)) + mo_two_e_integrals_jj(j,j) core_energy += 2.d0 * mo_one_e_integrals_diag(j) + mo_two_e_integrals_jj(j,j)
do k = i+1, n_core_orb do k = i+1, n_core_orb
l = list_core(k) l = list_core(k)
core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l)) core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l))
enddo enddo
enddo enddo
else
do i = 1, n_core_orb
j = list_core(i)
core_energy += 2.d0 * mo_one_e_integrals(j,j) + mo_two_e_integrals_jj(j,j)
do k = i+1, n_core_orb
l = list_core(k)
core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l))
enddo
enddo
endif
core_energy += nuclear_repulsion core_energy += nuclear_repulsion
END_PROVIDER END_PROVIDER