C KCREPA    SOURCE    CHAT      05/01/13    00:53:04     5004           
      SUBROUTINE KCREPA (DR,A,S,IES,NS,N,GG,SS)                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                         

C---------------------------------------------------------------------
C Calcul des facteurs de forme en 3D
C Sp appele par KALPRE
C    Creation des patches: decoupage de la face 1                       
C     N         : NOMBRE DE SOUS-ELEMENTS                               
C     GG(KES,N) : CENTRE DE GRAVITE                                     
C     SS(N)     : SURFACE RAPPORTEE A LA SURFACE 'S' DE L'ELEMENT       
C---------------------------------------------------------------------
      DIMENSION A(NS,*),GG(NS,*),SS(*),D(3)                             
      DIMENSION B(3,3),UU(4),GG1(3,200),SS1(200)                        
      E1 =0.1                                                           
      E2 =0.5                                                           
C     WRITE(6,*) '> KCREPA DR ',DR                                      
C                                                                       
      CALL KSCLAS(A,D,IES,NS)                                           
C     WRITE(6,*) ' DR D ',DR,D(1),D(2),D(3)                             
                                                                        
      IF (D(3).LE.DR) THEN                                              
         N=1                                                            
         SS(1)=S                                                        
         DO 1 K=1,IES                                                   
         GG(K,1)=(A(K,1)+A(K,2)+A(K,3))/3.                              
 1       CONTINUE                                                       
      ELSE                                                              
         IF ((D(2)/D(1)-1.).LT.E1.AND.(2.-D(3)/D(1)).LT.E2)  THEN       
C        WRITE(6,*) ' DECOUPAGE EN 2 '                                  
           DO 2 K=1,IES                                                 
           B(K,1) = A(K,1)                                              
           B(K,2) = A(K,2)                                              
           B(K,3) = (A(K,1)+A(K,3))/2.                                  
 2         CONTINUE                                                     
           CALL KNORM (IES,B,NS,UU,S1)                                  
C          WRITE(6,*) ' S S1 ',S,S1                                     
           CALL KSCLAS(B,D,IES,NS)                                      
           CALL KSDEC (DR,B,D,S1,IES,NS,N,GG,SS)                        
                                                                        
           DO 3 K=1,IES                                                 
           B(K,2) = A(K,2)                                              
           B(K,3) = A(K,3)                                              
           B(K,1) = (A(K,1)+A(K,3))/2.                                  
 3         CONTINUE                                                     
           CALL KSCLAS(B,D,IES,NS)                                      
           CALL KSDEC (DR,B,D,S-S1,IES,NS,N1,GG1,SS1)                   
                                                                        
C          WRITE(6,*) ' n n1 ',N,N1                                     
           DO 30 I=1,N1                                                 
           DO 31 K=1,IES                                                
           Gg(K,N+I)=GG1(K,I)                                           
  31       CONTINUE                                                     
           SS(N+I)=SS1(I)                                               
  30       CONTINUE                                                     
           N=N +N1                                                      
                                                                        
         ELSE                                                           
C          WRITE(6,*) ' REGULIER DECOUPAGE '                            
C     WRITE(6,*) ' A  ',A(1,3),A(2,3),A(3,3)                            
           CALL KSDEC (DR,A,D,S,IES,NS,N,GG,SS)                         
         ENDIF                                                          
                                                                        
      ENDIF                                                             
C     WRITE(6,*) '< KCREPA  ',N                                         
                                                                        
      RETURN                                                            
      END