!***********************************************************************
! This file is part of OpenMolcas.                                     *
!                                                                      *
! OpenMolcas is free software; you can redistribute it and/or modify   *
! it under the terms of the GNU Lesser General Public License, v. 2.1. *
! OpenMolcas is distributed in the hope that it will be useful, but it *
! is provided "as is" and without any express or implied warranties.   *
! For more details see the full text of the license in the file        *
! LICENSE or in <http://www.gnu.org/licenses/>.                        *
!                                                                      *
! Copyright (C) 2004, Giovanni Ghigo                                   *
!***********************************************************************
!  Cho_TraCtl
!
!> @brief
!>   Driver for the generation of the two-electrons integrals file (``MOLINT``) from the AO-based Cholesky Full Vectors
!> @author Giovanni Ghigo
!>
!> @details
!> All programs that need the generation of the two-electrons
!> integrals file in MO basis must tell to the Cholesky routine
!> who they are through \p iTraType:
!>
!> - ``1``: MBPT2
!> - ``2``: CASPT2
!> - ``3``: MCLR
!> - ``4``: CC
!>
!> The AO-based Cholesky Full Vectors (CHFV) are first transformed
!> in a new set of MO-based Transformed Cholesky Full Vectors
!> (TCVx) then the two-electrons integrals files (``MOLINT``) is
!> generated. The integrals in the file (``MOLINT``) are differently
!> ordered but addresses can be read from ``IAD2M`` as usual.
!>
!> The main loop runs over all the symmetries \c iSymL and for each
!> \f$ \text{CHFV}_{pq} \f$ (\f$ p,q \f$ are AO indices) the following MO-based
!> Transformed Cholesky Full Vectors (TCVx) can be generated:
!>
!> 1. TCVA: \f$ L_{ij}, L_{ji} \f$ if \c Sym(p) &ne; \c Sym(q)
!> 2. TCVB: \f$ L_{tj}, L_{ui} \f$ if \c Sym(p) &ne; \c Sym(q)
!> 3. TCVC: \f$ L_{aj}, L_{bi} \f$ if \c Sym(p) &ne; \c Sym(q)
!> 4. TCVD: \f$ L_{tu}, L_{ut} \f$ if \c Sym(p) &ne; \c Sym(q)
!> 5. TCVE: \f$ L_{au}, L_{bt} \f$ if \c Sym(p) &ne; \c Sym(q)
!> 6. TCVF: \f$ L_{ab} \f$  Only if \c DoFull = ``.True.`` (Not implemented yet!)
!>
!> MO Indices \f$ i,j \f$: Inactive; \f$ t,u \f$: Active; \f$ a,b \f$: Secondary
!>
!> Which TCVx have to be generated is defined in the logical array
!> \c TCVXist by the routine ::Mem_Est and the memory is managed through
!> the array \c TCVX of 2D allocatable matrices.
!>
!> Note that when \c Sym(p) &ne; \c Sym(q) the order of symmetry is
!> exchanged while the first index is always the MO we excite into
!> and the second index is always the MO we excite out.
!>
!> TCV type ``A`` and ``D``, \f$ L_{ji} \f$, and \f$ L_{ut} \f$, are not really generated
!> because they are just the transposed \f$ L_{ij} \f$ and \f$ L_{tu} \f$.
!> However, they are stored in memory.
!>
!> The main loop for the generation of the integrals (``MOLINT``) is
!> based on the total symmetry of the MO-based TCVx and for each
!> symmetry, a batch procedure is performed (\c nBatch). Within this
!> batch cycle, the TCVx are generated by ::Cho_TraS and ::Cho_TraA
!> depending if \c Sym(p) = \c Sym(q). In both these routines, a second
!> inner-batch procedure (\c nFBatch) is established reading the Full
!> Vectors and tranforming them in the TCVx.
!> Both the number of vectors
!> transformed in the two batch procedure are defined in ::Mem_Est
!> (\c nVec for \c nBatch and \c nFVec for \c nFBatch).
!>
!> The MO-based two-electron integrals generation is performed by
!> ::Cho_TwoEl. The integrals are \f$ (p,k|q,l) \f$ where \f$ p,q \f$: All MO; \f$ k,l \f$:
!> Occupied.
!> For MBPT2 integrals where \f$ p,q \f$ are occupied are not generated and
!> suitable routines called by ::ChoMP2_TraCtl are used.
!> For CC all \f$ p,q,k,l \f$ are all MO (not implemented yet).
!>
!> @note
!> The number of frozen and deleted MO used in the post-CASSFC/SCF
!> must be written in the RunFile in \c nFroPT and \c nDelPT arrays.
!>
!> @param[in] iTraType Caller program (see description)
!> @param[in] LUINTM   Unit number of two-electrons integrals file (``MOLINT``)
!> @param[in] CMO      MO coefficients
!> @param[in] NCMO     Total number of MO coefficients
!> @param[in] DoExch2  Flag for the generation of Exch-2 integrals
!***********************************************************************

subroutine Cho_TraCtl(iTraType,LUINTM,CMO,NCMO,DoExch2)
!***********************************************************************
! Author :  Giovanni Ghigo                                             *
!           Lund University, Sweden                                    *
!           October 2004                                               *
!----------------------------------------------------------------------*
! This is the routine for the transformation from AO basis to MO basis *
! of the Cholesky Full Vectors & Two-electrons integral generation.    *
! Reads the Cholesky Full Vectors (CHFV), generate new Transformed     *
! Cholesky Full Vectors (TCVx) then generate the Two-electrons inte-   *
! gral file (MOLINT).                                                  *
!  <p,q|k,l>  where p,q: All MO; k,l: Occupied                         *
! If DoFull=.True also <p,q|r,s> where p,q,r,s: All MO (for CC)        *
!***********************************************************************

use Cho_Tra, only: DoCoul, DoExc2, DoFull, DoTCVA, IAD2M, IfTest, nAsh, nBas, nDel, nFro, nIsh, nOrb, nOsh, nSsh, nSym, NumCho, &
                   TCVX, TCVXist
use Symmetry_Info, only: Mul
use stdalloc, only: mma_deallocate
use Constants, only: Zero, One
use Definitions, only: wp, iwp, u6

implicit none
integer(kind=iwp), intent(in) :: iTraType, LUINTM, NCMO
real(kind=wp), intent(in) :: CMO(NCMO)
logical(kind=iwp), intent(in) :: DoExch2
integer(kind=iwp) :: i, iAddrIAD2M, iBatch, IPRX, irc, iStrtVec_AB, iSym, iSymA, iSymAI, iSymB, iSymBJ, iSymI, iSymJ, iSymL, &
                     iType, j, jSym, k, LenIAD2M, lUCHFV, nBasT, nBatch, nData, nFVec, NumV, nVec
real(kind=wp) :: CPE, CPU0, CPU1, CPU2, CPU3, CPU4, CPU_Gen, CPU_Tot, CPU_Tra, tcpu_reo, TCR1, TCR2, TIO0, TIO1, TIO2, TIO3, TIO4, &
                 TIO_Gen, TIO_Tot, TIO_Tra, TIOE, TWR1, TWR2
logical(kind=iwp) :: Found
character(len=6) :: CHName
character(len=*), parameter :: CHNm = 'CHFV'

!-----------------------------------------------------------------------
IfTest = .false.
!IfTest = .true.
!DoExch2 = .true.
!-----------------------------------------------------------------------

call Timing(CPU0,CPE,TIO0,TIOE)

!**** INITIALIZATION ***************************************************

call CWTIME(TCR1,TWR1)
call Cho_X_init(irc,Zero)
if (irc /= 0) then
  write(u6,*) ' In Cho_TraCtl: Cho_X_Init returned non-zero rc = ',irc
  call Abend()
end if
call Cho_X_ReoVec(irc) ! get (if not there) CD vects in full stor
if (irc /= 0) then
  write(u6,*) ' In Cho_TraCtl: Cho_X_ReoVec returned non-zero rc = ',irc
  call Abend()
end if
call Cho_X_final(irc)
call CWTIME(TCR2,TWR2)
tcpu_reo = (TCR2-TCR1)
write(u6,*) ' Reordering of the Cholesky vectors to full storage. '
write(u6,*) ' Elapsed time for the reordering section: ',tcpu_reo
write(u6,*) ' CPU time for the reordering section: ',tcpu_reo
write(u6,*)

! Define what has to be calculated.
!  DoExc2 flag for the generation of Exch-2 integrals
!  DoTCVA flag for the generation of TCVA
!  DoFull flag for the generation of TCVF
!  DoCoul flag for the generation of coulomb integrals

DoExc2 = DoExch2

! MBPT2
if (iTraType == 1) then
  DoTCVA = .false.
  DoFull = .false.
  DoCoul = .false.
end if

! CASPT2
if (iTraType == 2) then
  DoTCVA = .true.
  DoFull = .false.
  DoCoul = .true.
end if

! MCLR
if (iTraType == 3) then
  DoTCVA = .true.
  DoFull = .false.
  DoCoul = .true.
end if

! CC
if (iTraType == 4) then
  DoTCVA = .true.
  DoFull = .true.
  DoCoul = .true.
end if

! If Tra is not recognized it is assumed is CASPT2 type.
if (iTraType >= 5) then
  DoTCVA = .true.
  DoFull = .false.
  DoCoul = .true.
end if

! Get Informations from RunFile.
!  The following informations must be passed to the Cholesky
!  transformation routine through RunFile. COMMON blocks could
!  not be used due to several conflicts.
call Get_iScalar('nSym',nSym)
call Get_iArray('nBas',nBas,nSym)
call Get_iArray('nFroPT',nFro,nSym)
call Get_iArray('nDelPT',nDel,nSym)
call Get_iArray('nIsh',nIsh,nSym)
! PAM 2007 call Get_iArray('nAsh',nAsh,nSym)
! Replaced by:
do i=1,nSym
  nAsh(i) = 0
end do
call qpg_iArray('nAsh',Found,nData)
if (Found .and. (nData == nSym)) then
  call Get_iArray('nAsh',nAsh,nSym)
end if
! End of replacement
call Get_NVnode(NumCho)
nBasT = 0
do i=1,nSym
  nBasT = nBasT+nBas(i)
  nOrb(i) = nBas(i)-nFro(i)-nDel(i)
  nOsh(i) = nIsh(i)+nAsh(i)
  nSsh(i) = nOrb(i)-nOsh(i)
end do

! Initialize information arrays.

TCVXist(:,:,:) = .false. ! TCVx existing flag.

! The Address Field for MOLINT:
LenIAD2M = 3*36*36
do i=1,36*36
  IAD2M(1,i) = 0
  IAD2M(2,i) = 0
  IAD2M(3,i) = 0
end do
iAddrIAD2M = 0
call iDaFile(LUINTM,1,IAD2M,LenIAD2M,iAddrIAD2M)

! The Timing:
CPU_Tra = Zero
TIO_Tra = Zero
CPU_Gen = Zero
TIO_Gen = Zero

!-----------------------------------------------------------------------
if (IfTest) then
  write(u6,*)
  write(u6,'(A,8I5)') '           Symmetries :',(i,i=1,nSym)
  write(u6,*)
  write(u6,'(A,8I5)') '               Frozen :',(nFro(i),i=1,nSym)
  write(u6,'(A,8I5)') '         Inactive (I) :',(nIsh(i),i=1,nSym)
  write(u6,'(A,8I5)') '           Active (A) :',(nAsh(i),i=1,nSym)
  write(u6,'(A,8I5)') '        Secondary (S) :',(nSsh(i),i=1,nSym)
  write(u6,'(A,8I5)') '              Deleted :',(nDel(i),i=1,nSym)
  write(u6,*)
  write(u6,'(A,8I5)') '      Total correlated:',(nOrb(i),i=1,nSym)
  write(u6,*)
  call XFlush(u6)
end if
!-----------------------------------------------------------------------

!**** START LOOP iSymL on TOTAL SYMMETRY of L (iSym * jSym) ************
do iSymL=1,nSym

  TCVXist(:,:,:) = .false. ! TCVx existing flag.
  call Mem_Est(iSymL,nVec,nFVec)
  !---------------------------------------------------------------------
  if (IfTest) then
    write(u6,*)
    write(u6,*) ' TCVx generated in Symmetry',iSymL
    do i=1,nSym
      do j=1,nSym
        do k=1,6
          if (TCVXist(k,i,j)) write(u6,*) ' Type=',k,' Symmetries:',i,j
        end do
      end do
    end do
    call XFlush(u6)
  end if
  !---------------------------------------------------------------------
  if ((nVec <= 0) .or. (nFVec <= 0)) then
    write(u6,*)
    write(u6,*) ' ************************************'
    write(u6,*) ' *  Insufficient memory for batch ! *'
    write(u6,*) ' ************************************'
    write(u6,*)
    call XFlush(u6)
    call Abend()
  end if
  nBatch = (NumCho(iSymL)-1)/nVec+1

  ! START LOOP iBatch
  do iBatch=1,nBatch

    if (iBatch == nBatch) then
      NumV = NumCho(iSymL)-nVec*(nBatch-1)
    else
      NumV = nVec
    end if
    !-------------------------------------------------------------------
    !if (IfTest) then
    !  nFBatch = (NumV-1) / nFVec + 1
    !  write(u6,*)
    !  write(u6,*)' iBatch=',iBatch,' of',nBatch,' - NumV=',NumV,' - nFBatch=',nFBatch
    !  call XFlush(u6)
    !end if
    !-------------------------------------------------------------------

    ! Start Transformation of Cholesy Vectors  CHFV -> TCVx
    call Timing(CPU1,CPE,TIO1,TIOE)

    ! Start Loop on CHFV-iSym-jSym
    do iSym=1,nSym
      lUCHFV = -1
      if (nBas(iSym) > 0) then
        do jSym=1,iSym
          lUCHFV = -1
          if ((nBas(jSym) > 0) .and. (Mul(iSym,jSym) == iSymL)) then
            lUCHFV = 7
            iStrtVec_AB = nVec*(iBatch-1)+1
            write(CHName,'(A4,I1,I1)') CHNm,iSym,jSym
            call dAName_MF_WA(lUCHFV,CHName)
            !-----------------------------------------------------------
            !if (IfTest) then
            !  write(u6,*) ' - Open ',CHName,' unit=',lUCHFV,' Vect=',iStrtVec_AB
            !  call XFlush(u6)
            !end if
            !-----------------------------------------------------------

            if (iSym == jSym) then
              call Cho_TraS(iSym,jSym,NumV,CMO,NCMO,lUCHFV,iStrtVec_AB,nFVec)
            else
              call Cho_TraA(iSym,jSym,NumV,CMO,NCMO,lUCHFV,iStrtVec_AB,nFVec)
            end if

            call dAClos(lUCHFV)
            !-----------------------------------------------------------
            !if (IfTest) then
            !  write(u6,*) ' - Closed ',CHName
            !  call XFlush(u6)
            !end if
            !-----------------------------------------------------------
          end if
        end do
      end if
    end do
    ! End Loop on CHFV-iSym-jSym

    call Timing(CPU2,CPE,TIO2,TIOE)
    CPU_Tra = CPU_Tra+CPU2-CPU1
    TIO_Tra = TIO_Tra+TIO2-TIO1
    ! End Transformation of Cholesky Vectors  CHFV -> TCVx

    ! Start Generation of Integrals files  TCVx -> MOLINT
    !-------------------------------------------------------------------
    if (IfTest) then
      write(u6,*) ' - Generation of Integrals:'
      call XFlush(u6)
    end if
    !-------------------------------------------------------------------

    ! Start Loop on I, J, A, B Symmetries
    do iSymI=1,nSym
      do iSymJ=1,iSymI
        do iSymA=1,nSym
          do iSymB=1,nSym
            iSymAI = Mul(iSymA,iSymI)
            iSymBJ = Mul(iSymB,iSymJ)

            if ((iSymAI == iSymL) .and. (iSymBJ == iSymL)) call Cho_TwoEl(iBatch,NumV,LUINTM,iAddrIAD2M,iSymI,iSymJ,iSymA,iSymB)

          end do
        end do
      end do
    end do
    ! End Loop on I, J, A, B Symmetries

    do iType=1,size(TCVX,1)
      do iSym=1,size(TCVX,2)
        do jSym=1,size(TCVX,3)

          call mma_deallocate(TCVX(iType,iSym,jSym)%A,safe='*')

        end do
      end do
    end do

    call Timing(CPU3,CPE,TIO3,TIOE)
    CPU_Gen = CPU_Gen+CPU3-CPU2
    TIO_Gen = TIO_Gen+TIO3-TIO2
    ! End Generation of Two-Electrons Integrals files

  end do
  ! END LOOP iBatchD -----------------------------------------------

end do
!**** END MAIN LOOP iSymL on TOTAL SYMMETRY of L (iSym * jSym) *********

iAddrIAD2M = 0
call iDaFile(LUINTM,1,IAD2M,LenIAD2M,iAddrIAD2M)

write(u6,*) 'TIMING INFORMATION:   CPU(s)   %CPU   Elapsed(s)'
write(u6,'(A,F9.2,1X,F6.1,1X,F12.2)') ' Transformation     ',CPU_Tra,1.0e2_wp*CPU_Tra/max(One,TIO_Tra),TIO_Tra
write(u6,'(A,F9.2,1X,F6.1,1X,F12.2)') ' Generation         ',CPU_Gen,1.0e2_wp*CPU_Gen/max(One,TIO_Gen),TIO_Gen
call Timing(CPU4,CPE,TIO4,TIOE)
CPU_Tot = CPU4-CPU0
TIO_Tot = TIO4-TIO0
write(u6,'(A,F9.2,1X,F6.1,1X,F12.2)') ' TOTAL              ',CPU_Tot,1.0e2_wp*CPU_Tot/max(One,TIO_Tot),TIO_Tot
write(u6,*)
call XFlush(u6)
!-----------------------------------------------------------------------
if (IfTest) then
  !IPRX=0    ! Do not print Coulomb nor Exchange Integrals
  IPRX = 1  ! Print only Coulomb Integrals
  !IPRX=2    ! Print all Integrals
  !IPRX=3    ! Print only Exchange Integrals
  call RdInt2(IPRX,DoTCVA)
end if
!-----------------------------------------------------------------------

call put_tra_comm(IAD2M,NSYM,NORB,NOSH,LUINTM)

return

end subroutine Cho_TraCtl
