********************************************************************************
*                                                                              *
*  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 ### asympot ###
c
c     Determines asymptotic (boundary) values of Coulomb and exchange
c     potentials from the multipole expansion.
c
      subroutine asympot (pot,excp)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      include 'commons8.inc'
      dimension pot(*),excp(*)

      do iorb=1,norb
         if (itouch(iorb).eq.1) then	
	    ibeg=i2b(iorb)
	    call zmulti(iorb,pot(ibeg))
         endif	    
      enddo 	

      if (iform.eq.0.or.iform.eq.2) return
      if (islat.eq.1) return

      do iorb1=1,norb
         do iorb2=iorb1,norb
            if (itouch(iorb1).eq.0.and.itouch(iorb2).eq.0) goto 10
            if (iorb1.eq.iorb2.and.mgx(6,iorb1).eq.0 ) goto 10
            if ((iorb1.eq.iorb2).and.(ilc(iorb1*(iorb1+1)/2).lt.1)) 
     &           goto 10
c           orbitals in increasing order
            ipc=iorb1+iorb2*(iorb2-1)/2
            iax=i3b(ipc)
c
            idel=iabs(mgx(6,iorb1)-mgx(6,iorb2))
            if (iorb1.eq.iorb2) idel=2*mgx(6,iorb1)

            ido=0
 1234       ido=ido+1
            if (ido.eq.2) then
               idel=mgx(6,iorb2)+mgx(6,iorb1)
               ipc=ipc+norb*(norb+1)/2
               iax=iax+i3si(ipc)
            endif

c           initialize array amul which is needed to evaluate exchange potentials 
c           in the asymptotic region

            if (idbg(300).eq.0) then
               call zasyx1  (idel,ipc,excp(iax))
            else
               call zasyx (idel,ipc,excp(iax))
            endif
            if (ilc(ipc).eq.2.and.ido.eq.1) go to 1234
 10         continue
         enddo
      enddo
      return
      end