QuantumPackage/src/bi_ort_ints/no_dressing_v0.irp.f

! ---

BEGIN_PROVIDER [double precision, noL_0e]

  implicit none
  integer                       :: i, j, k
  double precision              :: I_ijk_ijk, I_ijk_kij, I_ijk_jik, I_ijk_jki, I_ijk_ikj, I_ijk_kji
  double precision              :: t0, t1
  double precision, allocatable :: tmp(:)

  call wall_time(t0)
  print*, " Providing noL_0e ..."

  if(elec_alpha_num .eq. elec_beta_num) then

    allocate(tmp(elec_beta_num))

    !$OMP PARALLEL                                 &
    !$OMP DEFAULT (NONE)                           &
    !$OMP PRIVATE (i, j, k,                        &
    !$OMP         I_ijk_ijk, I_ijk_kij, I_ijk_jik) &
    !$OMP SHARED (elec_beta_num, tmp)

    !$OMP DO
    do i = 1, elec_beta_num

      tmp(i) = 0.d0
      do j = 1, elec_beta_num
        do k = 1, elec_beta_num

          call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
          call give_integrals_3_body_bi_ort(i, j, k, k, i, j, I_ijk_kij)
          call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)

          tmp(i) = tmp(i) + 4.d0 * (2.d0 * I_ijk_ijk + I_ijk_kij - 3.d0 * I_ijk_jik)
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL

    noL_0e = -1.d0 * (-sum(tmp)) / 6.d0

    deallocate(tmp)

  else

    allocate(tmp(elec_alpha_num))

    !$OMP PARALLEL                                 &
    !$OMP DEFAULT (NONE)                           &
    !$OMP PRIVATE (i, j, k,                        &
    !$OMP         I_ijk_ijk, I_ijk_kij, I_ijk_jik, &
    !$OMP         I_ijk_jki, I_ijk_ikj, I_ijk_kji) &
    !$OMP SHARED (elec_beta_num, elec_alpha_num, tmp)

    !$OMP DO
    do i = 1, elec_beta_num

      tmp(i) = 0.d0
      do j = 1, elec_beta_num
        do k = 1, elec_beta_num

          call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
          call give_integrals_3_body_bi_ort(i, j, k, k, i, j, I_ijk_kij)
          call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)

          tmp(i) = tmp(i) + 4.d0 * (2.d0 * I_ijk_ijk + I_ijk_kij - 3.d0 * I_ijk_jik)
        enddo
      enddo
    enddo
    !$OMP END DO

    !$OMP DO
    do i = elec_beta_num+1, elec_alpha_num

      tmp(i) = 0.d0
      do j = elec_beta_num+1, elec_alpha_num
        do k = elec_beta_num+1, elec_alpha_num

          call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
          call give_integrals_3_body_bi_ort(i, j, k, k, i, j, I_ijk_kij)
          call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)

          tmp(i) = tmp(i) + I_ijk_ijk + 2.d0 * I_ijk_kij - 3.d0 * I_ijk_jik
        enddo ! k
      enddo ! j

      do j = 1, elec_beta_num
        do k = 1, elec_beta_num

          call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
          call give_integrals_3_body_bi_ort(i, j, k, j, k, i, I_ijk_jki)
          call give_integrals_3_body_bi_ort(i, j, k, i, k, j, I_ijk_ikj)
          call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
          call give_integrals_3_body_bi_ort(i, j, k, k, j, i, I_ijk_kji)

          tmp(i) = tmp(i) + 6.d0 * (2.d0 * I_ijk_ijk + I_ijk_jki - I_ijk_ikj - I_ijk_jik - I_ijk_kji)
        enddo ! k

        do k = elec_beta_num+1, elec_alpha_num

          call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
          call give_integrals_3_body_bi_ort(i, j, k, j, k, i, I_ijk_jki)
          call give_integrals_3_body_bi_ort(i, j, k, i, k, j, I_ijk_ikj)
          call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
          call give_integrals_3_body_bi_ort(i, j, k, k, j, i, I_ijk_kji)

          tmp(i) = tmp(i) + 3.d0 * (2.d0 * I_ijk_ijk + 2.d0 * I_ijk_jki - I_ijk_ikj - I_ijk_jik - 2.d0 * I_ijk_kji)
        enddo ! k
      enddo ! j
    enddo ! i
    !$OMP END DO
    !$OMP END PARALLEL

    noL_0e = -1.d0 * (-sum(tmp)) / 6.d0

    deallocate(tmp)

  endif

  call wall_time(t1)
  print*, " Wall time for noL_0e (min) = ", (t1 - t0)/60.d0

  print*, " noL_0e = ", noL_0e

END_PROVIDER

! ---

BEGIN_PROVIDER [double precision, noL_1e, (mo_num, mo_num)]

  BEGIN_DOC
  !
  ! x (-1) because integrals are over -L
  !
  END_DOC

  implicit none
  integer          :: p, s, i, j
  double precision :: I_pij_sij, I_pij_isj, I_pij_ijs, I_pij_sji, I_pij_jsi, I_pij_jis
  double precision :: t0, t1

  call wall_time(t0)
  print*, " Providing noL_1e ..."

  if(elec_alpha_num .eq. elec_beta_num) then

    !$OMP PARALLEL                                 &
    !$OMP DEFAULT (NONE)                           &
    !$OMP PRIVATE (p, s, i, j,                     &
    !$OMP         I_pij_sij, I_pij_isj, I_pij_ijs, &
    !$OMP         I_pij_sji)                       &
    !$OMP SHARED (mo_num, elec_beta_num, noL_1e)

    !$OMP DO COLLAPSE(2)
    do s = 1, mo_num
      do p = 1, mo_num
  
        noL_1e(p,s) = 0.d0
        do i = 1, elec_beta_num
          do j = 1, elec_beta_num

            call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
            call give_integrals_3_body_bi_ort(p, i, j, i, s, j, I_pij_isj)
            call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs)
            call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji)
          
            noL_1e(p,s) = noL_1e(p,s) - (2.d0*I_pij_sij - 2.d0*I_pij_isj + I_pij_ijs - I_pij_sji)
          enddo
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL

  else

    !$OMP PARALLEL                                 &
    !$OMP DEFAULT (NONE)                           &
    !$OMP PRIVATE (p, s, i, j,                     &
    !$OMP         I_pij_sij, I_pij_isj, I_pij_ijs, &
    !$OMP         I_pij_sji, I_pij_jsi, I_pij_jis) &
    !$OMP SHARED (mo_num, elec_beta_num, elec_alpha_num, noL_1e)

    !$OMP DO COLLAPSE(2)
    do s = 1, mo_num
      do p = 1, mo_num
  
        noL_1e(p,s) = 0.d0
        do i = 1, elec_beta_num
          do j = 1, elec_beta_num

            call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
            call give_integrals_3_body_bi_ort(p, i, j, i, s, j, I_pij_isj)
            call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs)
            call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji)
          
            noL_1e(p,s) = noL_1e(p,s) - (2.d0*I_pij_sij - 2.d0*I_pij_isj + I_pij_ijs - I_pij_sji)
          enddo ! j
        enddo ! i

        do i = elec_beta_num+1, elec_alpha_num
          do j = 1, elec_beta_num

            call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji)
            call give_integrals_3_body_bi_ort(p, i, j, j, s, i, I_pij_jsi)
            call give_integrals_3_body_bi_ort(p, i, j, j, i, s, I_pij_jis)
            call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
            call give_integrals_3_body_bi_ort(p, i, j, i, s, j, I_pij_isj)
            call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs)
          
            noL_1e(p,s) = noL_1e(p,s) + 0.5d0 * (2.d0*I_pij_sji - I_pij_jsi + 2.d0*I_pij_jis - 4.d0*I_pij_sij + 2.d0*I_pij_isj - I_pij_ijs)
          enddo ! j

          do j = elec_beta_num+1, elec_alpha_num

            call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
            call give_integrals_3_body_bi_ort(p, i, j, i, s, j, I_pij_isj)
            call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs)
            call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji)
          
            noL_1e(p,s) = noL_1e(p,s) - 0.5d0 * (I_pij_sij - I_pij_isj + I_pij_ijs - I_pij_sji)
          enddo ! j
        enddo ! i

      enddo ! p
    enddo ! s
    !$OMP END DO
    !$OMP END PARALLEL

  endif

  call wall_time(t1)
  print*, " Wall time for noL_1e (min) = ", (t1 - t0)/60.d0

END_PROVIDER

! ---

BEGIN_PROVIDER [double precision, noL_2e, (mo_num, mo_num, mo_num, mo_num)]

  BEGIN_DOC
  !
  ! x (-1) because integrals are over -L
  !
  END_DOC

  implicit none
  integer          :: p, q, s, t, i
  double precision :: I_ipq_sit, I_ipq_tsi, I_ipq_ist
  double precision :: t0, t1

  call wall_time(t0)
  print*, " Providing noL_2e ..."

  if(elec_alpha_num .eq. elec_beta_num) then

    !$OMP PARALLEL                                  &
    !$OMP DEFAULT (NONE)                            &
    !$OMP PRIVATE (p, q, s, t, i,                   &
    !$OMP          I_ipq_sit, I_ipq_tsi, I_ipq_ist) &
    !$OMP SHARED (mo_num, elec_beta_num, noL_2e)

    !$OMP DO COLLAPSE(4)
    do t = 1, mo_num
      do s = 1, mo_num
        do q = 1, mo_num
          do p = 1, mo_num
  
            noL_2e(p,q,s,t) = 0.d0
            do i = 1, elec_beta_num

              call give_integrals_3_body_bi_ort(i, p, q, s, i, t, I_ipq_sit)
              call give_integrals_3_body_bi_ort(i, p, q, t, s, i, I_ipq_tsi)
              call give_integrals_3_body_bi_ort(i, p, q, i, s, t, I_ipq_ist)
          
              noL_2e(p,q,s,t) = noL_2e(p,q,s,t) - 0.5d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist)
            enddo
          enddo
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL

  else

    !$OMP PARALLEL                                  &
    !$OMP DEFAULT (NONE)                            &
    !$OMP PRIVATE (p, q, s, t, i,                   &
    !$OMP          I_ipq_sit, I_ipq_tsi, I_ipq_ist) &
    !$OMP SHARED (mo_num, elec_beta_num, elec_alpha_num, noL_2e)

    !$OMP DO COLLAPSE(4)
    do t = 1, mo_num
      do s = 1, mo_num
        do q = 1, mo_num
          do p = 1, mo_num
  
            noL_2e(p,q,s,t) = 0.d0
            do i = 1, elec_beta_num

              call give_integrals_3_body_bi_ort(i, p, q, s, i, t, I_ipq_sit)
              call give_integrals_3_body_bi_ort(i, p, q, t, s, i, I_ipq_tsi)
              call give_integrals_3_body_bi_ort(i, p, q, i, s, t, I_ipq_ist)
            
              noL_2e(p,q,s,t) = noL_2e(p,q,s,t) - 0.5d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist)
            enddo ! i

            do i = elec_beta_num+1, elec_alpha_num

              call give_integrals_3_body_bi_ort(i, p, q, s, i, t, I_ipq_sit)
              call give_integrals_3_body_bi_ort(i, p, q, t, s, i, I_ipq_tsi)
              call give_integrals_3_body_bi_ort(i, p, q, i, s, t, I_ipq_ist)
            
              noL_2e(p,q,s,t) = noL_2e(p,q,s,t) - 0.25d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist)
            enddo ! i

          enddo ! p
        enddo ! q
      enddo ! s
    enddo ! t
    !$OMP END DO
    !$OMP END PARALLEL

  endif

  call wall_time(t1)
  print*, " Wall time for noL_2e (min) = ", (t1 - t0)/60.d0

END_PROVIDER

! ---