      subroutine boys_print(n,natoms,nconts,ncontp,ncontd,nshels,nshelp,
     &                      nsheld,icfunc,nfuncatom,natomtype,overlap,
     &                      coeffmo,pmat,smat,pstmat)

c  this subroutine written by alain st-amant of the
c  department of chemistry, university of ottawa, ottawa, canada.
c  all rights reserved.  this is part of the DeFT project.

      implicit real*8(a-h,o-z)

      dimension nshels(*),nshelp(*),nsheld(*),nfuncatom(*),icfunc(*),
     &          natomtype(*)

      dimension overlap(*),coeffmo(*)

      dimension pmat(n,*),smat(n,*),pstmat(n,*)

      data zero,two,cutoff/0.0d0,2.0d0,0.05d0/

      do 1001 j=1,n
      do 1001 i=1,n
 1001 pmat(i,j)=coeffmo(i)*coeffmo(j)

      ij=0

      do 1002 i=1,n
      do 1002 j=1,i
      ij=ij+1
      smat(i,j)=overlap(ij)
 1002 smat(j,i)=overlap(ij)

      do 1003 j=1,n
      do 1004 i=1,n
 1004 pstmat(i,j)=zero
      do 1003 k=1,n
      do 1003 i=1,n
 1003 pstmat(i,j)=pstmat(i,j)+pmat(i,k)*smat(k,j)

      ii=0

      do 1005 i=1,nconts
      nfuncatom(ii+1)=icfunc(nshels(i))
 1005 ii=ii+1

      do 1006 i=1,ncontp
      do 1007 k=1,3
 1007 nfuncatom(ii+k)=icfunc(nshelp(i))
 1006 ii=ii+3

      do 1008 i=1,ncontd
      do 1009 k=1,6
 1009 nfuncatom(ii+k)=icfunc(nsheld(i))
 1008 ii=ii+6

      write(6,1010)
 1010 format(/,'         mulliken population analysis :',/)

      do 1011 i=1,natoms

      pop=zero

      do 1012 j=1,n
 1012 if(nfuncatom(j).eq.i) pop=pop+pstmat(j,j)

      if(abs(pop).gt.cutoff) write(6,1013) i,pop
 1013 format(15x,' atom # ',i4,'       population = ',f8.4)

 1011 continue

      write(6,1014)
 1014 format(/,'         mayer bond order analysis :',/)

      do 1015 i=1,natoms
      do 1015 j=i,natoms

      if(i.eq.j) goto 1015

      bond=zero

      do 1016 k=1,n
      do 1016 l=1,n
 1016 if((nfuncatom(k).eq.i).and.
     &   (nfuncatom(l).eq.j)) bond=bond+pstmat(k,l)*pstmat(l,k)

      if(abs(two*bond).gt.cutoff) write(6,1017) i,j,two*bond
 1017 format(15x,' atoms # ',i4,' and ',i4,'       bond order = ',f8.4)

 1015 continue

      write(6,1018)
 1018 format()

      ii=0

      do 1019 j=1,nconts
      if(abs(coeffmo(ii+1)).gt.cutoff)
     &       write(6,1020) ii+1,nfuncatom(ii+1),coeffmo(ii+1)
 1020 format('         a.o. #',i5,',     center',i4,',    s  ',f15.8)
 1019 ii=ii+1

      do 1021 j=1,ncontp
      if(abs(coeffmo(ii+1)).gt.cutoff)
     &       write(6,1022) ii+1,nfuncatom(ii+1),coeffmo(ii+1)
 1022 format('         a.o. #',i5,',     center',i4,',    px ',f15.8)
      if(abs(coeffmo(ii+2)).gt.cutoff)
     &       write(6,1023) ii+2,nfuncatom(ii+2),coeffmo(ii+2)
 1023 format('         a.o. #',i5,',     center',i4,',    py ',f15.8)
      if(abs(coeffmo(ii+3)).gt.cutoff)
     &       write(6,1024) ii+3,nfuncatom(ii+3),coeffmo(ii+3)
 1024 format('         a.o. #',i5,',     center',i4,',    pz ',f15.8)
 1021 ii=ii+3

      do 1025 j=1,ncontd
      if(abs(coeffmo(ii+1)).gt.cutoff)
     &       write(6,1026) ii+1,nfuncatom(ii+1),coeffmo(ii+1)
 1026 format('         a.o. #',i5,',     center',i4,',    dxx',f15.8)
      if(abs(coeffmo(ii+2)).gt.cutoff)
     &       write(6,1027) ii+2,nfuncatom(ii+2),coeffmo(ii+2)
 1027 format('         a.o. #',i5,',     center',i4,',    dxy',f15.8)
      if(abs(coeffmo(ii+3)).gt.cutoff)
     &       write(6,1028) ii+3,nfuncatom(ii+3),coeffmo(ii+3)
 1028 format('         a.o. #',i5,',     center',i4,',    dxz',f15.8)
      if(abs(coeffmo(ii+4)).gt.cutoff)
     &       write(6,1029) ii+4,nfuncatom(ii+4),coeffmo(ii+4)
 1029 format('         a.o. #',i5,',     center',i4,',    dyy',f15.8)
      if(abs(coeffmo(ii+5)).gt.cutoff)
     &       write(6,1030) ii+5,nfuncatom(ii+5),coeffmo(ii+5)
 1030 format('         a.o. #',i5,',     center',i4,',    dyz',f15.8)
      if(abs(coeffmo(ii+6)).gt.cutoff)
     &       write(6,1031) ii+6,nfuncatom(ii+6),coeffmo(ii+6)
 1031 format('         a.o. #',i5,',     center',i4,',    dzz',f15.8)
 1025 ii=ii+6

      write(6,1032)
 1032 format(//)

      return
      end
