      subroutine sc02j(in,jn,kn,ln,dum,hii)
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      parameter(maxsym=8)
      include 'maxorb.prm'
      parameter(maxorbcas=16)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |                      hii                                        |
c    |                               |(iadrv)|       | |
c                                                     (ysgn)
c
      common/dim/iadri ; integer(8) iadri
c
c-------------------------------------------------------------
c     on compte le nb de trous, d'orb CAS et de part ajoutes en 1 et 2
c              ijkl(1),ijkl(2),      ijkl(3),ijkl(4)
c
c     les det sont ecrits en OCCUPATION. Les trous sont a changer
c     de cote pour ecrire en T/P
c-------------------------------------------------------------
c
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common /icd1/ispin(2)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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 ijkl(4)
      dimension hii(iadri)
      yw1=.false.
      yw=.false.
CYW      if(yw)write(6,*)'sc02 ispin',ispin
      nt1=0
      np1=0
      nc1=0
      nt2=0
      np2=0
      nc2=0
      nt1a=0
      np1a=0
      nc1a=0
      nt2a=0
      np2a=0
      nc2a=0
      nt1b=0
      np1b=0
      nc1b=0
      nt2b=0
      np2b=0
      nc2b=0
c
c--   sc2 : in et jn doivent etre en dessous du niveau de Fermi,
c           kn et ln au-dessus
      ijkl(1)=in
      ijkl(2)=jn
      ijkl(3)=kn
      ijkl(4)=ln
      if(yw1)write(75,*)'sc02 XXX int' ,ijkl,'$'
      if(yw1) call scril
c
c--   repartition de l'integrale dans les determinants
      isint1=1
      isint2=1
      do i=1,2
         ind=ijkl(i)
CJose    Pose este if aci per al cas en el que revistam
CJose    ab les monoexcitacions i estem en el cas de les
CJose    integrals monoelectroniques ab dos indexs 0.
         if(ind.ne.0) then
            ity=itype(ind)
CYWc         if(yw)write(6,*)'i,ity',i,ity
            if(ity.eq.1) then
               isint2=its(isint1,itsym(ind))
               call cd02a(nt2,ispin(i),nt2a,it2a,nt2b,it2b,ind)
            else if(ity.eq.2) then
               isint1=its(isint1,itsym(ind))
               call cd02a(nc1,ispin(i),nc1a,ic1a,nc1b,ic1b,ind)
            else if(ity.eq.3) then
               isint1=its(isint1,itsym(ind))
               call cd02a(np1,ispin(i),np1a,ip1a,np1b,ip1b,ind)
            endif
         endif
      enddo
      do i=1,2
         ind=ijkl(i+2)
CJose
         if(ind.ne.0) then
            ity=itype(ind)
c        write(6,*)'i,ity',i,ity
            if(ity.eq.1) then
               isint1=its(isint1,itsym(ind))
               call cd02a(nt1,ispin(i),nt1a,it1a,nt1b,it1b,ind)
            else if(ity.eq.2) then
               isint2=its(isint1,itsym(ind))
               call cd02a(nc2,ispin(i),nc2a,ic2a,nc2b,ic2b,ind)
            else if(ity.eq.3) then
               isint2=its(isint1,itsym(ind))
               call cd02a(np2,ispin(i),np2a,ip2a,np2b,ip2b,ind)
            endif
         endif
      enddo
      if(yw1)write(75,*)'sc02 int sur det',
     *'  trou',(it1a(k),k=1,nt1a),(-it1b(k),k=1,nt1b),
     *' CAS',(ic1a(k),k=1,nc1a),(-ic1b(k),k=1,nc1b),
     *' part',(ip1a(k),k=1,np1a),(-ip1b(k),k=1,np1b),' | ',
     *' trou',(it2a(k),k=1,nt2a),(-it2b(k),k=1,nt2b),
     *' CAS',(ic2a(k),k=1,nc2a),(-ic2b(k),k=1,nc2b),
     *' part',(ip2a(k),k=1,np2a),(-ip2b(k),k=1,np2b),'$'
      if(yw1) call scril
c      call sc06(ijkl)
      call sc03
      call sc04(hii,dum)
      return
      end
