      subroutine adrdet(yc,jt1,it,jp1,ip,iadr)
      use module
      !
      ! Calcul de l'adresse d'un determinant
      ! donne zero si le determinant n'est pas lie
      !
      ! en entree : jt1,jp1 = nb de T/P
      ! it,ip T,P negatifs si spin beta, les beta viennent apres les
      ! alpha
      ! yc : en logique(1), occupation du CAS
      ! en sortie : iadr
      !
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      dimension yc(32),it(2),ip(2),nsa(maxorbcas)
      dimension kt(2),kp(2)
      common/bid/ibid(0:2,0:2,0:2,0:2)
      character(80) aa
      integer corr
      yw=.false.
      ! Nombre de spins alpha
      jt=jt1
      jp=jp1
      kt=abs(it)
      kp=abs(ip)
      do k=1,jt1
         if(it(k)<0) then
            jt=k-1
            exit
         endif
      enddo
      if(yw)print*,'jt1,jp1',jt1,jp1
      if(yw)print*,'it,ip',it(1:jt1),ip(1:jp1)
      if(yw)print*,'yc',yc(1:noac)
      if(yw)print*,'yc',yc(noac+1:noac+noac)
      do k=1,jp1
         if(ip(k)<0) then
            jp=k-1
            exit
         endif
      enddo
      ita=0;itb=0;ipa=0;ipb=0
      do k=1,jt1
         if(it(k)>0) ita=ita+1
      enddo
      do k=1,jt1
         if(it(k)<0) itb=itb+1
      enddo
      do k=1,jp1
         if(ip(k)>0) ipa=ipa+1
      enddo
      do k=1,jp1
         if(ip(k)<0) ipb=ipb+1
      enddo
      ibid(ita,itb,ipa,ipb)=ibid(ita,itb,ipa,ipb)+1
      ! Classe du determinant
      icl=icltp(ita,itb,ipa,ipb)
      !///////////////
      ! Adresse du CAS
      !///////////////
      call adrc(yc,iadrc,irang)
      !///////////////////////////////////////////////////////
      ! Acceptable ? (cad : le det est-il lie ?) si oui yacc=T
      ! si yacc, on calcule iadrtp
      !///////////////////////////////////////////////////////
      corr=0
      if(jt1==0) then
         if(jp1==0) then   !0T 0P
            yacc=.true.
            iadrtp=1
         else if(jp1==1) then   !0T 1P
            yacc=ilc1(kp(1)).ne.0
            iadrtp=ilc1(kp(1))
         else if(jp1==2) then   !0T 2P
            ii1=ilc1(kp(1))
            ii2=ilc1(kp(2))
            yacc=all(ilc1(kp).ne.0)
            if(yacc) then
               if(jp==1) then
                  if(ii1<ii2) then
                     iadrtp=num1(ii2)+ii1
                  else if(ii1==ii2) then
                     iadrtp=num1(nlcv+1)+ii1
                     corr=num1(nlcv+1)
                  else if(ii1>ii2) then
                     iadrtp=num1(nlcv+2)+num1(ii1)+ii2
                     corr=num1(nlcv+2)
                  endif
               else
                  iadrtp=num1(ii2)+ii1
               endif
            endif
         endif
      else if(jt1==1) then
         if(jp1==0) then   !1T 0P
            yacc=ilc1(kt(1)).ne.0
            iadrtp=ilc1(kt(1))
         else if(jp1==1) then   !1T 1P
            yacc=il(kt(1),kp(1)).ne.0
            if(yw)print*,'IL',kt(1),kp(1),il(kt(1),kp(1))
            iadrtp=il(kt(1),kp(1))
         else if(jp1==2) then   !1T 2P
            yacc=.false.
            if(ilp(kt(1),kp(1)).ne.0.and.ilc1(kp(2)).ne.0) then
               yacc=.true.
               iadrtp=abs(ipc(ilp(kt(1),kp(1)),nlco+ilc1(kp(2))))
               if(iadrtp==0) then
                  iadr=0
                  return
               endif
               if(kp(1)>kp(2)) then
                  corr=npcovv_pe+npcovv
                  iadrtp=iadrtp+corr
               endif
            endif
            if(.not.yacc.and.ilp(kt(1),kp(2)).ne.0.and.ilc1(kp(1)).ne.0)
     *      then
               yacc=.true.
               iadrtp=abs(ipc(ilp(kt(1),kp(2)),nlco+ilc1(kp(1))))
               if(iadrtp==0) then
                  iadr=0
                  return
               endif
               if(kp(1)>kp(2)) then
                  corr=npcovv_pe+npcovv
                  iadrtp=iadrtp+corr
               endif
            endif
         endif
      else if(jt1==2) then
         if(jp1==0) then   !2T 0P
            ii1=ilc1(kt(1))
            ii2=ilc1(kt(2))
            yacc=all(ilc1(kt).ne.0)
            if(yacc) then
               if(jt==1) then
                  if(ii1<ii2) then
                     iadrtp=num1(ii2)+ii1
                  else if(ii1==ii2) then
                     iadrtp=num1(nlco+1)+ii1
                     corr=num1(nlco+1)
                  else if(ii1>ii2) then
                     iadrtp=num1(nlco+2)+num1(ii1)+ii2
                     corr=num1(nlco+2)
                  endif
               else
                  iadrtp=num1(ii2)+ii1
               endif
            endif
         else if(jp1==1) then   !2T 1P
            yacc=.false.
            if(ilp(kt(1),kp(1)).ne.0.and.ilc1(kt(2)).ne.0) then
               yacc=.true.
               iadrtp=abs(ipc(ilp(kt(1),kp(1)),ilc1(kt(2))))
               if(iadrtp==0) then
                  iadr=0
                  return
               endif
               if(kt(1)>kt(2)) iadrtp=iadrtp+npcoov_te+npcoov
               if(kt(1)>kt(2)) corr=npcoov_te+npcoov
            endif
            if(.not.yacc.and.ilp(kt(2),kp(1)).ne.0.and.ilc1(kt(1)).ne.0)
     *      then
               yacc=.true.
               iadrtp=abs(ipc(ilp(kt(2),kp(1)),ilc1(kt(1))))
               if(iadrtp==0) then
                  iadr=0
                  return
               endif
               if(kt(1)>kt(2)) iadrtp=iadrtp+npcoov_te+npcoov
               if(kt(1)>kt(2)) corr=npcoov_te+npcoov
            endif
         else if(jp1==2) then   !2T 2P
            yacc=.false.
            call adrdet4(icl,kt(1),kt(2),kp(1),kp(2),iadrtp,corr)
            yacc=iadrtp.ne.0
         endif
      endif
      if(.not.yacc) then
         iadr=0
         return
      endif
      !//////////////////////////////////////
      ! Ecriture du determinant sur la sortie
      !//////////////////////////////////////
      ! print*,'ACCEPTE'
      if(mprint(8)==1)write(aa,'(32l1)') yc(1:noac*2)
      ii=noac*2+2
      if(mprint(8)==1
     *.and.jt1.ne.0)write(aa(ii+1:ii+4*jt1),'(2i4)')it(1:jt1)
      ii=ii+4*jt1+2
      if(mprint(8)==1)aa(ii+1:ii+3)='-->'
      ii=ii+5
      if(mprint(8)==1
     *.and.jp1.ne.0)write(aa(ii+1:ii+4*jp1),'(2i4)')ip(1:jp1)
      ii=ii+4*jp1+2
      !///////////////
      ! Adresse totale
      !///////////////
      iadr=iadrc+iadrtp+isdimtp(icl)
      !print*,'iadr',iadr,iadrc,iadrtp,isdimtp(icl)
      if(iadr==0) stop 'iadr=0'
      !iadr=sum(idimd(1:icl-1))+iadrtp+(iadrc-1)*idimtp(icl)
      !??????????????????????????????????
      if(mprint(8)==1)write(aa(40:79),'(5i8)') isdimtp(icl),
     *iadrc,iadrtp-corr,corr,iadr
      if(mprint(8)==1)print'(a)',aa
      !if(jt1==1) stop
!      print*,'adresse de depart',sum(idimd(1:icl-1))
      return
      end
       subroutine adrdet4(icl,kt1,kt2,kp1,kp2,iadrtp,corr)
      use module
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      dimension kt(2),kp(2)
      integer corr
      ! Adresse des det 2T 2P
      !
      ! 28  bb bb              corr : 0
      ! 29  bb a<b             corr : 0
      ! 29  bb a>b             corr : +nppaaaa+npp_pe
      ! 29  bb a=b             corr : 0
      ! 30  bb aa              corr : 0
      ! 31  a<b bb             corr : 0
      ! 31  a>b bb             corr : +nppaaaa+npp_te
      ! 31  a=b bb             corr : -npp_pe
      ! 32  a<b a<b            corr : 0
      ! 32  a<b a>b            corr : +nppaaaa+npp
      ! 32  a>b a<b            corr : +nppaaaa*2+npp
      ! 32  a>b a>b            corr : +nppaaaa*3+npp
      ! 32  a=b a<b            corr : 0
      ! 32  a=b a>b            corr : +nppaaaa*3+npp
      ! 32  a<b a=b            corr : 0
      ! 32  a>b a=b            corr : +nppaaaa*3+npp
      ! 32  a=b a=b            corr : 0
      ! 33  a<b aa             corr : 0
      ! 33  a>b aa             corr : +nppaaaa+npp_te
      ! 33  a=b aa             corr : -npp_pe
      ! 34  aa bb              corr : 0
      ! 35  aa a<b             corr : 0
      ! 35  aa a>b             corr : nppaaaa+npp_pe
      ! 35  aa a=b             corr : 0
      ! 36  aa aa              corr : 0
      !
      npp=nppaaaa+npp_pe+npp_te+npp_tepe
      !
      if(ilp(kt1,kp1).ne.0.and.ilp(kt2,kp2).ne.0) then
         ii1=ilp(kt1,kp1)
         ii2=ilp(kt2,kp2)
      else if(ilp(kt1,kp2).ne.0.and.ilp(kt2,kp1).ne.0) then
         ii1=ilp(kt1,kp2)
         ii2=ilp(kt2,kp1)
      else
         iadrtp=0
         return
      endif
      iimax=max(ii1,ii2)
      iimin=min(ii1,ii2)
      ii=iimax*(iimax-1)/2+iimin
      iadrtp=abs(ipp(ii))
      if(iadrtp==0) return
      if(icl==29) then
              !print*,'test',iadrtp,nppaaaa,npp_te,npp_pe
              !print*,'testii',ii1,ii2,ii
         if(kp1>kp2) iadrtp=iadrtp+nppaaaa+npp_pe
         if(kp1>kp2) corr=nppaaaa+npp_pe
      else if(icl==31) then
         if(kt1>kt2) iadrtp=iadrtp+nppaaaa+npp_te
         if(kt1>kt2) corr=nppaaaa+npp_te
         if(kt1==kt2) iadrtp=iadrtp-npp_pe
         if(kt1==kt2) corr=-npp_pe
      else if(icl==33) then
              !print*,'test',iadrtp,nppaaaa,npp_te,npp_pe
              !print*,'testii',ii1,ii2,ii
         if(kt1>kt2) iadrtp=iadrtp+nppaaaa+npp_te
         if(kt1>kt2) corr=nppaaaa+npp_te
         if(kt1==kt2) iadrtp=iadrtp-npp_pe
         if(kt1==kt2) corr=-npp_pe
!            if(kt1==kt2) print*,'iadrtp,npp_pe,isdimtp(icl)',
!        *   iadrtp,npp_pe,isdimtp(icl),abs(ipp(ii))
      else if(icl==35) then
         if(kp1>kp2) iadrtp=iadrtp+nppaaaa+npp_pe
         if(kp1>kp2) corr=nppaaaa+npp_pe
      else if(icl==32) then
      !
      !  <<  |  <=  |  =<  |   ==   |  <>  |  ><  |  >>  |  >=  |  <=  |
      !npaaaa|npp_pe|npp_te|npp_tepe|npaaaa|npaaaa|npaaaa|npp_pe|npp_te|
      !
         npp=npp_pe+npp_te+npp_tepe
            !print*,'npp',npp,nppaaaa,npp_pe,npp_te,npp_tepe
         if(kt1<kt2) then
            if(kp1<kp2) then
               return
            else if(kp1>kp2) then
               iadrtp=iadrtp+nppaaaa+npp
               corr=nppaaaa+npp
            else if(kp1==kp2) then
               return
            endif
         else if(kt1>kt2) then
            if(kp1<kp2) then
               iadrtp=iadrtp+nppaaaa*2+npp
               corr=nppaaaa*2+npp
            else if(kp1>kp2) then
               iadrtp=iadrtp+nppaaaa*3+npp
               corr=nppaaaa*3+npp
            else if(kp1==kp2) then
               iadrtp=iadrtp+nppaaaa*3+npp
               corr=nppaaaa*3+npp
            endif
         else if(kt1==kt2) then
            if(kp1<kp2) then
               return
            else if(kp1>kp2) then
               iadrtp=iadrtp+nppaaaa*3+npp
               corr=nppaaaa*3+npp
            else if(kp1==kp2) then
               return
            endif
         endif
      endif
      return
      end
       subroutine adrc(yc,iadrc,irang)
      use module
      !
      ! Calcul de l'adresse d'un determinant du CAS
      !
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      dimension yc(32),nsa(maxorbcas)
      ! Adresse du CAS
      yw=.false.
      yw0=.false.
      if(yw) then
         print*,'-----------entree adrc-------------------------'
         print*,'yc',yc(1:noac+noac)
         print*,'nocac0,nocbc0',nocac0,nocbc0
      endif
      nalpha=0
      do k=1,noac
         if(yc(k)) then
            nalpha=nalpha+1
            nsa(nalpha)=k
         endif
      enddo
      call rang2(nalpha,nsa,iranga)
      if(yw)print*,'nsa',nsa(1:nalpha),iranga
      nalpha=nalpha-nocac0
      nbeta=0
      do k=1,noac
         if(yc(k+noac)) then
            nbeta=nbeta+1
            nsa(nbeta)=k
         endif
      enddo
      call rang2(nbeta,nsa,irangb)
      ntb=c(noac,nbeta)
      nbeta=nbeta-nocbc0
      irang=irangb+(iranga-1)*ntb
      if(yw) then
         print*,'nalpha,nbeta',nalpha,nbeta
         print*,'iclasc(nalpha,nbeta)',iclasc(nalpha,nbeta)
         print*,'idebc',idebc(iclasc(nalpha,nbeta))
         print*,'-----------------------------------------------'
         print*,'iranga,irangb,irang ds classe',iranga,irangb,irang
      endif
      irang=irang+idebc(iclasc(nalpha,nbeta))-1
      if(yw)print*,'irang',irang
      if(yw)print*,'adrc',nalpha,nbeta,iclasc(nalpha,nbeta),
     *idebc(iclasc(nalpha,nbeta))-1
      iadrc=idetc(irang)
      if(yw0) print*,'yc',yc(1:noac+noac),irang,iadrc
      return
      end
 
 
 
 
 
