      subroutine adrc(iw,nca,ica,ncb,icb,iadrcas)
c
c-----------------------------------------------------------------
c    subroutine d'adressage des determinants
c
c    nca,ica :  nombre d'alpha du CAS, orb.occ. par les alpha
c    ncb,icb :  idem en beta
c-----------------------------------------------------------------
c
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      PARAMETER (maxorb=500,maxsym=8,MNEL=5,maxorbcas=16,maxdetc=12870)
      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 ica(maxorbcas),icb(maxorbcas)
      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
      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 /z/ iz(maxorbcas,maxorbcas,maxorbcas)
      common /adrsym/irangs(maxdetc,0:maxorbcas)
     *,maxs(maxsym,0:maxorbcas)
      dimension icamc(maxorb)
      yw=iw.eq.1
      yw=.false.
      yw1=.false.
      if(yw) write(6,*)'.........................'
      if(yw) write(6,*)'...debut adrc............'
      isca=1
      do k=1,nca
         isca=its(isca,itsym(ica(k)))
         if(yw)write(6,*)'adrc.f ica(k),k',ica(k),k
         if(yw)write(6,*)'adrc.f itsym(ica(k))',itsym(ica(k))
      enddo
      do k=1,nca
         icamc(k)=icamun(ica(k))
      enddo
      if(yw)write(6,*)'a (icamc(k),k=1,nca)',(icamc(k),k=1,nca)
      call rang2(nca,icamc,iranga)
      iadra=irangs(iranga,nca)
      isc=isca
      do k=1,ncb
         icamc(k)=icamun(icb(k))
         isc=its(isc,itsym(icb(k)))
      enddo
      if(yw)write(6,*)'b (icamc(k),k=1,nca)',(icamc(k),k=1,ncb)
      call rang2(ncb,icamc,irangb)
      iadrb=irangs(irangb,ncb)
      if(yw)write(6,*)'isc,isca,nca',isc,isca,nca
      if(yw)write(6,*)'maxs',maxs(isca,nca)
      iadrab=iadra+(iadrb-1)*maxs(isca,nca)
      iadrcas=iadrab+icatc(isc,isca,nca,ncb)
      if(yw)
     *write(6,*)'iranga,irangb,iadra,iadrb,iadrab,icatc',iranga,irangb,
     *iadra,iadrb,iadrab,icatc(isc,isca,nca,ncb)
      if(yw1)
     *write(6,'(a35,2i5,3x,20i3)')'adrc : iadra,iadrb,det. du CAS'
     *,iadra,iadrb,(ica(k),k=1,nca),(-icb(j),j=1,ncb)
      if(yw) write(6,*)'.....fin adrc............'
      if(yw) write(6,*)'.........................'
      return
      end
       subroutine adrc_mr(nca,ica,ncb,icb,iadrcas)
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxorb=500,maxsym=8)
      parameter(maxorbcas=16,maxdetc=12870)
      parameter(maxref=1000,idicmr=35000)
      common/mr3/ maxcmr(-2:2,maxsym,-2:2),mixtpmr(idicmr)
     *,ndetc,ndetc0,iadrc_mr(idicmr)
      common/sym/itsym(2*maxorb),its(maxsym,maxsym),nsym
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/cas_spin/isz0
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      dimension ica(maxorbcas),icb(maxorbcas)
      yw=.false.
c
c------------------------------------------------------------
c     adresse mr totale de la configuration de CAS
c------------------------------------------------------------
c
      nelc=nca+ncb-nelac
      ispcas=nca-ncb-isz0
      ispc1=ksp(ispcas)
      isca=1
      do k=1,nca
         isca=its(isca,itsym(ica(k)))
      enddo
      iscb=1
      do k=1,ncb
         iscb=its(iscb,itsym(icb(k)))
      enddo
      isc=its(isca,iscb)
      call adrc(0,nca,ica,ncb,icb,iadrcas)
      iadrcas=iadrcas+maxcmr(nelc,isc,ispc1)
      if(yw) then
         write(75,*)'dans adrc_mr   ica',(ica(k),k=1,nca)
     *   ,'  icb',(icb(k),k=1,ncb),'$'
         call scril
         write(6,1000)'dans adrc_mr  nelc,isc,ispc1,iadrcas',
     *   nelc,isc,ispc1,iadrcas
 1000    format(a40,4i4)
         write(6,*)'dans adrc_mr  maxcmr',maxcmr(nelc,isc,ispc1)
      endif
      iadrcas=iadrc_mr(iadrcas)
      if(yw) write(6,*) 'iadrcas',iadrcas
      return
      end
