program lookq
      implicit none
      character*80 s80
      integer*4 nmo,i
      real*8 r
      real*8,allocatable::qxx(:,:),qyy(:,:),qzz(:,:)
      open(10,file='QXX.MO.SCR.TXT')
      read(10,*)
      read(10,*)
      read(10,*)
      nmo=0
1     read(10,10)s80
10    format(a80)
      if(s80(1:17).ne.'                 ')then
       nmo=nmo+1
       goto 1
      endif
      write(6,*)nmo,' orbitals'
      close(10)
      allocate(qxx(nmo,nmo),qyy(nmo,nmo),qzz(nmo,nmo))
      open(38,file='QXX.MO.SCR.TXT')
      call rmtr38(qxx,nmo,nmo,1)
      close(38)
      open(38,file='QYY.MO.SCR.TXT')
      call rmtr38(qyy,nmo,nmo,1)
      close(38)
      open(38,file='QZZ.MO.SCR.TXT')
      call rmtr38(qzz,nmo,nmo,1)
      close(38)
      write(6,60)
60    format(' Orbital       XX          YY          ZZ          RR    
     1    <r>')
      do 2 i=1,nmo
      r=qxx(i,i)+qyy(i,i)+qzz(i,i)
2     write(6,61)i,qxx(i,i),qyy(i,i),qzz(i,i),r,dsqrt(r)
61    format(i5,5f12.2)
      end

      subroutine rmtr38(A,n0,n,ic)
c     ic=0 .. reads triangle of a supposedly symmetric matrix
c     ic=1 .. reads it all
c
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER*4 (I-N)
      dimension A(n0,n)
      read(38,*)
      read(38,*)
      N1=1
1     N3=MIN(N1+4,N)
      read(38,*)
      lnst=n1
      if(ic.eq.1)lnst=1
      DO 130 LN=lnst,N
      IEND=MIN(LN,N3)
      if(ic.eq.1)iend=N3
130   read(38,*)J,(A(LN,J),J=N1,iend)
      N1=N1+5
      IF(N3.LT.N)GOTO 1
      read(38,*)
      return
      end