diff --git a/src/determinants/fock_diag.irp.f b/src/determinants/fock_diag.irp.f index 6f2ffb9b..5c8f3603 100644 --- a/src/determinants/fock_diag.irp.f +++ b/src/determinants/fock_diag.irp.f @@ -30,71 +30,11 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) stop -1 endif - if (is_complex) then - ! Occupied MOs - do ii=1,elec_alpha_num - i = occ(ii,1) - fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + dble(mo_one_e_integrals_complex(i,i)) - E0 = E0 + dble(mo_one_e_integrals_complex(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) + dble(mo_one_e_integrals_complex(i,i)) - E0 = E0 + dble(mo_one_e_integrals_complex(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) + dble(mo_one_e_integrals_complex(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) + dble(mo_one_e_integrals_complex(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 - 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) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i) + E0 = E0 + mo_one_e_integrals_diag(i) do jj=1,elec_alpha_num j = occ(jj,1) if (i==j) cycle @@ -109,8 +49,8 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) 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) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i) + E0 = E0 + mo_one_e_integrals_diag(i) do jj=1,elec_beta_num j = occ(jj,2) if (i==j) cycle @@ -126,7 +66,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) ! 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) + fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(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) @@ -138,7 +78,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint) 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) + fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(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) @@ -148,7 +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) enddo enddo - endif fock_diag_tmp(1,mo_num+1) = E0 fock_diag_tmp(2,mo_num+1) = E0 diff --git a/src/determinants/ref_bitmask.irp.f b/src/determinants/ref_bitmask.irp.f index 4e029ceb..675ef5b6 100644 --- a/src/determinants/ref_bitmask.irp.f +++ b/src/determinants/ref_bitmask.irp.f @@ -27,15 +27,15 @@ ref_bitmask_two_e_energy = 0.d0 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_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) + mo_kinetic_integrals(occ(i,2),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_energy += mo_one_e_integrals_diag(occ(i,1)) + mo_one_e_integrals_diag(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_diag(occ(i,1)) + mo_integrals_n_e_diag(occ(i,2)) enddo do i = elec_beta_num+1,elec_alpha_num - ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1)) - ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) - ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1)) + ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1)) + ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1)) + ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1)) enddo do j= 1, elec_alpha_num diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 6b164816..52dfc143 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -1745,7 +1745,7 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb) call bitstring_to_list_ab(key, occ, tmp, Nint) na = na-1 - hjj = hjj - mo_one_e_integrals(iorb,iorb) + hjj = hjj - mo_one_e_integrals_diag(iorb) ! Same spin 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) other_spin = iand(ispin,1)+1 - hjj = hjj + mo_one_e_integrals(iorb,iorb) + hjj = hjj + mo_one_e_integrals_diag(iorb) ! Same spin do i=1,na diff --git a/src/determinants/slater_rules_wee_mono.irp.f b/src/determinants/slater_rules_wee_mono.irp.f index 4c1c9330..3a8c9075 100644 --- a/src/determinants/slater_rules_wee_mono.irp.f +++ b/src/determinants/slater_rules_wee_mono.irp.f @@ -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) do ispin = 1,2 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 diff --git a/src/mo_one_e_ints/kin_mo_ints.irp.f b/src/mo_one_e_ints/kin_mo_ints.irp.f index 216628bb..b12b39bc 100644 --- a/src/mo_one_e_ints/kin_mo_ints.irp.f +++ b/src/mo_one_e_ints/kin_mo_ints.irp.f @@ -22,3 +22,22 @@ BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)] 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 diff --git a/src/mo_one_e_ints/mo_one_e_ints.irp.f b/src/mo_one_e_ints/mo_one_e_ints.irp.f index ac4b4e3b..5e9f4997 100644 --- a/src/mo_one_e_ints/mo_one_e_ints.irp.f +++ b/src/mo_one_e_ints/mo_one_e_ints.irp.f @@ -24,3 +24,23 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)] ENDIF 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 diff --git a/src/mo_one_e_ints/pot_mo_ints.irp.f b/src/mo_one_e_ints/pot_mo_ints.irp.f index 90f7b06c..6682449a 100644 --- a/src/mo_one_e_ints/pot_mo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_ints.irp.f @@ -44,3 +44,22 @@ BEGIN_PROVIDER [double precision, mo_integrals_n_e_per_atom, (mo_num,mo_num,nucl 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 diff --git a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f index 179b33ed..f135629a 100644 --- a/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f +++ b/src/mo_one_e_ints/pot_mo_pseudo_ints.irp.f @@ -25,4 +25,23 @@ BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)] 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 diff --git a/src/mo_two_e_ints/core_quantities.irp.f b/src/mo_two_e_ints/core_quantities.irp.f index 8afbcd83..773561f0 100644 --- a/src/mo_two_e_ints/core_quantities.irp.f +++ b/src/mo_two_e_ints/core_quantities.irp.f @@ -5,25 +5,14 @@ BEGIN_PROVIDER [double precision, core_energy] END_DOC integer :: i,j,k,l core_energy = 0.d0 - if (is_complex) then - do i = 1, n_core_orb - j = list_core(i) - core_energy += 2.d0 * dble(mo_one_e_integrals_complex(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 - 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) + core_energy += 2.d0 * mo_one_e_integrals_diag(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 END_PROVIDER