Esope source files

   1 : C EGA1      SOURCE    PV        07/11/23    21:16:49     5978           
   2 :       LOGICAL FUNCTION EGA1 (IP1,IP2,EPS1)                                      
   3 :       implicit real*8 (a-h,o-z)
   4 : ************************************************************************        
   5 : *                                                                               
   6 : *                             E G A 1                                           
   7 : *                             -------                                           
   8 : *                                                                               
   9 : * FONCTION:                                                                     
  10 : * ---------                                                                     
  11 : *                                                                               
  12 : *     INDIQUER SI 2 POINTS ONT MEME POSITION DANS L'ESPACE, A PEU DE            
  13 : *     CHOSES PRES                                                               
  14 : *                                                                               
  15 : * MODULES UTILISES:                                                             
  16 : * -----------------                                                             
  17 : *                                                                               
  18 :       IMPLICIT INTEGER(I-N)
  19 : -INC CCGEOME                                                                    
  20 : -INC CCOPTIO                                                                    
  21 : -INC SMCOORD                                                                    
  22 : *                                                                               
  23 : * ARGUMENTS:   (E)=ENTREE   (S)=SORTIE   (+ = PASSE PAR COMMUN)                 
  24 : * ----------                                                                    
  25 : *                                                                               
  26 : *     IP1     (E)  1ER POINT.                                                   
  27 : *     IP2     (E)  2EME POINT.                                                  
  28 : *     EPS1    (E)  TOLERANCE POUR ANNONCER "MEME POSITION".                     
  29 : *                  SI NEGATIF, AUCUNE TOLERANCE SPECIFIEE: ON PREND UN          
  30 : *                  SOUS-MULTIPLE DE LA DENSITE.                                 
  31 : *             (S)  TOLERANCE UTILISEE.                                          
  32 : *    +DENSIT  (E)  VOIR "CGEOME".                                               
  33 : *    +IDIM    (E)  VOIR "COPTIO".                                               
  34 : *    +MCOORD  (E)  VOIR "COPTIO".                                               
  35 : *     EGA1    (S)  .TRUE. SI LES POINTS SONT A LA MEME POSITION.                
  36 : *                  .FALSE. SINON.                                               
  37 : *                                                                               
  38 :       INTEGER IP1,IP2                                                           
  39 : *                                                                               
  40 : * AUTEUR, DATE DE CREATION:                                                     
  41 : * -------------------------                                                     
  42 : *                                                                               
  43 : *     PASCAL MANIGOT     1ER OCTOBRE 1986                                       
  44 : *                                                                               
  45 : * LANGAGE:                                                                      
  46 : * --------                                                                      
  47 : *                                                                               
  48 : *     ESOPE + FORTRAN77                                                         
  49 : *                                                                               
  50 : ************************************************************************        
  51 : *                                                                               
  52 :       REAL*8 EPS1                                                               
  53 :       IF (IP1 .EQ. IP2) THEN                                                    
  54 :          EGA1 = .TRUE.                                                          
  55 :          RETURN                                                                 
  56 :       END IF                                                                    
  57 : *                                                                               
  58 :       SEGACT,MCOORD                                                             
  59 :       IDIMP1 = IDIM + 1                                                         
  60 : *                                                                               
  61 :       IF (EPS1 .LT. 0.) THEN                                                    
  62 :          EPS1 = (XCOOR(IP1*IDIMP1) + XCOOR(IP2*IDIMP1)) / 20.                   
  63 :          IF (EPS1 .LE. 0.) EPS1 = DENSIT /10.                                   
  64 :       END IF                                                                    
  65 : *                                                                               
  66 :       DIST = (XCOOR((IP1-1)*IDIMP1+1) - XCOOR((IP2-1)*IDIMP1+1))**2             
  67 :      &     + (XCOOR((IP1-1)*IDIMP1+2) - XCOOR((IP2-1)*IDIMP1+2))**2             
  68 :       IF (IDIM .EQ. 3) THEN                                                     
  69 :          DIST = DIST +                                                          
  70 :      &         (XCOOR((IP1-1)*IDIMP1+3) - XCOOR((IP2-1)*IDIMP1+3))**2           
  71 :       END IF                                                                    
  72 :       DIST = SQRT(DIST)                                                         
  73 : *                                                                               
  74 :       EGA1 = DIST.LE.EPS1                                                       
  75 : *                                                                               
  76 :       END                                                                       
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :