      subroutine trad(ne,ntv,npv,nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp
     *,ierr )
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
c
c----------------------------------------------------------
c    subroutine de traduction des determinants ecrits en
c    trou/part  en determinants ecrits en occupation du CAS
c    plus trou/part des inactives et des virtuelles
c
c    ne,ntv,npv : degre d'excitation, trous et part du det vieux
c    nca,ica :    nb d'alpha du CAS, orb. actives occ. par 1 alpha
c    ncb,icb :    idem en beta
c    nt,it,ispt : nb de trous, numero des trous, spin des trous
c    np,ip,ispp : idem pour les part
c----------------------------------------------------------
c
      PARAMETER (maxsym=8)
      include 'maxorb.prm'
      parameter (maxorbcas=16)
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sy2/nts(maxsym),ncs(maxsym),nps(maxsym)
     *,norbs(maxsym)
      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
      character*4 gener
      dimension yc(maxorbcas+maxorbcas)
     *,ntv(maxorbcas+2),npv(maxorbcas+2)
      dimension ispor(maxorb+maxorb+1)
      common/debug/ywgen
      yw=.false.
      if(ywgen)yw=.true.
      ierr=0
      do i=1,norb
         ispor(i)=i
         ispor(i+norb)=-i
      enddo
      yion=mod(-ms2,2).ne.0
      if(yion)ispor(norb+norb+1)=-norb-1
      nt=0
      np=0
      ispt=0
      ispp=0
      do i=1,noac
         yc(i)=yrefc(i)
         yc(i+noac)=yrefc(i)
      enddo
      if(yw)write(6,*)' '
      if(yw)write(6,'(''yion'',l2)') yion
      if(yw)write(6,*)'ntv,npv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
      if(yw)write(6,*)'vieux  ',(ispor(ntv(k)),k=1,ne)
     *,(ispor(npv(k)),k=1,ne)
      do 1 i=1,ne
      iit=ntv(i)
c      write(6,*)'iit',iit
c      write(6,*)'iit',iit,iorb(iit)
c      write(6,*)'yac(iorb(iit))',yac(iorb(iit))
      if(yac(iorb(iit)))then
c        write(6,*)'icamun(iit)',icamun(iit)
         if(.not.yc(icamun(iit))) then
            write(6,*)'mauvais trou numero',i,ntv(i)
            write(6,'(''yion'',l2)') yion
            write(6,*)'ntv,npv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
            write(6,*)'vieux  ',(ispor(ntv(k)),k=1,ne)
     *      ,(ispor(npv(k)),k=1,ne)
            write(6,*)'yc',yc
            write(6,*)'iit',iit,iorb(iit)
            write(6,*)'yac(iorb(iit))',yac(iorb(iit))
            write(6,*)'icamun',icamun
            stop
         endif
         yc(icamun(iit))=.false.
      else
         nt=nt+1
         if(nt.gt.2) then
            ierr=1
            return
         endif
         if(iit.le.norb) then
            ispt=ispt+1
         else
            ispt=ispt-1
         endif
         it(nt)=iit
      endif
      iip=npv(i)
c     write(6,*)'yac(iorb(iip))',yac(iorb(iip))
c     write(6,*)'icamun(iip)',icamun(iip)
      if(iip.eq.norb+norb+1)goto 1
      if(yac(iorb(iip)))then
         if(yc(icamun(iip))) then
            write(6,*)'mauvaise part numero',i,npv(i)
            write(6,*)'ntv,npv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
            stop
         endif
         yc(icamun(iip))=.true.
      else
         if(iip.eq.norb+norb+1)goto 2
         np=np+1
         if(np.gt.2) then
            ierr=1
            return
         endif
         if(iip.le.norb) then
            ispp=ispp+1
         else
            ispp=ispp-1
         endif
         ip(np)=iip
2        continue
      endif
 1    continue
      nca=0
      ncb=0
c     if(nt.ne.0)ispt=ispt/nt
c     if(np.ne.0)ispp=ispp/np
      if(yw)write(6,'('' yc'',20l1)')(yc(k),k=1,noac*2)
      do i=1,noac
         if(yc(i))then
            nca=nca+1
            ica(nca)=numac(i)
         endif
         if(yc(i+noac))then
            ncb=ncb+1
            icb(ncb)=numac(i)
         endif
      enddo
      if(yw) then
         write(6,*)'nca,ncb',nca,ncb
         write(6,*)
     *   '   trous',(ispor(it(k)),k=1,nt),' ispt',ispt
     *   ,'  cas',(ica(k),k=1,nca),(-icb(k),k=1,ncb)
     *   ,'  part',(ispor(ip(k)),k=1,np),' ispp',ispp
c        write(6,*)'trous',(ispor(it(k)),k=1,nt),'   ispt',ispt
c        write(6,*)' part',(ispor(ip(k)),k=1,np),'   ispp',ispp
      endif
      return
      end
