      subroutine adrp(np,ip,ispp,iadrp)
c
c----------------------------------------------------------
c    subroutine d'adressage des determinants
c
c    nca,ica :    nombre d'alpha du CAS, orb. 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
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      PARAMETER (maxsym=8,MNEL=5,maxorbcas=16)
      include 'maxorb.prm'
      PARAMETER (MAXELCAS=20)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/cas_spin/isz0
      common/sym/itsym(2*maxorb),its(maxsym,maxsym),nsym
      common/mxdetc/maxc(-2:2,maxsym,-2:2),
     *maxca(-2:2,maxsym,maxsym,-2:2)
      dimension ip(2)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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
c     dimension yc(maxorbcas+maxorbcas),ntv(8),npv(8)
c     dimension ispor(maxorb+maxorb)
      common /prep2/ icatt(2,maxsym,maxsym,-1:1),
     *icatp(2,maxsym,maxsym,-1:1)
     *,itorb(maxorb*2),icatc(maxsym,maxsym,0:maxorbcas,0:maxorbcas)
      common/test/itest(100)
      yw=.false.
      if(yw)write(6,*)'entree adrp,np,ip',np,'   ',ip,'  ispp',ispp
      if(np.eq.0)then
         iadrp=1
         return
      endif
      ip1=iorb(ip(1))
      if(ip(1).gt.norb) ip1=ip(1)-norb
      if(np.eq.1) then
         isp=itsym(ip1)
         if(yw) write(6,*)'icatp,itorb',icatp(1,isp,isp,ispp),itorb(ip1)
         if(yw) write(6,*)'ispp',ispp
         iadrp=icatp(1,isp,isp,ispp)+itorb(ip1)
         if(yw) write(6,*)'iadrp',iadrp
      else
         ispp1=ispp/2
         ip2=iorb(ip(2))
c        if(ip(2).gt.norb) ip2=ip(2)-norb
         is1=itsym(ip1)
         is2=itsym(ip2)
         itorb2=itorb(ip2)
         itorb1=itorb(ip1)
         isp=its(is1,is2)
ctest
         if(ispp.ne.0.and.ip1.gt.ip2)call erreur(24)
ctestf
         if(is1.ne.is2.or.ispp.eq.0) then
            if(yw) write(6,*)'ip1,is1',ip1,is1
            if(yw) write(6,*)'ip(1),is1,norb',ip(1),is1,norb
            if(yw) write(6,*)'ip2,is2',ip2,is2
            if(yw) write(6,*)'ip(2),is2,norb',ip(2),is2,norb
            if(yw)
     *      write(6,*)'icatp,itorb',icatp(2,isp,is1,ispp1),itorb1,itorb2
            iadrp=icatp(2,isp,is1,ispp/2)+itorb2+(itorb(ip1)-1)*nps(is2)
            if(yw) write(6,*)'iadrp',iadrp
         else
            if(yw) write(6,*)'ip1,is1',ip1,is1
            if(yw) write(6,*)'ip(1),is1,norb',ip(1),is1,norb
            if(yw) write(6,*)'ip2,is2',ip2,is2
            if(yw) write(6,*)'ip(2),is2,norb',ip(2),is2,norb
            iadrp=icatp(2,isp,is1,ispp/2)+(itorb2-1)*
     *      (itorb2-2)/2+itorb(ip1)
            if(yw)
     *      write(6,*)'icatp,itorb',icatp(2,isp,is1,ispp1),itorb1,itorb2
            if(yw) write(6,*)'iadrp',iadrp
            if(iadrp.eq.0)stop
         endif
      endif
      return
      end
       subroutine erreur(i)
      dimension n(1)
      write(6,*)'erreur',i
      do i=1,2
         n(i)=0
      enddo
      stop
      return
      end
