********************************************************************************
*                                                                              * 
*  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 ### chasympot ###
c
c     Checking contributions of multipole moments to Coulomb and exchange 
c     potentials at the practical infinity.
c
c     Determine asymptotic (boundary) values of Coulomb and exchange
c     potentials from the multipole expansion of a given order.
c
      subroutine chasympot (pot,excp)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      include 'commons8.inc'
      dimension pot(*),excp(*)

c     write(*,*) 'asympt: for two different nonsigma orbitals',
c     & 	  'the case (+-) is now also included'

      write(*,*) 'Checking multipole expansion for Coulomb potentials'
      do iorb=norb,1,-1
         call zmultitail(iorb,pot(ibeg))
      enddo 	

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

      write(*,*)
      write(*,*) 'Checking multipole expansion for exchange potentials'
      do iorb1=1,norb
         do iorb2=iorb1,norb
            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
            
            write(*,1000) iorn(iorb1),bond(iorb1),gut(iorb1),
     &           iorn(iorb2),bond(iorb2),gut(iorb2)
            write(*,*) '------ ilc(ipc) ',iorb1,iorb2,'...',idel,
     &           '...',ipc,ilc(ipc)
 1000       format(i4,1x,a8,a1,3x,i4,1x,a8,a1,3x)
            
            if (idbg(300).eq.0) then
               call zasyxtail1   (idel,ipc,excp(iax))
            else
               call zasyxtail  (idel,ipc,excp(iax))
            endif
            
            if (ilc(ipc).eq.2.and.ido.eq.1) go to 1234
 10         continue
         enddo
      enddo
      return
      end