      subroutine sc04c(
     *iadrc1,iadrc2,melc,mscas,mspc1,idebc,ifinc,isyc)
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter(idirac=15000,idicmr=35000)
c
c----------------------------------------------------------------
c     on a commence a remplir les 2 det
c     on finit de les remplir de facon semblable a droite et a
c     gauche
c----------------------------------------------------------------
c
      common/cas_spin/isz0
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      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/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
     *,iodro(maxorb*2)
     *,numinb(maxorb),numvib(maxorb)
      common/sgn/ksgn(maxorb+maxorb),isgn0,intsgn
      common /icd3/ numta(maxorb),numca(maxorb),numpa(maxorb),
     *numtb(maxorb),numcb(maxorb),numpb(maxorb)
      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 /sy/ isint1,isint2,
     *isy1ta,isy1tb,isy1pa,isy1pb,isy1ca,isy1cb,
     *isy2ta,isy2tb,isy2pa,isy2pb,isy2ca,isy2cb
      dimension iadrc1(idirac),iadrc2(idirac)
     *,melc(2,idirac),mscas(2,idirac),mspc1(2,idirac)
     *,idebc(25),ifinc(25),isyc(idirac)
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      common/mr3/ maxcmr(-2:2,maxsym,-2:2),mixtpmr(idicmr)
     *,ndetc,ndetc0,iadrc_mr(idicmr)
      dimension nsc1a(10),nsc1b(10)
      dimension ica(maxorbcas),icb(maxorbcas)
      yw=.false.
      yw1=.false.
CYW      if(yw)write(6,*)'entree dans sc04c'
c
c----------------------------------------------------------------
c     on rajoute des electrons au CAS
c----------------------------------------------------------------
c
      ncda=noac-nc1a-nc2a
      ncdb=noac-nc1b-nc2b
      imuc=0
      ysc=.true.
c     ysc : concerne le determinant exterieur a s
c     ysc=F : on est sur qu'il est exterieur
c     ysc=T : on ne sait pas
c----------------------------
c
c--------------------------------------------------
c     on a la relation :
c     nc3a=nca0+nt3a+nt1a-np1a-np3a-nc1a
c     (rem : on a nt1a-np1a-nc1a=nt2a-np2a-nc2a)
c     on ne connait pas nt3a ni np3a
c     on pose kc3a=nt3a-np3a
c     kc3a variera de -2 a 2
c     idem pour les beta
c--------------------------------------------------
c
      if(yw1)write(6,*)'sc04c noac,nc2a,nc2b,ncda',noac,nc2a,nc2b,ncda
CYW      if(yw)write(6,*)'nca0,nt1a,np1a,nc1a',nca0,nt1a,np1a,nc1a
      if(yw1) then
         write(6,*)'ic1a(k)',(ic1a(k),k=1,nc1a)
         write(6,*)'ic1b(k)',(ic1b(k),k=1,nc1b)
      endif
      do 1 kc3a=-2,2
      nc3a=nca0+kc3a+nt1a-np1a-nc1a
      if(yw1)write(6,*)'apres 1 kc3a,nc3a',kc3a,nc3a
      if(nc3a.gt.ncda) goto 1
      if(nc3a.lt.0) goto 1
      do 2 kc3b=-2,2
      indc=kc3b+3+5*(kc3a+3-1)
      idebc(indc)=imuc
      if(yw1)write(6,*)'kc3a,kc3b,indc,idebc(indc)',
     *kc3a,kc3b,indc,idebc(indc)
      nc3b=ncb0+kc3b+nt1b-np1b-nc1b
CYW      if(yw)write(6,*)'apres 2 kc3b,nc3b',kc3b,nc3b
      if(nc3b.lt.0) goto 2
      if(nc3b.gt.ncdb) goto 2
c?
c?      if(iabs(nca0-nc3a-nc3b).gt.2) goto 2
c :   pas plus de 2 el en + ou en - dans le CAS
      if(iabs(nca0+ncb0-nc3a-nc3b-nc1a-nc1b).gt.2) goto 2
      if(iabs(nca0+ncb0-nc3a-nc3b-nc2a-nc2b).gt.2) ysc=.false.
c--     test sur le spin total du CAS
      if(gener.eq.'PERT'.or.gener.eq.'DDci'.or.ygmono
     *.or.gener.eq.'MR') then
c :      pas de diff de spin sup a 2 dans le CAS
CYW         if(yw)write(6,*)'gener',gener
         if(iabs(nca0-ncb0-(nc3a+nc1a-nc3b-nc1b)).gt.2) goto 2
         if(iabs(nca0-ncb0-(nc3a+nc2a-nc3b-nc2b)).gt.2) ysc=.false.
      endif
      if(gener.eq.'DDCI'.or.gener.eq.'DDC2') then
c :      pas de diff de spin sup a 3 dans le CAS
CYW         if(yw)write(6,*)'gener',gener
         if(iabs(nca0-ncb0-(nc3a+nc1a-nc3b-nc1b)).gt.3) goto 2
         if(iabs(nca0-ncb0-(nc3a+nc2a-nc3b-nc2b)).gt.3) ysc=.false.
      endif
c     write(6,*)'nc1a,nc3a,nca0',nc1a,nc3a,nca0
c     write(6,*)'nc2a,nc3a,nca0',nc2a,nc3a,nca0
c     write(6,*)'nc1b,nc3b,ncb0',nc1b,nc3b,ncb0
c     write(6,*)'nc2b,nc3b,ncb0',nc2b,nc3b,ncb0
CYW      if(yw)write(6,*)'sc04c nc3a',nc3a
CYW      if(yw)write(6,*)'sc04c nc3b',nc3b
c     nombre de places disponibles
CYW      if(yw)
CYW     *write(6,*)'nc1a,nc1b,nc2a,nc2b',nc1a,nc1b,nc2a,nc2b
CYW      if(yw)
CYW     *write(6,*)'dispo ncda,ncdb',ncda,ncdb
c
c--   partie du CAS commune aux 2 determinants
c
      call combi0(nsc1a,ncda,nc3a,ireca)
      goto 31
 11   call combi2(nsc1a,ncda,nc3a,ireca)
 31   continue
      isy1ca=1
      isgn=1
      do i=1,nc3a
         ic3a(i)=numca(nsc1a(i))
         isy1ca=its(isy1ca,itsym(ic3a(i)))
c        isgn=isgn*ksgn((ic3a(i)))
      enddo
c     isgn1ca=isgn
      call combi0(nsc1b,ncdb,nc3b,irecb)
      goto 32
 12   call combi2(nsc1b,ncdb,nc3b,irecb)
 32   continue
      isy1cb=isy1ca
c     isgn=isgn1ca
      do i=1,nc3b
         ic3b(i)=numcb(nsc1b(i))
         isy1cb=its(isy1cb,itsym(ic3b(i)))
      enddo
      if(yw1) then
         write(6,*)'ic3a(k)',(ic3a(k),k=1,nc3a)
         write(6,*)'ic3b(k)',(ic3b(k),k=1,nc3b)
      endif
c
c--   determinant qui doit appartenir a S
c
      call union(nca,nc1a,nc3a,ica,ic1a,ic3a)
      call reor(nca,ica,idum)
      call union(ncb,nc1b,nc3b,icb,ic1b,ic3b)
      call reor(ncb,icb,idum)
      ispcas=nca-ncb-isz0
c     if(ispcas.eq.0) then
c        ispc11=0
c     else
c        ispc11=ispcas/iabs(ispcas)
c     endif
      ispc11=ksp(ispcas)
CYW      if(yw)write(6,*)'ispcas,ispc11,nca,ncb,isz0',
CYW     *ispcas,ispc11,nca,ncb,isz0
      nelc1=nca+ncb-nelac
      iscas1=1
      do k=1,nca
         iscas1=its(iscas1,itsym(ica(k)))
      enddo
      do k=1,ncb
         iscas1=its(iscas1,itsym(icb(k)))
      enddo
      call adrc(0,nca,ica,ncb,icb,iadr1)
      if(gener.eq.'MR') then
         iadr1=iadrc_mr(iadr1+maxcmr(nelc1,iscas1,ispc11))
      endif
c      print*,'sc04c cas1',(ica(k),k=1,nca),'  ',(-icb(k),k=1,ncb)
c
c--   determinant qui ne doit pas appartenir a S
c
      if(.not.ysc) then
c        on est sur que le det est exterieur a S
         iadr2=-1
         goto 4
      endif
      call union(nca,nc2a,nc3a,ica,ic2a,ic3a)
      call reor(nca,ica,idum)
      call union(ncb,nc2b,nc3b,icb,ic2b,ic3b)
      call reor(ncb,icb,idum)
      ispcas=nca-ncb-isz0
      ispc12=ksp(ispcas)
      nelc2=nca+ncb-nelac
      iscas2=1
      do k=1,nca
         iscas2=its(iscas2,itsym(ica(k)))
      enddo
      do k=1,ncb
         iscas2=its(iscas2,itsym(icb(k)))
      enddo
      call adrc(0,nca,ica,ncb,icb,iadr2)
c      print*,'sc04c cas2',(ica(k),k=1,nca),'  ',(-icb(k),k=1,ncb)
      if(gener.eq.'MR') then
c        print*,'adresses CAS',iadr1,iadr2
c        print*,'nelc1,iscas1,ispc11,maxcmr',
c     *   nelc1,iscas1,ispc11,maxcmr(nelc1,iscas1,ispc11)
c        print*,'nelc2,iscas2,ispc12,maxcmr',
c     *   nelc2,iscas2,ispc12,maxcmr(nelc2,iscas2,ispc12)
         iadr2=iadrc_mr(iadr2+maxcmr(nelc2,iscas2,ispc12))
c        print*,'adresses CAS',iadr1,iadr2
      endif
CYW      if(yw)write(6,*)'adresses CAS',iadr1,iadr2
c-----------------------------------------------
c     on stocke les adresses
c-----------------------------------------------
 4    continue
      imuc=imuc+1
      if(imuc.gt.idirac) goto 3
      isyc(imuc)=isy1cb
      iadrc1(imuc)=iadr1
      iadrc2(imuc)=iadr2
      melc(1,imuc)=nelc1
      melc(2,imuc)=nelc2
      mscas(1,imuc)=iscas1
      mscas(2,imuc)=iscas2
      mspc1(1,imuc)=ispc11
      mspc1(2,imuc)=ispc12
CYW      if(yw)write(6,*)
CYW     *'imuc,isy1cb,isgn,iadr1,iadr2,nelc1,iscas1,ispc11,ispc12'
CYW     *,imuc,isy1cb,isgn,iadr1,iadr2,nelc1,iscas1,ispc11,ispc12
CYW      if(yw)write(6,*)
CYW     *'nelc2,iscas2'
CYW     *,nelc2,iscas2
 3    continue
      if(irecb.eq.0) goto 12
      if(ireca.eq.0) goto 11
      ifinc(indc)=imuc
      if(yw1)write(6,*)'indc,idebc(indc),ifinc(indc)',indc,idebc(indc)
     *,ifinc(indc)
 2    continue
 1    continue
CYW      if(yw)write(6,*)'idebc',idebc
CYW      if(yw)write(6,*)'ifinc',ifinc
CYW      if(yw)write(6,*)'sortie sc04c'
      if(imuc.gt.idirac) then
         write(6,*)'imuc trop grand   imuc,idirac',imuc,idirac
         write(6,*)'augmenter idirac'
         stop
      endif
      return
      end
