      subroutine categ_mr
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      PARAMETER (maxorb=500,maxsym=8,maxorbcas=16,idicmr=35000)
      parameter(maxdetc=12870)
      common/mr3/ maxcmr(-2:2,maxsym,-2:2),mixtpmr(idicmr)
     *,ndetc,ndetc0,iadrc_mr(idicmr)
      character*4 gener
      common /prep/ nca0,ncb0,ic0(maxorbcas),icamun(maxorb+maxorb)
     *,numt(maxorb),nump(maxorb),nv
     *,gener,yoc(maxorb+maxorb),yrefc(maxorbcas),yac(maxorb)
     *,ygmono,ygddci,ygddc2,ygcas,ygtous
      common /ctg/icateg(-2:2,maxsym,-2:2,41)
     *,niit(0:2,maxsym,-1:1)
      common /ctg_mr/icateg_mr(idicmr,41)
      common/mxdetc/maxc(-2:2,maxsym,-2:2),
     *maxca(-2:2,maxsym,maxsym,-2:2)
      common/sym/itsym(2*maxorb),its(maxsym,maxsym),nsym
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/cas_spin/isz0
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      dimension ica(maxorbcas),icb(maxorbcas)
      dimension ntv(maxorbcas+2),npv(maxorbcas+2),it(2),ip(2)
      yw=.false.
      do kii=1,41
         do iadr=1,ndetc
            icateg_mr(iadr,kii)=0
         enddo
      enddo
      if(yw) then
         do k=1,2
            do l=1,nsym
               do m=-1,1
                  print*,'k,l,m,niit(k,l,m)',k,l,m,niit(k,l,m)
               enddo
            enddo
         enddo
      endif
      ndetc=0
      call rew61
 1    continue
      call venond1(ne,ntv,npv,ierr)
      if(ierr.eq.1) goto 100
c      read(61,end=100) ne
c      if(ne.ne.0) read(61)(ntv(k),k=1,ne),(npv(k),k=1,ne)
      if(yw)print*,'ntv,npv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
      call trad
     *(ne,ntv,npv,nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,ierr)
      call adrc(0,nca,ica,ncb,icb,iadrcas)
      isc=1
      do k=1,nca
         isc=its(isc,itsym(ica(k)))
      enddo
      do k=1,ncb
         isc=its(isc,itsym(icb(k)))
      enddo
      ispcas=nca-ncb-isz0
      ispc1=ksp(ispcas)
      nelc=nca+ncb-nca0-ncb0
      iadr=iadrcas+maxcmr(nelc,isc,ispc1)
      iadr=iadrc_mr(iadr)
      ndetc=max0(ndetc,iadr)
      ist=1
      do k=1,nt
         ist=its(ist,itsym(it(k)))
      enddo
      ispt1=0
      do k=1,nt
         if(it(k).le.norb)ispt1=ispt1+1
         if(it(k).gt.norb)ispt1=ispt1-1
      enddo
      if(iabs(ispt1).eq.2) ispt1=ispt1/2
      if(yw) then
         print*,'ica',(ica(k),k=1,nca)
         print*,'icb',(icb(k),k=1,ncb)
         print*,'iadrcas,maxcmr',iadrcas,
     *   maxcmr(nelc,isc,ispc1)
         print*,'nelc,isc,ispc1,nt,ist,ispt1',
     *   nelc,isc,ispc1,nt,ist,ispt1
         print*,'iadr,nt,ist,ispt1',iadr,nt,ist,ispt1
         print*,'niit(nt,ist,ispt1)',niit(nt,ist,ispt1)
      endif
c     print*,'iadr,nt,ist,ispt1',iadr,nt,ist,ispt1
c     print*,'niit(nt,ist,ispt1)',niit(nt,ist,ispt1)
      icateg_mr(iadr,niit(nt,ist,ispt1))=
     *icateg_mr(iadr,niit(nt,ist,ispt1))+1
      if(yw) then
         print*,'icateg_mr',icateg_mr(iadr,niit(nt,ist,ispt1))
         write(6,'('' categ_mr deter'',10i4,3x,20i3)')
     *   iadrcas,iadr,nelc,isc,ispc1,nt,ist,ispt1,
     *   niit(nt,ist,ispt1),
     *   icateg_mr(iadr,niit(nt,ist,ispt1)),
     *   (ica(k),k=1,nca),
     *   (-icb(k),k=1,ncb)
      endif
      goto 1
 100  continue
      itot=0
      do kii=1,41
c      do ispt1=-1,1
c         do ist=1,nsym
c            do nt=0,2
         do iadr=1,ndetc
            itot0=itot
            itot=itot+icateg_mr(iadr,kii)
            icateg_mr(iadr,kii)=itot0
            if(yw)write(6,'('' iadr,kii,icateg_mr'',4i5)')
     *      iadr,kii,icateg_mr(iadr,kii)
         enddo
c            enddo
c         enddo
c      enddo
      enddo
      return
      end
