********************************************************************************
*                                                                              *
*  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 ### asympti ###
c
      subroutine asympti (pot,excp)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      include 'commons8.inc'
      dimension pot(*),excp(*)

c     determine values of Coulomb potential in the asymptotic region
c     from the multipole expansion
c
      do iorb=1,norb
         if (itouch(iorb).eq.1) then	
	    ibeg=i2b(iorb)
            if (idbg(301).eq.0) then
               call zmulti(iorb,pot(ibeg))
            else
               call zmultii(iorb,pot(ibeg))
            endif
         endif	    
      enddo 	

c     determine values of exchange potentials in the asymptotic region 
c     from multipole expansion

      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)

            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

            if (idbg(301).eq.0) then
               call zasyx1  (idel,ipc,excp(iax))
            else
               call zasyxi  (idel,ipc,excp(iax))
            endif

            if (ilc(ipc).eq.2.and.ido.eq.1) go to 1234
 10         continue
         enddo
      enddo
      return
      end