!***********************************************************************
! 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) 1991,1993,1998, Roland Lindh                           *
!***********************************************************************

!#define _DEBUGPRINT_
subroutine Cmpct(abcd,na,nb,nijkl,mijkl,Zeta,Kappab,P,Ind_Pair,Con,xZeta,xKapp,xP,IndZ,iOff,Jnd,xZInv,AeqB,xab,xabCon,Alpha, &
                 xAlpha,Beta,xBeta)
!***********************************************************************
!                                                                      *
! Object: to find the largest value of the integrals which will be     *
!         generated by an exponent combination. This information will  *
!         be used to prescreen the data.                               *
!                                                                      *
!     Author: Roland Lindh, Dept. of Theoretical Chemistry,            *
!             University of Lund, SWEDEN                               *
!             June '91                                                 *
!             Modified for direct SCF, January '93                     *
!                                                                      *
!             Modified for k2 prescreening, June '98                   *
!***********************************************************************

use Gateway_Info, only: cdMax, CutInt, lSchw, RadMax
use Constants, only: Zero, One
use Definitions, only: wp, iwp
#ifdef _DEBUGPRINT_
use Definitions, only: u6
#endif

implicit none
integer(kind=iwp), intent(in) :: na, nb, nijkl, mijkl, Ind_Pair(mijkl), iOff
real(kind=wp), intent(in) :: abcd(mijkl,na,nb,na,nb), Zeta(mijkl), KappAB(mijkl), P(nijkl,3), Con(nijkl), Alpha(mijkl), Beta(mijkl)
real(kind=wp), intent(inout) :: xZeta(nijkl), xKapp(nijkl), xP(nijkl,3), xZInv(nijkl), xab(nijkl), xabCon(nijkl), xAlpha(nijkl), &
                                xBeta(nijkl)
integer(kind=iwp), intent(inout) :: IndZ(nijkl+1), Jnd
logical(kind=iwp), intent(in) :: AeqB
integer(kind=iwp) :: ia, ib, ijkl, ijkl_
real(kind=wp) :: abConMax, abMax, Check

#include "compiler_features.h"

#ifdef _DEBUGPRINT_
write(u6,*) ' In Cmpct'
write(u6,*) AeqB,iOff,Jnd
call RecPrt('Cmpct:Zeta',' ',Zeta,mijkl,1)
call RecPrt('Cmpct:KappAB',' ',KappAB,mijkl,1)
call RecPrt('Cmpct:abcd',' ',abcd,mijkl,(na*nb)**2)
#endif

! Move data

if (AeqB) then
  IndZ(iOff+1:iOff+mijkl) = Ind_Pair(:)
  xZeta(iOff+1:iOff+mijkl) = Zeta(:)
  xKapp(iOff+1:iOff+mijkl) = KappAB(:)
  xP(iOff+1:iOff+mijkl,:) = P(1:mijkl,:)
  xAlpha(iOff+1:iOff+mijkl) = Alpha(:)
  xBeta(iOff+1:iOff+mijkl) = Beta(:)
  do ijkl=1,mijkl
    ijkl_ = Ind_Pair(ijkl)
    xZInv(iOff+ijkl) = One/Zeta(ijkl)

    abMax = Zero
    do ia=1,na
      do ib=1,nb
#       ifdef _BUGGY_INTEL_OPTIM_
        if (Jnd < -1) call Abend()
#       endif
        abMax = max(abMax,abs(abcd(ijkl,ia,ib,ia,ib)))
      end do
    end do
    xab(ijkl+iOff) = sqrt(abMax)
    xabCon(ijkl+iOff) = sqrt(abMax)*Con(ijkl_)
  end do
  Jnd = Jnd+mijkl
else
  do ijkl=1,mijkl
    ijkl_ = Ind_Pair(ijkl)

    ! Select the largest element (over components)
    abMax = Zero
    do ia=1,na
      do ib=1,nb
#       ifdef _BUGGY_INTEL_OPTIM_
        if (Jnd < -1) call Abend()
#       endif
        abMax = max(abMax,abs(abcd(ijkl,ia,ib,ia,ib)))
      end do
    end do
    abMax = sqrt(abMax)
    abConMax = abMax*Con(ijkl_)
    if (lSchw) then
      Check = abConMax*cdMax
    else
      Check = KappAB(ijkl)*Con(ijkl)*RadMax
    end if
    if (Check >= CutInt) then
      Jnd = Jnd+1
      xZeta(Jnd) = Zeta(ijkl)
      xKapp(Jnd) = KappAB(ijkl)
      xP(Jnd,1) = P(ijkl,1)
      xP(Jnd,2) = P(ijkl,2)
      xP(Jnd,3) = P(ijkl,3)
      xZInv(Jnd) = One/Zeta(ijkl)
      IndZ(Jnd) = Ind_Pair(ijkl)
      xab(Jnd) = abMax
      xabCon(Jnd) = abConMax
      xAlpha(Jnd) = Alpha(ijkl)
      xBeta(Jnd) = Beta(ijkl)
    end if
  end do
end if
IndZ(nijkl+1) = Jnd

#ifdef _DEBUGPRINT_
write(u6,*) 'AeqB=',AeqB
write(u6,*) 'IndZ=',IndZ
call RecPrt('xZeta ',' ',xZeta,1,Jnd)
call RecPrt('xKapp ',' ',xKapp,1,Jnd)
call RecPrt('xP(x) ',' ',xP(1,1),1,Jnd)
call RecPrt('xP(y) ',' ',xP(1,2),1,Jnd)
call RecPrt('xP(z) ',' ',xP(1,3),1,Jnd)
call RecPrt('xZInv ',' ',xZInv,1,Jnd)
call RecPrt('xab   ',' ',xab,1,Jnd)
call RecPrt('xabCon',' ',xabCon,1,Jnd)
call RecPrt('xAlpha',' ',xAlpha,1,Jnd)
call RecPrt('xBeta ',' ',xBeta,1,Jnd)
#endif

end subroutine Cmpct
