quack/src/AOtoMO/AOtoMO_oooooo.f90

subroutine AOtoMO_oooooo(nBas,nO,cO,O,oooOooo)

! AO to MO transformation of three-electron integrals for the block oooooo
! Semi-direct O(N^7) algorithm

  implicit none

! Input variables

  integer,intent(in)            :: nBas,nO
  double precision,intent(in)   :: cO(nBas,nO),O(nBas,nBas,nBas,nBas,nBas,nBas)

! Local variables

  double precision,allocatable  :: scr1(:,:,:,:,:,:),scr2(:,:,:,:,:,:)
  integer                       :: mu,nu,la,si,ka,ta,i,j,k,l,m,n

! Output variables

  double precision,intent(out)  :: oooOooo(nO,nO,nO,nO,nO,nO)

! Memory allocation
  allocate(scr1(nBas,nBas,nBas,nBas,nBas,nBas),scr2(nBas,nBas,nBas,nBas,nBas,nBas))

  write(*,*)
  write(*,'(A42)')           '------------------------------------------'
  write(*,'(A42)')           ' AO to MO transformation for oooooo block '
  write(*,'(A42)')           '------------------------------------------'
  write(*,*)

  scr1 = 0d0
  do mu=1,nBas
    do nu=1,nBas
      do la=1,nBas
        do si=1,nBas
          do ka=1,nBas
            do ta=1,nBas
              do n=1,nO
                scr1(mu,nu,la,si,ka,n) = scr1(mu,nu,la,si,ka,n) + O(mu,nu,la,si,ka,ta)*cO(ta,n)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo
 
  scr2 = 0d0   
  do mu=1,nBas
    do nu=1,nBas
      do la=1,nBas
        do si=1,nBas
          do ka=1,nBas
            do i=1,nO
              do n=1,nO
                scr2(i,nu,la,si,ka,n) = scr2(i,nu,la,si,ka,n) + cO(mu,i)*scr1(mu,nu,la,si,ka,n)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo

  scr1 = 0d0
  do nu=1,nBas
    do la=1,nBas
      do si=1,nBas
        do ka=1,nBas
          do i=1,nO
            do m=1,nO
              do n=1,nO
                scr1(i,nu,la,si,m,n) = scr1(i,nu,la,si,m,n) + scr2(i,nu,la,si,m,n)*cO(ka,m)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo

  scr2 = 0d0   
  do nu=1,nBas
    do la=1,nBas
      do si=1,nBas
        do i=1,nO
          do j=1,nO
            do m=1,nO
              do n=1,nO
                scr2(i,j,la,si,m,n) = scr2(i,j,la,si,m,n) + cO(nu,j)*scr1(i,nu,la,si,m,n)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo

  scr1 = 0d0   
  do la=1,nBas
    do si=1,nBas
      do i=1,nO
        do j=1,nO
          do l=1,nO
            do m=1,nO
              do n=1,nO
                scr1(i,j,la,l,m,n) = scr1(i,j,la,l,m,n) + scr2(i,j,la,si,m,n)*cO(si,l)
              enddo
            enddo
          enddo
        enddo
      enddo
    enddo
  enddo

  oooOooo = 0d0
  do si=1,nBas
    do i=1,nO
      do j=1,nO
        do k=1,nO
          do l=1,nO
            do m=1,nO
              do n=1,nO
                oooOooo(i,j,k,l,m,n) = oooOooo(i,j,k,l,m,n) + cO(la,k)*scr1(i,j,la,k,m,n)
               enddo
             enddo
          enddo
        enddo
      enddo
    enddo
  enddo

  deallocate(scr1,scr2)

end subroutine AOtoMO_oooooo