* CCSD(T) spin orb

Ref:
John D. Watts, Jürgen Gauss, and Rodney J. Bartlett
J. Chem. Phys. 98, 8718 (1993)
http://dx.doi.org/10.1063/1.464480

** v1
#+begin_src f90 :comments org :tangle ccsd_t_spin_orb.irp.f
subroutine ccsd_par_t_spin(nO,nV,t1,t2,f_o,f_v,f_ov,v_ooov,v_vvoo,v_vvvo,energy)

  implicit none

  integer, intent(in)           :: nO, nV
  double precision, intent(in)  :: t1(nO,nV), t2(nO,nO,nV,nV)
  double precision, intent(in)  :: f_o(nO), f_v(nV), f_ov(nO,nV)
  double precision, intent(in)  :: v_ooov(nO,nO,nO,nV)
  double precision, intent(in)  :: v_vvoo(nV,nV,nO,nO), v_vvvo(nV,nV,nV,nO)
  double precision, intent(out) :: energy

  double precision, allocatable :: t3(:,:,:,:,:,:), s(:,:)
  double precision              :: e_t, e_st, e_dt, delta_abc, delta
  integer                       :: i,j,k,l,m,a,b,c,d,e

  allocate(t3(nO,nO,nO,nV,nV,nV), s(nO,nV))

  t3 = 0d0
  
  ! T3
  do c = 1, nV
    do b = 1, nV
      do a = 1, nV
        delta_abc = f_v(a) + f_v(b) + f_v(c)
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
              do e = 1, nV
                t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) &
                  + t2(j,k,a,e) * v_vvvo(b,c,e,i) &
                  - t2(i,k,a,e) * v_vvvo(b,c,e,j) & ! - P(ij)
                  - t2(j,i,a,e) * v_vvvo(b,c,e,k) & ! - P(ik)
                  - t2(j,k,b,e) * v_vvvo(a,c,e,i) & ! - P(ab)
                  - t2(j,k,c,e) * v_vvvo(b,a,e,i) & ! - P(ac)
                  + t2(i,k,b,e) * v_vvvo(a,c,e,j) & ! + P(ij) P(ab)
                  + t2(i,k,c,e) * v_vvvo(b,a,e,j) & ! + P(ij) P(ac)
                  + t2(j,i,b,e) * v_vvvo(a,c,e,k) & ! + P(ik) P(ab)
                  + t2(j,i,c,e) * v_vvvo(b,a,e,k)   ! + P(ik) P(ac)
              enddo
              do m = 1, nO
                t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) &
                  + t2(m,i,b,c) * v_ooov(j,k,m,a) &
                  - t2(m,j,b,c) * v_ooov(i,k,m,a) & ! - P(ij)
                  - t2(m,k,b,c) * v_ooov(j,i,m,a) & ! - P(ik)
                  - t2(m,i,a,c) * v_ooov(j,k,m,b) & ! - P(ab)
                  - t2(m,i,b,a) * v_ooov(j,k,m,c) & ! - P(ac)
                  + t2(m,j,a,c) * v_ooov(i,k,m,b) & ! + P(ij) P(ab)
                  + t2(m,j,b,a) * v_ooov(i,k,m,c) & ! + P(ij) P(ac)
                  + t2(m,k,a,c) * v_ooov(j,i,m,b) & ! + P(ik) P(ab)
                  + t2(m,k,b,a) * v_ooov(j,i,m,c)   ! + P(ik) P(ac)
              enddo
                t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) * (1d0 / delta)
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo
  

  ! E_T
  e_t = 0d0
  do c = 1, nV
    do b = 1, nV
      do a = 1, nV
        delta_abc = f_v(a) + f_v(b) + f_v(c)
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
              e_t = e_t + t3(i,j,k,a,b,c) * delta * t3(i,j,k,a,b,c)
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo
  e_t = e_t / 36d0

  ! E_ST
  s = 0d0
  do c = 1, nV
    do b = 1, nV
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              s(i,a) = s(i,a) + v_vvoo(b,c,j,k) * t3(i,j,k,a,b,c)
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo

  e_st = 0d0
  do a = 1, nV
    do i = 1, nO
      e_st = e_st + s(i,a) * t1(i,a)
    enddo
  enddo
  e_st = e_st * 0.25d0

  ! E_DT
  e_dt = 0d0
  do c = 1, nV
    do b = 1, nV
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              e_dt = e_dt + t2(i,j,a,b) * f_ov(k,c) * t3(i,j,k,a,b,c)
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo
  e_dt = e_dt * 0.25d0

  ! (T)
  !print*,e_t,e_st,e_dt
  energy = e_t + e_st + e_dt

  deallocate(t3,s)
  
end
#+end_src

** v2
#+begin_src f90 :comments org :tangle ccsd_t_spin_orb.irp.f
subroutine ccsd_par_t_spin_v2(nO,nV,t1,t2,f_o,f_v,f_ov,v_ooov,v_vvoo,energy)

  implicit none

  integer, intent(in)           :: nO, nV
  double precision, intent(in)  :: t1(nO,nV), t2(nO,nO,nV,nV)
  double precision, intent(in)  :: f_o(nO), f_v(nV), f_ov(nO,nV)
  double precision, intent(in)  :: v_ooov(nO,nO,nO,nV)
  double precision, intent(in)  :: v_vvoo(nV,nV,nO,nO)
  double precision, intent(out) :: energy

  double precision, allocatable :: t3_bc(:,:,:,:), s(:,:), e_t(:), e_dt(:)
  double precision, allocatable :: A_vovv(:,:,:,:), v_vvvo(:,:,:,:)
  double precision, allocatable :: T_voov(:,:,:,:), B_ooov(:,:,:,:)
  double precision              :: e_st, delta_abc, delta, ta, tb
  integer                       :: i,j,k,l,m,a,b,c,d,e

  allocate(t3_bc(nO,nO,nO,nV), s(nO,nV), e_t(nV), e_dt(nV))
  allocate(A_vovv(nV,nO,nV,nV),v_vvvo(nV,nV,nV,nO),T_voov(nV,nO,nO,nV),B_ooov(nO,nO,nO,nV))

  call gen_v_spin(cc_nV_m,cc_nV_m,cc_nV_m,cc_nO_m, &
       cc_nV_S,cc_nV_S,cc_nV_S,cc_nO_S, &
       cc_list_vir_spin,cc_list_vir_spin,cc_list_vir_spin,cc_list_occ_spin, &
       nV,nV,nV,nO, v_vvvo)
  
  ! Init 
  s = 0d0
  e_t = 0d0
  e_st = 0d0
  e_dt = 0d0

  call wall_time(ta)
  !$OMP PARALLEL &
  !$OMP PRIVATE(i,j,k,m,a,b,c,e) &
  !$OMP SHARED(A_vovv,ta,tb,t3_bc,s,e_t,e_st,e_dt,t2,v_vvvo,v_ooov, &
  !$OMP v_vvoo,f_o,f_v,f_ov,delta,delta_abc,nO,nV,T_voov,B_ooov) &
  !$OMP DEFAULT(NONE)

  !$OMP DO collapse(3)
  do c = 1, nV
    do b = 1, nV
      do i = 1, nO
        do e = 1, nV
          A_vovv(e,i,b,c) = v_vvvo(b,c,e,i)
        enddo
      enddo
    enddo
  enddo
  !$OMP END DO nowait

  !$omp do collapse(3)
  do a = 1, nV
    do k = 1, nO
      do j = 1, nO
        do e = 1, nV
          T_voov(e,j,k,a) = t2(j,k,a,e)
        enddo
      enddo
    enddo
  enddo
  !$omp end do nowait

  !$omp do collapse(3)
  do a = 1, nV
    do k = 1, nO
      do j = 1, nO
        do m = 1, nO
          B_ooov(m,j,k,a) = v_ooov(j,k,m,a)
        enddo
      enddo
    enddo
  enddo
  !$omp end do

  do c = 1, nV
    do b = 1, nV

      ! T3(:,:,:,:,b,c)
      ! Init
      !$OMP DO collapse(3)
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              t3_bc(i,j,k,a) = 0d0
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      
      !$OMP DO collapse(3)
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              do e = 1, nV
                t3_bc(i,j,k,a) = t3_bc(i,j,k,a) &
                   !+ t2(j,k,a,e) * v_vvvo(b,c,e,i) &
                   !- t2(i,k,a,e) * v_vvvo(b,c,e,j) & ! - P(ij)
                   !- t2(j,i,a,e) * v_vvvo(b,c,e,k) & ! - P(ik)
                   !- t2(j,k,b,e) * v_vvvo(a,c,e,i) & ! - P(ab)
                   !- t2(j,k,c,e) * v_vvvo(b,a,e,i) & ! - P(ac)
                   !+ t2(i,k,b,e) * v_vvvo(a,c,e,j) & ! + P(ij) P(ab)
                   !+ t2(i,k,c,e) * v_vvvo(b,a,e,j) & ! + P(ij) P(ac)
                   !+ t2(j,i,b,e) * v_vvvo(a,c,e,k) & ! + P(ik) P(ab)
                   !+ t2(j,i,c,e) * v_vvvo(b,a,e,k)   ! + P(ik) P(ac)
                   + T_voov(e,j,k,a) * A_vovv(e,i,b,c) &
                   - T_voov(e,i,k,a) * A_vovv(e,j,b,c) & ! - P(ij)
                   - T_voov(e,j,i,a) * A_vovv(e,k,b,c) & ! - P(ik)
                   - T_voov(e,j,k,b) * A_vovv(e,i,a,c) & ! - P(ab)
                   - T_voov(e,j,k,c) * A_vovv(e,i,b,a) & ! - P(ac)
                   + T_voov(e,i,k,b) * A_vovv(e,j,a,c) & ! + P(ij) P(ab)
                   + T_voov(e,i,k,c) * A_vovv(e,j,b,a) & ! + P(ij) P(ac)
                   + T_voov(e,j,i,b) * A_vovv(e,k,a,c) & ! + P(ik) P(ab)
                   + T_voov(e,j,i,c) * A_vovv(e,k,b,a)   ! + P(ik) P(ac)
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
      
      !$OMP DO collapse(3)
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              do m = 1, nO
                t3_bc(i,j,k,a) = t3_bc(i,j,k,a) &
                   !+ t2(m,i,b,c) * v_ooov(j,k,m,a) &
                   !- t2(m,j,b,c) * v_ooov(i,k,m,a) & ! - P(ij)
                   !- t2(m,k,b,c) * v_ooov(j,i,m,a) & ! - P(ik)
                   !- t2(m,i,a,c) * v_ooov(j,k,m,b) & ! - P(ab)
                   !- t2(m,i,b,a) * v_ooov(j,k,m,c) & ! - P(ac)
                   !+ t2(m,j,a,c) * v_ooov(i,k,m,b) & ! + P(ij) P(ab)
                   !+ t2(m,j,b,a) * v_ooov(i,k,m,c) & ! + P(ij) P(ac)
                   !+ t2(m,k,a,c) * v_ooov(j,i,m,b) & ! + P(ik) P(ab)
                   !+ t2(m,k,b,a) * v_ooov(j,i,m,c)   ! + P(ik) P(ac)
                   + t2(m,i,b,c) * B_ooov(m,j,k,a) &
                   - t2(m,j,b,c) * B_ooov(m,i,k,a) & ! - P(ij)
                   - t2(m,k,b,c) * B_ooov(m,j,i,a) & ! - P(ik)
                   - t2(m,i,a,c) * B_ooov(m,j,k,b) & ! - P(ab)
                   - t2(m,i,b,a) * B_ooov(m,j,k,c) & ! - P(ac)
                   + t2(m,j,a,c) * B_ooov(m,i,k,b) & ! + P(ij) P(ab)
                   + t2(m,j,b,a) * B_ooov(m,i,k,c) & ! + P(ij) P(ac)
                   + t2(m,k,a,c) * B_ooov(m,j,i,b) & ! + P(ik) P(ab)
                   + t2(m,k,b,a) * B_ooov(m,j,i,c)   ! + P(ik) P(ac)
              enddo
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO

      !$OMP DO
      do a = 1, nV
        delta_abc = f_v(a) + f_v(b) + f_v(c)
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
               delta = f_o(i) + f_o(j) + f_o(k) - delta_abc 
               t3_bc(i,j,k,a) = t3_bc(i,j,k,a) * (1d0 / delta)
             enddo
           enddo
         enddo
       enddo
      !$OMP END DO

      ! E_T
      !$OMP DO
      do a = 1, nV
        delta_abc = f_v(a) + f_v(b) + f_v(c)
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
              e_t(a) = e_t(a) + t3_bc(i,j,k,a) * delta * t3_bc(i,j,k,a)
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO nowait

      ! E_ST
      !$OMP DO
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              s(i,a) = s(i,a) + v_vvoo(b,c,j,k) * t3_bc(i,j,k,a)
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO nowait

      ! E_DT
      !$OMP DO
      do a = 1, nV
        do k = 1, nO
          do j = 1, nO
            do i = 1, nO
              e_dt(a) = e_dt(a) + t2(i,j,a,b) * f_ov(k,c) * t3_bc(i,j,k,a)
            enddo
          enddo
        enddo
      enddo
      !$OMP END DO
    enddo
    !$OMP MASTER
    call wall_time(tb)
    write(*,'(A1,F6.2,A5,F10.2,A2)') ' ', dble(c)/dble(nV)*100d0, '% in ', tb-ta, ' s'
    !$OMP END MASTER
  enddo
  !$OMP END PARALLEL

  do a = 2, nV
    e_t(1) = e_t(1) + e_t(a)
  enddo
  
  do a = 2, nV
    e_dt(1) = e_dt(1) + e_dt(a)
  enddo

  e_t = e_t / 36d0
  
  do a = 1, nV
    do i = 1, nO
      e_st = e_st + s(i,a) * t1(i,a)
    enddo
  enddo
  e_st = e_st * 0.25d0

  e_dt = e_dt * 0.25d0

  ! (T)
  !print*,e_t(1),e_st,e_dt(1)
  energy = e_t(1) + e_st + e_dt(1)

  deallocate(t3_bc,s)
  
end
#+end_src
