C KREM3G    SOURCE    CHAT      05/01/13    01:06:19     5004           
      SUBROUTINE KREM3G(K2,NS1,NS2,NS3,NF1,NF2,NF3,NA1,NA2,NA3                  
     * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF,SPROJP)                                  
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
C----------------------------------------------------------------------
C Calcul des facteurs de forme en 3D
C Sp appele par KPROJG
C                                                                               
C   CAS DE 3 FACES DIFFERENTES NON PARALLELES
C   -----------------------------------------
C                                                                               
C----------------------------------------------------------------------         
C                                                                               
      DIMENSION U2(4),KC1(2),KG(2),KH(2)                                        
-INC TFFOR3D
C                                                                               
      SEGMENT SPROJP                                                            
      INTEGER  KF(NPT),ICOO(2,NPT)                                              
      REAL*8   XR(3,NPT)                                                        
      ENDSEGMENT                                                                
C                                                                               
      SEGMENT SKSEGM                                                            
        INTEGER  KKSEGM(2,NSEGM)                                                
      ENDSEGMENT                                                                
C                                                                               
C     DESCRIPTION DES ARETES                                                    
C                                                                               
      SEGMENT SKCEL                                                             
      INTEGER  KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC)                   
      REAL*8   RMAX                                                             
      ENDSEGMENT                                                                
C                                                                               
C--------------------------------------------------------------------           
       NR = IR(/1)                                                              
C                                                                               
C      WRITE(6,*) ' KREM3G K2 ',K2                                              
C      WRITE(6,*) '        NF ',NF1,NF2,NF3                                     
C      WRITE(6,*) ' NFA ',NFA(NA1),NFA(NA2),NFA(NA3)                            
C                                                                               
C                                                                               
C                                                                               
      IF (NFA(NA1).NE.3.AND.NFA(NA2).NE.3.AND.NFA(NA3).NE.3) THEN               
C                                                                               
C     PAS DE FACE GENEREE                                                       
C     -------------------                                                       
C                                                                               
      CALL KINITB(KBCEL,NR,NR,KG,NG)                                            
      CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)            
      CALL KREMPA(K2,KG,NG,NF1,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)            
      CALL KFINSO(NF2,NF3,KA,IM,KH)                                             
      KG(1) = ( KG(1)/2 + KH(1) )/2                                             
      KG(2) = ( KG(2)/2 + KH(2) )/2                                             
      CALL KREMPI(NIN,K2,KG,1,NF1,C,U2,SHC3D,SKCEL,SKBUFF)                      
                                                                                
      CALL KINITB(KBCEL,NR,NR,KG,NG)                                            
      CALL KREMPA(K2,KG,NG,NF2,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)            
      CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)            
      CALL KFINSO(NF1,NF3,KA,IM,KH)                                             
      KG(1) = ( KG(1)/2 + KH(1) )/2                                             
      KG(2) = ( KG(2)/2 + KH(2) )/2                                             
      CALL KREMPI(NIN,K2,KG,1,NF2,C,U2,SHC3D,SKCEL,SKBUFF)                      
                                                                                
      CALL KINITB(KBCEL,NR,NR,KG,NG)                                            
      CALL KREMPA(K2,KG,NG,NF3,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)            
      CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)            
      CALL KFINSO(NF1,NF2,KA,IM,KH)                                             
      KG(1) = ( KG(1)/2 + KH(1) )/2                                             
      KG(2) = ( KG(2)/2 + KH(2) )/2                                             
      CALL KREMPI(NIN,K2,KG,1,NF3,C,U2,SHC3D,SKCEL,SKBUFF)                      
                                                                                
      ELSE                                                                      
C                                                                               
C     IL EXISTE UNE FACE GENEREE                                                
C     ---------------------------                                               
C                                                                               
      IF (NFA(NA2).EQ.3) THEN                                                   
      KC1(1) = ICOO(1,NS1)                                                      
      KC1(2) = ICOO(2,NS1)                                                      
      CALL KREM3F(K2,KG,NG,KC1,NA2,NF2,NF3,NF1,NA3,NA1                          
     -                       ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)                   
      ENDIF                                                                     
C                                                                               
      IF (NFA(NA3).EQ.3) THEN                                                   
      KC1(1) = ICOO(1,NS2)                                                      
      KC1(2) = ICOO(2,NS2)                                                      
      CALL KREM3F(K2,KG,NG,KC1,NA3,NF3,NF1,NF2,NA1,NA2                          
     -                       ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)                   
      ENDIF                                                                     
                                                                                
      IF (NFA(NA1).EQ.3) THEN                                                   
      KC1(1) = ICOO(1,NS3)                                                      
      KC1(2) = ICOO(2,NS3)                                                      
      CALL KREM3F(K2,KG,NG,KC1,NA1,NF1,NF2,NF3,NA2,NA3                          
     -                       ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF)                   
      ENDIF                                                                     
                                                                                
      ENDIF                                                                     
C                                                                               
      RETURN                                                                    
      END