      subroutine f_int
c----------------------------------------------------------
c    fonction qui attribue la valeur 0 ou 1 a une integrale
c   suivant qu'elle existe ou pas : depend de ses indices
c    le resultat est stocke dans un tableau d'entiers intc(i1,i2,i3,i4)
c   l'indice est un trou  => ii=1
c   l'indice est au CAS   => ii=2
c   l'indice est une part => ii=3
c----------------------------------------------------------
c     Creation du tableau permettant d'avoir ii en fonction
c    de l'orbitale ou se trouve l'electron : itype(orb)
c----------------------------------------------------------
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      PARAMETER (maxorb=500,maxsym=8,MNEL=5,maxorbcas=16)
      PARAMETER (MAXELCAS=20)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/sym/itsym(2*maxorb),its(maxsym,maxsym),nsym
      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 /cat_int/intc(3,3,3,3),intsc(17,maxsym,maxsym,maxsym)
      common/int_type/itype(maxorb)
      do i1=1,3
         do i2=1,3
            do i3=1,3
               do i4=1,3
                  intc(i1,i2,i3,i4)=0
               enddo
            enddo
         enddo
      enddo
c----- integrale tttC
      intc(1,1,1,2)=1
c----- integrale tttp
      intc(1,1,1,3)=2
c----- integrale ttCC
      intc(1,1,2,2)=3
c----- integrale ttCp
      intc(1,1,2,3)=4
c----- integrale ttpp
      intc(1,1,3,3)=5
c----- integrale tCtC
      intc(1,2,1,2)=6
c----- integrale tCtp
      intc(1,2,1,3)=7
c----- integrale tCCC
      intc(1,2,2,2)=8
c----- integrale tCCp
      intc(1,2,2,3)=9
c----- integrale tCpp
      intc(1,2,3,3)=10
c----- integrale tpCC
      intc(1,3,2,2)=11
c----- integrale tpCp
      intc(1,3,2,3)=12
c----- integrale tppp
      intc(1,3,3,3)=13
c----- integrale Ctpp
      intc(2,1,3,3)=14
c----- integrale CCCp
      intc(2,2,2,3)=15
c----- integrale CCpp
      intc(2,2,3,3)=16
c----- integrale CpCp
      intc(2,3,2,3)=17
c     write(6,*)'i1 i2 i3 int1 int2 int3'
c     do i1=1,3
c       do i2=1,3
c          do i3=1,3
c              write(6,*)i1,' ',i2,' ',i3,' ',
c    *         (intc(i1,i2,i3,i4),i4=1,3)
c          enddo
c       enddo
c     enddo
c----------------------------------------------------------
c                itype(i)=1 si i correspond a un trou
c                         2                 au CAS
c                         3                 a une particule
c----------------------------------------------------------
      i=1
      do k=1,noca0
         if(numt(i).eq.k) then
            itype(k)=1
            i=i+1
         else
            itype(k)=2
         endif
      enddo
      i=1
      do k=noca0+1,norb
         if(nump(i).eq.k) then
            itype(k)=3
            i=i+1
         else
            itype(k)=2
         endif
      enddo
c      write(6,*)'noca=',noca,'  nocb=',nocb
c      write(6,*)'itype: ',(itype(k),k=1,norb)
c-----------------------------------------------------------------
c     Sous categories
c-----------------------------------------------------------------
      iscat0=0
      do 1 i1=1,3
      do 2 i2=1,3
      do 3 i3=1,3
      do 4 i4=1,3
      jcat=intc(i1,i2,i3,i4)
      if(jcat.ne.0) then
c------- Sous-categories d'integrales
         do 5 isi=1,nsym
         do 6 isj=1,nsym
         do 7 isk=1,nsym
         iscat=1
         isl=its(1,its(isi,its(isj,isk)))
         if(i1.eq.1) then
            iscat=iscat*nts(isi)
         else
            if(i1.eq.2) then
               iscat=iscat*ncs(isi)
            else
               iscat=iscat*nps(isi)
            endif
         endif
         if(i2.eq.1) then
            iscat=iscat*nts(isj)
         else
            if(i2.eq.2) then
               iscat=iscat*ncs(isj)
            else
               iscat=iscat*nps(isj)
            endif
         endif
         if(i3.eq.1) then
            iscat=iscat*nts(isk)
         else
            if(i3.eq.2) then
               iscat=iscat*ncs(isk)
            else
               iscat=iscat*nps(isk)
            endif
         endif
         if(i4.eq.1) then
            iscat=iscat*nts(isl)
         else
            if(i4.eq.2) then
               iscat=iscat*ncs(isl)
            else
               iscat=iscat*nps(isl)
            endif
         endif
         intsc(jcat,isi,isj,isk)=iscat0+
     *   intsc(jcat,isi,isj,isk)
         iscat0=iscat +iscat0
c                             write(6,*)'jcat=',jcat,' isi=',isi,
c    *                        ' isj=',isj,' isk=',isk,' isl=',isl,
c    *                        ' iscat',iscat
 7       continue
 6       continue
 5       continue
      endif
 4    continue
 3    continue
 2    continue
 1    continue
c     do jcat=1,17
c        write(6,*)'jcat=',jcat
c        do isi=1,nsym
c           write(6,*)'isi',isi
c           do isj=1,nsym
c         write(6,*)'isj=',isj,' intsc',(intsc(jcat,isi,isj,k),k=1,nsym)
c           enddo
c        enddo
c     enddo
      return
      end
