      subroutine sc06(ijkl)
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      parameter(maxsym=8)
      include 'maxorb.prm'
      parameter(maxorbcas=16)
c
c----------------------------------------------------------------
c     preparation du signe des elements de matrice
c----------------------------------------------------------------
c
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common /icd3/ numta(maxorb),numca(maxorb),numpa(maxorb),
     *numtb(maxorb),numcb(maxorb),numpb(maxorb)
      common /icd1/ispin(2)
      common/compt/nt1,np1,nc1,nt2,np2,nc2,
     *nt1a,np1a,nc1a,nt1b,np1b,nc1b,
     *nt2a,np2a,nc2a,nt2b,np2b,nc2b,
     *nt3a,np3a,nc3a,nt3b,np3b,nc3b,
     *it1a(2),ip1a(2),ic1a(maxorbcas),it1b(2),ip1b(2),ic1b(maxorbcas),
     *it2a(2),ip2a(2),ic2a(maxorbcas),it2b(2),ip2b(2),ic2b(maxorbcas),
     *it3a(2),ip3a(2),ic3a(maxorbcas),it3b(2),ip3b(2),ic3b(maxorbcas)
      common/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
     *,iodro(maxorb*2)
     *,numinb(maxorb),numvib(maxorb)
      common/sgn/ksgn(maxorb+maxorb),isgn0,intsgn
      dimension ijkl(4),ijklo(4),id(maxorb)
      dimension ksgn1(maxorb+maxorb),ksgn2(maxorb+maxorb)
      yw=.false.
c
c----------------------------------------------------------------
c     integrale : <xyzt>  x,y,z,t > norb si spin beta
c     determ : <xy12345678|zt12345678>
c     ou "12345678" est la partie commune entre les det
c
c     1) "12345678" sont les inactives autres que xyzt
c     on reordonne : <12x3456y78|1z2345t678>
c     signe ?
c     partons de <xy | zt>
c     ajoutons i   <ixy | izt>    +
c                  <xiy | izt>    -
c                  <xyi | izt>    +
c                  <xiy | zti>    -
c     etc...
c     regle :
c     on definit {xo,yo}={x,y} tel que xo<yo et
c     {zo,to}={z,t} tel que zo<to
c     si i<xo<yo et i<zo<to  +
c        xo<i<yo et i<zo<to  -
c     etc...
c     ...+...xo.....-......yo.....+..
c     ...+.........zo...-........to..+..
c     ...+...x0..-.zo...+..y0.-..to..+..
c----------------------------------------------------------------
c
c-----on commence par mettre les spins beta, puis on reordonne
      nal=0
      do i=1,2
         if(ispin(i).eq.1) then
            nal=nal+2
            ijklo(i)=iodro(ijkl(i))
            ijklo(i+2)=iodro(ijkl(i+2))
         else
            ijklo(i)=iodro(ijkl(i))+norb
            ijklo(i+2)=iodro(ijkl(i+2))+norb
            ijkl(i)=ijkl(i)+norb
            ijkl(i+2)=ijkl(i+2)+norb
         endif
      enddo
CYW      if(yw)write(6,*)'sc06 ijklo av reor',(ijklo(k),k=1,4)
      call reor(2,ijklo,isgn1)
      call reor(2,ijklo(3),isgn2)
CYW      if(yw)write(6,*)'sc06 ijklo',(ijklo(k),k=1,4)
c-----on definit les zones + et - pour les inactives
      do i=1,4
         ksgn1(iordo(ijklo(i)))=0
         ksgn2(iordo(ijklo(i)))=0
      enddo
      do i=1,ijklo(1)-1
         ksgn1(iordo(i))=1
      enddo
      do i=ijklo(1)+1,ijklo(2)-1
         ksgn1(iordo(i))=-1
      enddo
      do i=ijklo(2)+1,norb+norb
         ksgn1(iordo(i))=1
      enddo
      do i=1,ijklo(3)-1
         ksgn2(iordo(i))=1
      enddo
      do i=ijklo(3)+1,ijklo(4)-1
         ksgn2(iordo(i))=-1
      enddo
      do i=ijklo(4)+1,norb+norb
         ksgn2(iordo(i))=1
      enddo
      do i=1,norb+norb
         ksgn(i)=ksgn1(i)*ksgn2(i)
c     write(62,*)i,(ijklo(k),k=1,4),ksgn1(i),ksgn2(i),ksgn(i)
      enddo
      call reor(4,ijklo,idum)
      call reor(4,ijkl,idum)
CYW      if(yw)write(6,*)'ijklo apres reor',ijklo
CYW      if(yw)write(6,*)'ijkl apres reor',ijkl
c-----on ajoute  les inactives alpha
      call comple(ninac,numina,nal,ijkl,nd,id)
c     id sont les nd inactives disponibles
      isgn0=intsgn*isgn1*isgn2
      do i=1,nd
         isgn0=isgn0*ksgn(id(i))
CYW         if(yw)write(6,*)'i,id(i),ksgn(id(i))',i,id(i),ksgn(id(i))
      enddo
c-----on ajoute  les inactives beta
      nd=0
      if(nal.lt.4)call comple(ninac,numinb,4-nal,ijkl(nal+1),nd,id)
c     id sont les nd inactives disponibles
      do i=1,nd
         isgn0=isgn0*ksgn(id(i))
CYW         if(yw)write(6,*)'i,id(i),ksgn(id(i))',i,id(i),ksgn(id(i))
      enddo
c
c---------------------------------------------------------
c     quand on rajoutera d'autres el (CAS, part), le signe
c     de ksgn modifiera le signe de l'element de matrice
c     de la meme facon. Idem pour les trous
c---------------------------------------------------------
c
CYW      if(yw)write(6,*)'sc06 ksgn',(ksgn(k),k=1,norb),' ',
CYW     *(ksgn(k),k=norb+1,norb+norb)
CYW      if(yw)write(6,*)'sc06 isgn0',isgn0
      return
      end
