subroutine prnt
c
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      dimension ipop(4)
c
      data ipop /98,99,100,115/
c
      do id=1,nd,69
      hkt=hk/temp(id)
      ane=elec(id)
      call sabolf(id)
c     do k=1,4
      do k=3,3
         ii=ipop(k)-3
         iat=iatm(ii)
         ie=iel(ii)
         psum=0.
         psuu=0.
         do j=n0a(iat),nka(iat)
            psum=psum+popul(j,id)
            if(ilk(j).gt.0)
     *      psuu=psuu+usum(ilk(j))*elec(id)*popul(j,id)
         end do
         BB=DENS(ID)/WMM(ID)/YTOT(ID)*ABUND(IAT,ID)
         rin=0.
         rou=0.
c        write(63,601) id,ii,psum,bb,popul(ii,id)
         do jj=nfirst(ie),ii-1
            itr=itra(jj,ii)
            ru=rru(itr,id)*wop(ii,id)
            cu=colrat(itr,id)*wop(ii,id)
            if(ii.le.nlast(ie)) then
            rd=rrd(itr,id)*g(jj)/g(ii)*exp(hkt*fr0(itr))*wop(jj,id)
            else
            rd=rrd(itr,id)*sbf(jj)*ane*wop(jj,id)
            end if
            cd=coltar(itr,id)*wop(jj,id)
c           write(63,602) jj,itr,popul(jj,id),ru,cu,rd,cd
            rin=rin+(ru+cu)*popul(jj,id)
            rou=rou+(rd+cd)*popul(ii,id)
         end do
c
         do jj=ii+1,nnext(ie)
            itr=itra(ii,jj)
            ru=rru(itr,id)*wop(jj,id)
            cu=colrat(itr,id)*wop(jj,id)
            if(jj.le.nlast(ie)) then
            rd=rrd(itr,id)*g(ii)/g(jj)*exp(hkt*fr0(itr))*wop(ii,id)
            else
            rd=rrd(itr,id)*sbf(ii)*ane*wop(ii,id)
            end if
            cd=coltar(itr,id)*wop(ii,id)
c           write(63,602) jj,itr,popul(jj,id),rd,cd,ru,cu
            rou=rou+(ru+cu)*popul(ii,id)
            rin=rin+(rd+cd)*popul(jj,id)
         end do
c
c        write(63,603) id,ii,rou,rin,(rou-rin)/rin
      end do
c     write(63,*)
      end do
c     write(63,*) '=============================='
c     write(63,*)
c
c 601 format('id,ii',2i4,1p4e12.4)
c 602 format('   jj    ',i4,i5,1p5e12.4)
c 603 format('iitot',2i4,1p3e12.4/)
c
      return
      end