C FERME     SOURCE    PV        07/10/05    21:15:48     5890           
C---------------------------------------------------------------------|         
C                                                                     |         
       LOGICAL FUNCTION FERME(KKK)                                              
C                                                                     |         
C      CETTE FONCTION LOGIQUE VERIFIE SI LE MAILLAGE DE SURFACE       |         
C      EST FERME.                                                     |         
C      ELLE VERIFIE AUSSI LE SIGNE DU VOLUME INTERNE                  |         
C                                                                     |         
C      FERME EST VRAI SI LE MAILLAGE DE SURFACE EST FERME             |         
C                                                                     |         
C      FERME EST FAUX SI LE MAILLAGE DE SURFACE EST OUVERT            |         
C                                                                     |         
C      ELLE TENTE D'ORIENTER LES ELEME,TS TOUS PAREILS                |         
C                                                                     |         
C                                                                     |         
C---------------------------------------------------------------------|         
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC TDEMAIT                                                                    
-INC CCOPTIO                                                                    
C                                                                               
C       WRITE(6,1000)                                                           
C1000   FORMAT(' SUBROUTINE FERME')                                             
C                                                                               
      IBID =KKK                                                                 
      IF (NFACET.EQ.0) GOTO 301                                                 
      DO 90 I=1,NFACET
       IFAT(I)=0
       IFUT(I)=0
  90  CONTINUE                                                                  
       IFC=1
       IFAT(1)=1
       IFUT(1)=1
       DO 100 I=1,NFACET                                                        
        IF=IFAT(I)
        IF (IF.EQ.0) GOTO 200
         DO 110 I1=1,4                                                          
          J1=NFC(I1,IF)                                                         
              NB=0                                                              
              NBPA=0                                                            
               IF (J1.EQ.0) GOTO 100                                            
                 J2=ISUCC(IF,J1)                                                
                 IFJ2=0                                                         
                   DO 120 K=1,40
                      JF=NPF(K,J1)                                              
                      IF (JF.EQ.0) GOTO 130                                     
                      IF (JF.EQ.IF) GOTO 120                                    
                      IF (ISUCC(JF,J1).EQ.J2) THEN                              
*  RETOURNER JF                                                                 
         IFJ2=1
         IF (IFUT(JF).EQ.1) GOTO 200
         NBJ=4                                                                  
         IF (NFC(4,JF).EQ.0) NBJ=3                                              
         DO 125 I2=1,NBJ/2                                                      
          NTEMP=NFC(NBJ+1-I2,JF)                                                
          NFC(NBJ+1-I2,JF)=NFC(I2,JF)                                           
          NFC(I2,JF)=NTEMP                                                      
125      CONTINUE                                                               
              IFC=IFC+1
              IFAT(IFC)=JF
              IFUT(JF)=1
                       ENDIF                                                    
           IF (IPRED(JF,J1).EQ.J2) THEN                                         
           IFJ2=1
              IF (IFUT(JF).EQ.1) GOTO 120
              IFC=IFC+1
              IFAT(IFC)=JF
              IFUT(JF)=1
           ENDIF                                                                
120                CONTINUE                                                     
130                CONTINUE                                                     
          IF(IFJ2.EQ.0) GOTO 200
110          CONTINUE                                                           
100    CONTINUE                                                                 
       IF (IFC.NE.NFACET) GOTO 200
C                                                                               
       FERME=.TRUE.                                                             
C  VERIFICATION DU SIGNE                                                        
        VOL=0.                                                                  
         DO 300 IF=1,NFACET
            I1=NFC(1,IF)                                                        
            I2=NFC(2,IF)                                                        
            I3=NFC(3,IF)                                                        
         VOL=VOL-(XYZ(1,I1)*(XYZ(2,I2)*XYZ(3,I3)-XYZ(3,I2)*XYZ(2,I3))           
     # +         XYZ(2,I1)*(XYZ(3,I2)*XYZ(1,I3)-XYZ(1,I2)*XYZ(3,I3))            
     # +         XYZ(3,I1)*(XYZ(1,I2)*XYZ(2,I3)-XYZ(2,I2)*XYZ(1,I3)))           
            I4=NFC(4,IF)                                                        
            IF (I4.EQ.0) GOTO 300                                               
         VOL=VOL-(XYZ(1,I3)*(XYZ(2,I4)*XYZ(3,I1)-XYZ(3,I4)*XYZ(2,I1))           
     # +         XYZ(2,I3)*(XYZ(3,I4)*XYZ(1,I1)-XYZ(1,I4)*XYZ(3,I1))            
     # +         XYZ(3,I3)*(XYZ(1,I4)*XYZ(2,I1)-XYZ(2,I4)*XYZ(1,I1)))           
300    CONTINUE                                                                 
301    CONTINUE                                                                 
       FERME=.TRUE.                                                             
       IF (VOL.LT.0.) GOTO 220                                                  
       GOTO 400                                                                 
C                                                                               
200    FERME=.FALSE.                                                            
       WRITE(6,1010)J1,J2,IF,JF
1010   FORMAT('  PROBLEME FERME ARETE ',2I5,' FACETTES ',2I5)
C                                                                               
       RETURN                                                                   
220    CONTINUE                                                                 
*  TOUT RETOURNER                                                               
       DO 310 JF=1,NFACET                                                       
         NBJ=4                                                                  
         IF (NFC(4,JF).EQ.0) NBJ=3                                              
         DO 320 I2=1,NBJ/2                                                      
          NTEMP=NFC(NBJ+1-I2,JF)                                                
          NFC(NBJ+1-I2,JF)=NFC(I2,JF)                                           
          NFC(I2,JF)=NTEMP                                                      
320      CONTINUE                                                               
310      CONTINUE                                                               
400      CONTINUE                                                               
*  REMETTRE IFAT A ZERO                                                         
       DO 401 I=1,NFACET                                                        
        IFAT(I)=I
        IFUT(I)=I
 401   CONTINUE                                                                 
       RETURN                                                                   
       END