      subroutine adrdet(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr)
c
c----------------------------------------------------------
c    subroutine d'adressage des determinants
c
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
c----------------------------------------------------------
c          non MR                |               MR
c                                |
c . ica,icb -> call adrc(ica,icb,| . ica,icb -> call adrc_mr(ica,icb,..
c                       iadrc...)|                          iadrcas)
c      avec                      |   avec
c                                |
c  iadrc=iadrab+icatc(isc,isca,  |  iadrcas=iadrc+maxcmr(nelc,isc,ispc1)
c                     nca,ncb)   |  iadrcas=iadrc_mr(iadrcas)
c                                |
c   iadrcat= iadrc+              |
c   maxc(nelc,iscas,ispc1) *     | . iadrcat=
c . ((iadrp-1)+(iadrt-1)*max_p)  |   ((iadrp-1)+(iadrt-1)*max_p)+1
c                                |
c . iadr=iadrcat+icateg(         | . iadr=iadrcat+icateg_mr(iadrcas,
c   (nelc,iscas,ispc1,           |       niit(nt,ist,ispt1))
c   niit(nt,ist,ispt1))          |
c                                |
c----------------------------------------------------------
c
c
c----------------------------------------------------------
c    cas MRS
c
c     Presque tout l'habillage se fait independemment des spins
c     Ils ne sont pris en compte que a la fin
c
c     1) partie CAS : generation de iocc=occupation des orbitales
c        du CAS
c        ex iocc= 2,0,2,1,1,0,2
c     iocc--------(subr adrcass)--------> iadrs     (adresse)
c     iadrs-------(tableau tpmrs)-------> tpmrs(iadrs)  codage en Char*1
c     tpmrs(iadrs)----(ichar)-----------> mixtpmrs  integer*4
c     mixtpmrs---------(subr sptxm)-----> mint,maxt,minp,maxp
c     iadrs-------(tableau nim)---------> iadr
c
c     signification de nim(iadrs) :
c     On considere la relation d'equivalence entre det :
c     avoir meme partie CAS (meme iocc)
c     nim(iadrs) est le nombre total de determinants (totaux : T, C, P
c     avec toutes combinaisons de spin) dans toutes
c     les classes d'equivalences precedentes
c
c     adresse des Trous et Part
c     nt,it-------(adrts)-------------->iadrt    adresse des trous
c     np,ip-------(adrps)-------------->iadrp    adresse des part
c     mt=nombre de trous possibles compte tenu des symetries
c     adresse des T/P : iadrt+(iadrp-1)*mt
c
c     clssm : on definit une 2eme relation d'equivalence :
c     avoir meme mixtpmrs (meme mint,maxt...)
c     et memes nt,isp,isolp,nt,ist,isolc
c     ou isol. est le nombre d'electrons celibataires :
c     clssm(mixtpmrs,niips(np,isolp,isp),niits(isolt,ist),isolc)
c     =nombre de det (sans spins) dans les classes precedentes
c
c     irang : adresse de la partie de spin d'un determinant donne
c     MH : nombre de det de spins possibles
c
c     adresse totale :
c     iadr=nim(iadrs)
c     + irang + (iadrt+(iadrp-1)*mt-1)*MH
c     +clssm(mixtpmrs,niips(np,isolp,isp),niits(isolt,ist),isolc)
c----------------------------------------------------------
c
c
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      PARAMETER (maxorb=500,maxsym=8,MNEL=5,maxorbcas=16)
      PARAMETER (MAXELCAS=20,idicmr=35000)
      parameter(ndimcs0=100000)
      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)
      common/maxdettrou/maxt(2,maxsym,maxsym,0:1)
      common/maxdetpart/maxp(2,maxsym,maxsym,0:1)
      dimension ica(maxorbcas),icb(maxorbcas),it(2),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
      common /ctg_mr/icateg_mr(idicmr,41)
      common /ctg/icateg(-2:2,maxsym,-2:2,41)
     *,niit(0:2,maxsym,-1:1)
      common /co_max/ maxtt(2,maxsym,0:1),maxpp(0:2,maxsym,0:1)
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      common/test/itest(50)
      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/adrmrs/clss(15,18,17,0:maxorbcas)
     *,clssm(15,18,17,0:maxorbcas)
      common/sy3/itorbi(maxorb),isbrot(maxorb),itorbc(maxorb)
     *,itorbs(maxorb)
      common /combs/  C(0:maxorbcas+4,-1:maxorbcas+4)
      integer c,clss,clssm,ces
      common /adrcs/ ces(0:maxorbcas,0:maxorbcas),idimcs
     *,nim(ndimcs0),tpmrs
      character*1 tpmrs(ndimcs0)
      dimension iocc(maxorbcas),ic1(maxorbcas)
      common/niis/niips(0:2,0:2,maxsym),niits(0:2,maxsym)
      dimension ial1(maxorbcas+4)
      icc(i)=(i-1)*i/2
      yw=.false.
      yw1=.false.
      if(nt.eq.1) then
         it1=iorb(it(1))
      else if(nt.eq.2) then
         it1=iorb(it(1))
         it2=iorb(it(2))
      endif
      if(np.eq.1) then
         ip1=iorb(ip(1))
      else if(np.eq.2) then
         ip1=iorb(ip(1))
         ip2=iorb(ip(2))
      endif
c      print*,'it,ip',it,ip
      if(yw) then
         nta=(nt+ispt)/2
         npa=(np+ispp)/2
         if(gener(1:2).eq.'MR') then
         if(nt.eq.0) then
            nta=0
         else if(nt.eq.1) then
c            nta=1-it(1)/(norb+1)
             nta=(ispt+1)/2
         else
c            nta=2-it(1)/(norb+1)-it(2)/(norb+1)
            nta=(ispt+2)/2
         endif
         if(np.eq.0) then
            npa=0
         else if(np.eq.1) then
c            npa=1-ip(1)/(norb+1)
            npa=(ispp+1)/2
         else
c            npa=2-ip(1)/(norb+1)-ip(2)/(norb+1)
            npa=(ispp+2)/2
         endif
         endif
         if(yw)write(6,*)'------------------------'
         if(yw)write(75,*)' debut adrdet '
     *   ,' trou',(iorb(it(k)),k=1,nta),(-iorb(it(k)),k=nta+1,nt),
     *   ' CAS',(ica(k),k=1,nca),(-icb(k),k=1,ncb),
     *   ' part',(iorb(ip(k)),k=1,npa),(-iorb(ip(k)),k=npa+1,np),'$'
         if(yw) call scril
      endif
c
c     cas MRS
c
      if(gener(1:2).eq.'MR') then
 
c
c     place des alpha dans les couches ouvertes
c     trous
         ii=0
         nalfa=0
         if(nt.eq.0) then
            nta=0
         else if(nt.eq.1) then
c            nta=1-it(1)/(norb+1)
            nta=(ispt+1)/2
         else
c            nta=2-it(1)/(norb+1)-it(2)/(norb+1)
            nta=(ispt+2)/2
         endif
c         print*,'nta',nta
         if(nt.eq.1) then
            ii=1
            if(nta.eq.0) then
               ial1(1)=1
               nalfa=1
            endif
         else if(nt.eq.2) then
            if(nta.eq.0) then
               ii=2
               ial1(1)=1
               ial1(2)=2
               nalfa=2
            else if (nta.eq.1) then
               if(it1.lt.it2) then
                  nalfa=1
                  ii=2
                  ial1(1)=2
               else if(it1.gt.it2) then
                  nalfa=1
                  ii=2
                  ial1(1)=1
               endif
            else if (nta.eq.2) then
               ii=2
            endif
         endif
         if(yw)print*,'fin trous ii,nalfa',ii,nalfa
c     CAS
         do k=1,noac
            iocc(k)=0
         enddo
         do k=1,nca
            iocc(itorbc(ica(k)))=1
         enddo
         do k=1,ncb
            if(iocc(itorbc(icb(k))).eq.1) then
               iocc(itorbc(icb(k)))=2
            else
               iocc(itorbc(icb(k)))=-1
            endif
         enddo
c         print*,'ii avant CAS',ii
         do k=1,noac
            if(iocc(k).eq.1) then
               ii=ii+1
               nalfa=nalfa+1
               ial1(nalfa)=ii
            else if (iocc(k).eq.-1) then
               ii=ii+1
            endif
         enddo
         do k=1,noac
            if(iocc(k).eq.-1) iocc(k)=1
         enddo
         if(yw)print*,'fin CAS ii,nalfa',ii,nalfa
c     particules
         if(np.eq.0) then
            npa=0
         else if(np.eq.1) then
c            npa=1-ip(1)/(norb+1)
            npa=(ispp+1)/2
         else
c            npa=2-ip(1)/(norb+1)-ip(2)/(norb+1)
            npa=(ispp+2)/2
         endif
c         print*,'npa',npa,ip(1)
         if(np.eq.1) then
            ii=ii+1
            if(npa.eq.1) then
               nalfa=nalfa+1
               ial1(nalfa)=ii
            endif
         else if(np.eq.2) then
            if(npa.eq.2) then
               ii=ii+2
               ial1(nalfa+1)=ii-1
               ial1(nalfa+2)=ii
               nalfa=nalfa+2
            else if (npa.eq.1) then
               if(ip1.lt.ip2) then
                  ii=ii+2
                  nalfa=nalfa+1
                  ial1(nalfa)=ii-1
               else if(ip1.gt.ip2) then
                  ii=ii+2
                  nalfa=nalfa+1
                  ial1(nalfa)=ii
               endif
            else if (npa.eq.0) then
               ii=ii+2
            endif
         endif
         if(yw)print*,'fin part ii,nalfa',ii,nalfa
c
c     adresse du CAS
c         print*,'ica',ica
c         print*,'icb',icb
         if(yw)write(75,*)'iocc',(iocc(k),k=1,noac),'$'
         if(yw)call scril
         call adrcass(iocc,iadrs,ncf,isolc,ic1)
         mixtpmrs=ichar(tpmrs(iadrs))
         if(yw)print*,'iadrs',iadrs
c
c     adresse des trous et des part
         call adrts(nt,it,iadrt)
         call adrps(np,ip,iadrp)
         if(yw)print*,'iadrt,iadrp',iadrt,iadrp
         isolt=0
         ist=1
         mt=1
         if(nt.eq.1)then
            isolt=1
            ist=itsym(it1)
            mt=nts(ist)
         else if(nt.eq.2)then
            is1=itsym(it1)
            is2=itsym(it2)
            ist=its(is1,is2)
            if(it1.eq.it2) then
               isolt=0
               mt=ninac
            else
               isolt=2
               mt=0
               if(ist.eq.1) then
                  do is=1,nsym
                     mt=mt+icc(nts(is))
                  enddo
c                  mt=icc(nts(is1))
               else
                  do is=1,nsym
                     js=its(is,ist)
                     if(is.gt.js)mt=mt+nts(is)*nts(js)
c                     print*,'is,its(is,ist),mt',is,its(is,ist),mt
                  enddo
c                  mt=nts(is1)*nts(is2)
               endif
            endif
         endif
         isolp=0
         isp=1
         if(np.eq.1)then
            isolp=1
            isp=itsym(ip1)
         else if(np.eq.2)then
            isp=its(itsym(ip1),itsym(ip2))
            if(ip1.eq.ip2) then
               isolp=0
            else
               isolp=2
            endif
         endif
         isol=isolt+isolp+isolc
         if(yw)print*,'isolt,isolp,isolc,isol',
     *   isolt,isolp,isolc,isol
         if(yw)print*,'ial1',
     *   (ial1(k),k=1,isol)
         if(yw)print*,'mixtpmrs',mixtpmrs
         call rang3s(isol,(isol+ms2)/2,ial1,irang)
         iadr=nim(iadrs)+clssm
     *   (mixtpmrs,niips(np,isolp,isp)
     *   ,niits(isolt,ist),isolc)
     *   +irang+(iadrt+(iadrp-1)*mt-1)*c(isol,(isol+ms2)/2)
         if(yw) then
            print*,'nim(iadrs)',nim(iadrs)
            print*,'clssm',clssm
     *      (mixtpmrs,niips(np,isolp,isp)
     *      ,niits(isolt,ist),isolc)
            print*,'irang',irang
            print*,'mt',mt
            print*,'c (mh)',c(isol,(isol+ms2)/2)
            print*,'IADR',iadr
            print*,'iadrt,iadrp,iadrt+(iadrp-1)*mt-1',
     *      iadrt,iadrp,iadrt+(iadrp-1)*mt-1
         endif
         return
      endif
 
 
      nelc=nca+ncb-nelac
      iscas=1
c      write(6,*)'itsym',itsym
c      do k=1,maxsym
c         write(6,*)'its',(its(k,l),l=1,maxsym)
c      enddo
      do k=1,nca
         iscas=its(iscas,itsym(ica(k)))
      enddo
      isa=iscas
      do k=1,ncb
c        print*,'iscas,icb(k)',iscas,icb(k)
         iscas=its(iscas,itsym(icb(k)))
      enddo
c     ispcas=nca-ncb
      ispcas=nca-ncb-isz0
      ispc1=ksp(ispcas)
c      if(ispcas.eq.0) then
c         ispc1=0
c      else
c         ispc1=ispcas/iabs(ispcas)
c      endif
      if(yw) then
         write(6,*)'nelc=nca+ncb-nelac,nca,ncb,nelac',nelc,nca,ncb,nelac
         write(6,*)'iscas',iscas,' ispcas',ispcas,'isz0',isz0
      endif
      call adrt(nt,it,ispt,iadrt)
      call adrp(np,ip,ispp,iadrp)
      call adrc(0,nca,ica,ncb,icb,iadrc)
      isp=1
      ist=1
      ispt1=ispt
      if(nt.eq.1)then
         ist=itsym(it1)
      else
         if(nt.eq.2)then
            ist=its(itsym(it1),itsym(it2))
            ispt1=ispt/nt
         endif
      endif
      if(yw) then
         write(6,*)'np,isp,ispp,iadrp',np,isp,ispp,iadrp
         write(6,*)'nt,ispt,iadrt',nt,ispt,iadrt
         write(6,*)'nelc,iscas,ispc1',nelc,iscas,ispc1
         write(6,*)'iadrc,maxc',iadrc,maxc(nelc,iscas,ispc1)
      endif
      if(np.eq.0) then
         max_p=1
      else
         if(np.eq.1)then
            isp=itsym(ip1)
         else
            isp=its(itsym(ip1),itsym(ip2))
         endif
         jspin=iabs(ispp)
         if(jspin.eq.2)jspin=1
         if(yw)write(6,*)'np,isp,jspin,ispp',np,isp,jspin,ispp
         max_p=maxpp(np,isp,jspin)
      endif
      if(yw)write(6,*)'max_p',max_p
      if(yw)write(6,*)'nelc,iscas,ispc1',nelc,iscas,ispc1
c     adresse par les part
capc      if(nt.eq.0) then
capc     max_t=1
capc      else
capc     jspin=iabs(ksp(ispt))
capc     max_t=maxtt(nt,ist,jspin)
capc      endif
capc      iadrcat=iadrp+max_p*(iadrt-1)+max_p*max_t*(iadrc-1)
capc      write(6,*)'iadrt,iadrp,iadrc,max_p,max_t,iadrcat',
capc     *iadrt,iadrp,iadrc,max_p,max_t,iadrcat
c fin modif app
      if(gener.eq.'MR') then
         call adrc_mr(nca,ica,ncb,icb,iadrcas)
         iadrcat=((iadrp-1)+(iadrt-1)*max_p)+1
         iadr=iadrcat+icateg_mr(iadrcas,niit(nt,ist,ispt1))
         if(yw)write(6,*)'iadrcas,niit',iadrcas,niit(nt,ist,ispt1)
         if(yw)write(6,*)'icateg_mr',icateg_mr(iadrcas,
     *   niit(nt,ist,ispt1))
      else
         iadrcat=iadrc+
     *   maxc(nelc,iscas,ispc1)*((iadrt-1)*max_p+iadrp-1)
         iadr=iadrcat+icateg(nelc,iscas,ispc1,niit(nt,ist,ispt1))
      endif
c     write(6,*)'nelc,iscas,ispc1,nt,ist,ispt1,icateg'
c    *,nelc,iscas,ispc1,nt,ist,ispt1,
c    *icateg(nelc,iscas,ispc1,nt,ist,ispt1)
c     yw=.true.
      if(yw)write(6,*)'nelc,iscas,ispc1,nt,ist,ispt1'
     *,nelc,iscas,ispc1,nt,ist,ispt1
      if(yw)write(6,*)'maxc(nelc,iscas,ispc1)',maxc(nelc,iscas,ispc1)
      if(yw)write(6,*)'icateg',icateg(nelc,iscas,ispc1,
     *niit(nt,ist,ispt1))
      if(yw)write(6,*)'iadrt,iadrc,iadrp,iadrcat,iadr'
     *,iadrt,iadrc,iadrp,iadrcat,iadr
c     yw=.false.
      if(yw1) then
         nta=(nt+ispt)/2
         npa=(np+ispp)/2
         write(6,*)'nt,np,ispt,ispp,nta,npa',nt,np,ispt,ispp,nta,npa
         write(6,*)'adrdet ',
     *   ' trou',(iorb(it(k)),k=1,nta),(-iorb(it(k)),k=nta+1,nt),
     *   ' CAS',(ica(k),k=1,nca),(-icb(k),k=1,ncb),
     *   ' part',(iorb(ip(k)),k=1,npa),(-iorb(ip(k)),k=npa+1,np),
     *   ' iadr',iadr
         if(yw)write(6,*)' fin adrdet '
         if(yw)write(6,*)'------------------------'
      endif
      if(itest(7).eq.iadr) then
         nta=(nt+ispt)/2
         npa=(np+ispp)/2
         write(6,*)'nt,np,ispt,ispp,nta,npa',nt,np,ispt,ispp,nta,npa
         write(6,*)'adrdet ',
     *   ' trou',(iorb(it(k)),k=1,nta),(-iorb(it(k)),k=nta+1,nt),
     *   ' CAS',(ica(k),k=1,nca),(-icb(k),k=1,ncb),
     *   ' part',(iorb(ip(k)),k=1,npa),(-iorb(ip(k)),k=npa+1,np),
     *   ' iadr',iadr
         write(6,*)'nelc,iscas,ispc1,nt,ist,ispt1'
     *   ,nelc,iscas,ispc1,nt,ist,ispt1
         write(6,*)'maxc(nelc,iscas,ispc1)',maxc(nelc,iscas,ispc1)
         write(6,*)'icateg',icateg(nelc,iscas,ispc1,niit(nt,ist,ispt1))
         write(6,*)'iadrt,iadrc,iadrp,iadrcat,iadr'
     *   ,iadrt,iadrc,iadrp,iadrcat,iadr
         write(6,*)'max_p',max_p
         write(6,*)'np,isp,ispp,iadrp',np,isp,ispp,iadrp
         write(6,*)'nt,ispt,iadrt',nt,ispt,iadrt
         write(6,*)'nelc,iscas,ispc1',nelc,iscas,ispc1
         write(6,*)'iadrc,maxc',iadrc,maxc(nelc,iscas,ispc1)
         stop
      endif
      return
      end
