********************************************************************************
*                                                                              * 
*  2DHF version 1-2003                                                         *
*  Copyright (C) 1996  Jacek Kobus, Leif Laaksonen, Dage Sundholm              *
*                                                                              *
*  This software may be used and distributed according to the terms            *
*  of the GNU General Public License, see README and COPYING.                  *
*                                                                              *
********************************************************************************
c ### slaterp ###
c
c     Calculates the exchange potentials as the local Slater approximation
c
      subroutine slaterp(psi,pot,excp,f2,f4,wk0)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      include 'commons8.inc'	

      dimension psi(*),pot(*),excp(*),f2(*),f4(*),wk0(*)

c     sl1=3/pi   sl2=1./3.
c     sl1=3/(8pi)   sl2=1./3.
      if (nel.eq.1) return

      do i=1,mxsize
         wk0(i)=0.d0
      enddo	

c     contributions from the local slater exchange

      do iorb1=1,norb
         iborb1=i1b(iorb1)	   	 
         ngorb1=i1si(iorb1)	 	 
         coo=occ(iorb1)
         do i=1,ngorb1
            wk0(i)=wk0(i)+coo*psi(iborb1+i-1)*psi(iborb1+i-1)
         enddo
      enddo


c     multiply the exch. pot. by f4 to make it commensurate with
c     the coulomb pot.

      third=1.d0/3.d0
      xa=-3.d0/2.d0*alphaf*(3.d0/pii/(2.d0*pii))**third
      do i=1,mxsize
         wk0(i)=xa*(wk0(i))**third*f4(i)
      enddo		

c     store the local exchange pot. in excp array

      call dcopy (mxsize,wk0,1,excp(1),1)

      return
      end