!***********************************************************************
! 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/>.                        *
!***********************************************************************

!----------------------------------------------------------------------*
! This subroutine reads from the formatted file DIFFPR coming from     *
! generated by MpProp the Slater Exponents, Factors and Nuclear Charges*
!----------------------------------------------------------------------*
subroutine Get_Slater(LMltSlQ,outxyz,nAt)

use qmstat_global, only: SlExpQ
use Index_Functions, only: nTri3_Elem, nTri_Elem
use stdalloc, only: mma_allocate
use Definitions, only: wp, iwp, u6

implicit none
integer(kind=iwp), intent(out) :: LMltSlQ
integer(kind=iwp), intent(in) :: nAt
real(kind=wp), intent(in) :: outxyz(3,nTri_Elem(nAt))
integer(kind=iwp) :: iC, ind, jhr, l, Lu, nS, nSlCentQ, nT, nTestjhr
real(kind=wp) :: CoordTest(3), SlFactQ(6)
logical(kind=iwp) :: Exists
integer(kind=iwp), external :: IsFreeUnit
#include "warnings.h"

#include "macros.fh"

! Open the file
Lu = IsFreeUnit(40)
call Opnfl('DIFFPR',Lu,Exists)
if (.not. Exists) then
  write(u6,*)
  write(u6,*) ' Can not locate output file DiffPr. '
  call Quit(_RC_IO_ERROR_READ_)
end if
rewind(Lu)

! Read Number of centers and angular momenta.

read(Lu,101) nSlCentQ
read(Lu,101) LMltSlQ

! A first test
nTestjhr = nTri_Elem(nAt)
if (nSlCentQ /= nTestjhr) then
  write(u6,*) 'ERROR! Number of centers in DiffPr file',nSlCentQ,' is different from number of centers obtained from RUNFILE', &
              nTestjhr,' Check your files.'
  call Quit(_RC_GENERAL_ERROR_)
end if

! Read Exponentials for the Centers
call mma_allocate(SlExpQ,[0,LMltSlq],[1,nSlCentQ],label='SlExpQ')
do iC=1,nSlCentQ
  read(Lu,103) CoordTest(:)
  ind = 0
  do jhr=1,nSlCentQ
    if (abs(CoordTest(1)-outxyz(1,jhr)) < 1.0e-4_wp) then
      if (abs(CoordTest(2)-outxyz(2,jhr)) < 1.0e-4_wp) then
        if (abs(CoordTest(3)-outxyz(3,jhr)) < 1.0e-4_wp) then
          ind = jhr
        end if
      end if
    end if
  end do
  if (ind == 0) write(u6,*) 'ERROR. Something is very wrong, coordinates of DiffPr and MpProp files do not match. DiffPr center',iC
  do l=0,LMltSlQ
    nS = nTri3_Elem(l)
    nT = nTri3_Elem(l+1)
    read(Lu,104) SlExpQ(l,ind)
    read(Lu,105) SlFactQ(nS+1:nT)
    !read(Lu,105) SlFactQ(nS+1:nT,ind)
    unused_var(SlFactQ)
  end do
  !Jose. No read nuclear charge
  !read(Lu,104) PointP(ind)
  read(Lu,*)
end do

close(Lu)

return

101 format(I5)
103 format(3(F20.14))
104 format(F20.14)
105 format(3(F20.14))

end subroutine Get_Slater
