Esope source files

   1 : C FACET2    SOURCE    PV        07/10/11    21:15:08     5907           
   2 : C---------------------------------------------------------------------|         
   3 : C                                                                     |         
   4 :        LOGICAL FUNCTION FACET2(JF)                                              
   5 : C                                                                     |         
   6 : C      CETTE FONCTION LOGIQUE INDIQUE SI LA FACETTE JF EST VALIDE.    |         
   7 : C      -+- ON TESTE L'INTERSECTION DE LA FACETTE AVEC LES FACETTES    |         
   8 : C      ENVIRONNANTES.                                                 |         
   9 : C          ON TESTE AUSSI QU'AUCUNE ARETE N'EST DIAGONALE D'UN        |         
  10 : C      FACETTE QUADRANGULAIRE                                         |         
  11 : C      ON VERIFIE QU'ELLE EST DISTANTE DES FACETTES ENVIRONNANTES     |         
  12 : C                                                                     |         
  13 : C---------------------------------------------------------------------|         
  14 : C                                                                               
  15 :       IMPLICIT INTEGER(I-N)
  16 :       IMPLICIT REAL*8(A-H,O-Z)
  17 : -INC TDEMAIT                                                                    
  18 : -INC CCOPTIO                                                                    
  19 :        LOGICAL INTER,DROIT,DIAGO                                                
  20 : C                                                                               
  21 :        FACET2=.TRUE.                                                            
  22 : C                                                                               
  23 : *  NE FAIRE LES TESTS QUE SI LA FACETTE EST NOUVELLE                            
  24 :        IF=0                                                                     
  25 :        DO 50 I=1,NFACET                                                         
  26 :          IF=IFUT(I)                                                             
  27 :           IF (IF.EQ.JF) GOTO 60                                                 
  28 :   50   CONTINUE                                                                 
  29 :        RETURN                                                                   
  30 :   60   CONTINUE                                                                 
  31 : *                                                                               
  32 :        I1=NFC(1,JF)                                                             
  33 :        I2=NFC(2,JF)                                                             
  34 :        I3=NFC(3,JF)                                                             
  35 :        I4=NFC(4,JF)                                                             
  36 :           IF (DIAGO(I1,I2,0.95d0)) GOTO 500
  37 :           IF (DIAGO(I2,I3,0.95d0)) GOTO 500
  38 :       IF (I4.EQ.0) THEN                                                         
  39 :           IF (DIAGO(I3,I1,0.95d0)) GOTO 500
  40 :       ELSE                                                                      
  41 :           IF (DIAGO(I3,I4,0.95d0)) GOTO 500
  42 :           IF (DIAGO(I4,I1,0.95d0)) GOTO 500
  43 :       ENDIF                                                                     
  44 : C                                                                               
  45 : C      TEST DE L'INTERSECTION DE LA FACETTE JF AVEC LES FACETTES ENVIRON        
  46 : C      -----------------------------------------------------------------        
  47 : C                                                                               
  48 : 105    CONTINUE                                                                 
  49 : C                                                                               
  50 : *      DO 110 I=1,NFACET                                                        
  51 : *        IF=IFUT(I)                                                             
  52 : *         IF (IF.EQ.JF) GOTO 110                                                
  53 : *           J1=NFC(1,IF)                                                        
  54 : *           J2=NFC(2,IF)                                                        
  55 : *           J3=NFC(3,IF)                                                        
  56 : *           J4=NFC(4,IF)                                                        
  57 : *            IF (INTER(I1,I2,I3,J1,J2,J3,XYZ(1,1))) GOTO 500                    
  58 : *         IF (I4.NE.0) THEN                                                     
  59 : *            IF (INTER(I3,I4,I1,J1,J2,J3,XYZ(1,1))) GOTO 500                    
  60 : *         ENDIF                                                                 
  61 : *         IF (J4.NE.0) THEN                                                     
  62 : *            IF(INTER(I1,I2,I3,J3,J4,J1,XYZ(1,1))) GOTO 500                     
  63 : *         IF (I4.EQ.0) GOTO 110                                                 
  64 : *            IF(INTER(I3,I4,I1,J3,J4,J1,XYZ(1,1))) GOTO 500                     
  65 : *         ENDIF                                                                 
  66 : *110   CONTINUE                                                                 
  67 : C                                                                               
  68 : C                                                                               
  69 : C      FACET2=FALSE SI LA NOUVELLE FACETTE EST MAUVAISE                         
  70 : C      FACET2=TRUE SI LA NOUVELLE FACETTE EST BONNE                             
  71 : C                                                                               
  72 :        FACET2=.TRUE.                                                            
  73 :        RETURN                                                                   
  74 : 500        FACET2=.FALSE.                                                       
  75 : *          WRITE(6,2000)                                                        
  76 : 2000       FORMAT(' FACET2 DESTRUCTION DE L',1H','ELEMENT')                     
  77 :        RETURN                                                                   
  78 : C                                                                               
  79 :        END                                                                      
  80 :  
  81 :  
  82 :