      subroutine adri2(iia,isa,iib,iic,iid,isb,isc,isd,jrang,idepi)
      parameter(maxsym=8)
      include 'maxorb.prm'
      IMPLICIT REAL*8(A-H,O-x,z),logical*1(y)
      common/sy2/nts(maxsym),ncs(maxsym),nps(maxsym)
     *,norbs(maxsym)
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      dimension idepi(maxsym,maxsym)
      dimension idet1(3)
      yw=.false.
      if(yw) then
         write(6,1000)'entree adri2 iia,iib,iic,iid',iia,iib,iic,iid
         write(6,1000)'entree adri2 isa,isb,isc,isd',isa,isb,isc,isd
      endif
c      write(6,*)'idepi',idepi
 1000 format(a30,10i3)
      nb=norbs(isb)
      nc=norbs(isc)
      nd=norbs(isd)
      if(isa.eq.isb)nb=nb-1
      if(isa.eq.isc)nc=nc-1
      if(isa.eq.isd)nd=nd-1
      if(isb.ne.isc) then
         if(isc.ne.isd) then
            if(isd.ne.isb) then
               jrang=iid+(iic-1)*nd+(iib-1)*nc*nd
            else
c              on a alors    iib.ne.iid
               jrang1=iid+(iib-1)*nd-1
               if(iid.gt.iib) jrang1=jrang1-1
               jrang=iic+jrang1*nc
            endif
         else
c           on a alors   isb.ne.isd  et  iid>iic
            jrang=iib+(iic+(iid-2)*(iid-1)/2-1)*(iia-1)
            if(yw)write(6,*)'iia,iib,iic,iid,nb',
     *      iia,iib,iic,iid,nb,jrang
         endif
      else
         if(isc.ne.isd) then
c           on a alors   isb.ne.isd  et  iib.ne.iic
            jrang1=iic+(iib-1)*nc-1
            if(iic.gt.iib) jrang1=jrang1-1
            jrang=iid+jrang1*(iia-1)
         else
c           toutes les symetries sont alors egales et iid > iic
            if(iib.gt.iic) then
               idet1(1)=iic
               idet1(2)=iid
               idet1(3)=iib
            else
               idet1(1)=iib
               idet1(2)=iic
               idet1(3)=iid
            endif
            if(yw)print*,'idet1',idet1
            jrang=idet1(1)+(idet1(2)-1)*(idet1(2)-2)/2+
     *      (idet1(3)-1)*(idet1(3)-2)*(idet1(3)-3)/6
c           call rang2(3,idet1,jrang)
            if(yw)print*,'idet1,jrang',idet1,jrang
            if(iib.gt.iic) then
               jrang=jrang*2-1
            else
               jrang=jrang*2
            endif
            if(yw)print*,'idet1,jrang',idet1,jrang
c            jrang1=iic+(iid-2)*(iid-1)/2
c            jrang=iib+(jrang1-1)*(iia-1)
c            if(yw)write(6,*)'iia,iib,iic,iid,nb,jrang1,jrang',
c     *      iia,iib,iic,iid,nb,jrang1,jrang
         endif
      endif
      jrang=jrang+idepi(isc,isd)
      if(yw) then
         write(75,*)'sortie adri2 isa,isb,isc,isd,idepi(isc,isd)',
     *   isa,isb,isc,isd,idepi(isc,isd),'$'
         call scril
         write(75,*)'sortie adri2 nb,nc,nd,iia,iib,iic,iid,jrang'
     *   ,nb,nc,nd,iia,iib,iic,iid,jrang,'$'
         call scril
      endif
      return
      end
