C FACOM3    SOURCE    CHAT      07/10/29    21:19:29     5940           
      subroutine facom3(inodfa,itty,icomn,icom,kfatt,itfa,kft)
**************************************************************************      
*      
*    ENTREES
*        inofa   : noeuds de l element   
*        itty    : type de l element 
*        icomn : tableau contenant les pts communs (en desordre)
*                
*        icom nombre de points communs
*
*    SORTIES
*        itfa(n) tableau des faces de ivol1 a tester   il y en a kft
*        kft nombre de face a tester 
*
*     
***************************************************************************
      IMPLICIT INTEGER(I-N)
       IMPLICIT REAL*8(A-H,O-Z)
       
      
-INC CCOPTIO
-INC SMELEME
-INC CCGEOME
C      dimension ivole(8,1)
      dimension inodfa(*),kfatt(*),itfa(*),icomn(*)

         
      if(idim.eq.3) then 
  
      nbfa1 = ltel(1,itty)
      iltad = ltel(2,itty)
C      write(6,*) ' nombre de faces ', nbfa1, ' iltad ',iltad
C      write(6,*) ' entree' ,(icomn(i),i=1,icom)

      
   
      do 1 ifac = 1,nbfa1      
      ityp= ldel(1,iltad+ifac-1)
      iad = ldel(2,iltad+ifac-1)
      npfac = kdfac(1,ityp)  
C    write(6,*)' fac  ityp iad npfac', ifac ,ityp ,iad,npfac 
       
    
      
      if(icom.EQ.npfac) then      
C -------------on tient une face complete -------------------------           
      do 2 kp = 1,npfac 
       jf1 = inodfa(lfac(iad+kp-1))
C      jf1 =ivole(lfac(iad+kp-1),ivol1)
      do 3 jk = 1,icom
C      write(6,*)'adr ',lfac(iad+kp-1),'point ',jf1,'ptcom ',icomn(jk)
         if(icomn(jk).eq.jf1) then 
         kfatt(ifac) = kfatt(ifac)+1
         if (kfatt(ifac).eq.icom) then
         kft=1
         itfa(kft) = ifac 
        goto 1000  
         endif
      endif                     
3     continue
C   si on arrive ici il y a un malaise
2     continue

           
       elseif(icom.eq.1)   then 
C ----------------- coin   commun   -------------------------        
       do 40 kp = 1,npfac 
      jf1 = inodfa(lfac(iad+kp-1))
C      jf1 =ivole(lfac(iad+kp),ivol1)
           
      do 50 jk = 1,icom
         if(icomn(jk).eq.jf1) then       
           kft=kft+1            
           itfa(kft) = ifac  
           if(kft.eq.3) goto 1000         
         endif
50     continue
40     continue 
      elseif (icom.eq.kdegre(ityp))   then 
C      else 
C ----------------- arete  commune  -------------------------

      do 20 kp = 1,npfac 
      jf1 = inodfa(lfac(iad+kp-1))
C      jf1 =ivole(lfac(iad+kp-1),ivol1)  
      do 30 jk = 1,icom
         if(icomn(jk).eq.jf1) then 
         kfatt(ifac) = kfatt(ifac)+1
            if (kfatt(ifac).EQ.2) then
            kft=kft+1            
            itfa(kft) = ifac
           if(kft.eq.2) goto 1000   
            endif 
         endif
30     continue
20     continue
       
       endif 
1     continue

      else
C ===========================2D ===================  
 
C nombre de points par cote      
      nbpc = kdegre(itty)
C   nombre de cotes       
      nbcot =nbsom(itty)
      nbpoi = nbnne(itty)   
      ini = 0 
      
      if (icom.GT.1)  then 
      
      do 100 ifac=1,nbcot 
      do 101 isa = 1,nbpc
      ini = ini+1
       if(ini.eq.nbpoi+1) ini = 1 
       jf1 = inodfa(ini)        
      do 102 jk=1,icom
         if(icomn(jk).eq.jf1) then
      kfatt(ifac)=kfatt(ifac)+1 
      if (kfatt(ifac).eq.2) then
         kft=1
         itfa(kft) = ifac 
        goto 1000        
         endif
      endif
102   continue
101   continue 
      ini = ini-1
100   continue       
      
      elseif(icom.eq.1) then 
      
C    on a un point commun  on cherche les 2 segments 
      jk=icomn(1)
      do 140 ifac=1,nbcot      
      do 141 isa=1,nbpc
      ini = ini+1
      if(ini.eq.nbpoi+1) ini = 1 
      jf1=inodfa(ini)         
      if(jf1.eq.jk) then   
      kft=kft+1
      itfa(kft) = ifac 
        if(kft.eq.2) goto 1000
      endif
  
141   continue       
      ini = ini -1
140   continue       


      endif
      endif 
       
1000  continue
C      write(6,*) ' face ou cote ',(itfa(ik),ik=1,kft)
   
      return 
      end