Esope source files

   1 : C VALTRI    SOURCE    PV        07/11/23    21:19:51     5978           
   2 :       SUBROUTINE VALTRI (NOD1,NOD2,NOD3,  QUALIT)                               
   3 :       implicit real*8 (a-h,o-z)
   4 : ************************************************************************        
   5 : *                                                                               
   6 : *                             V A L T R I                                       
   7 : *                             -----------                                       
   8 : *                                                                               
   9 : * FONCTION:                                                                     
  10 : * ---------                                                                     
  11 : *                                                                               
  12 : *     CALCUL DE LA QUALITE D'UN TRIANGLE.                                       
  13 : *                                                                               
  14 : * MODULES UTILISES:                                                             
  15 : * -----------------                                                             
  16 : *                                                                               
  17 :       IMPLICIT INTEGER(I-N)
  18 : -INC CCOPTIO                                                                    
  19 : -INC SMCOORD                                                                    
  20 : *                                                                               
  21 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
  22 : * -----------                                                                   
  23 : *                                                                               
  24 : *    +XCOOR   (E)  VOIR LE COMMUN "COPTIO" ET LE SEGMENT "MCOORD".              
  25 : *                  (SEGMENT SUPPOSE ACTIF)                                      
  26 : *    +IDIM    (E)  VOIR LE COMMUN "COPTIO".                                     
  27 : *     NOD1    (E)  NUMERO DU NOEUD 1.                                           
  28 : *     NOD2    (E)  NUMERO DU NOEUD 2.                                           
  29 : *     NOD3    (E)  NUMERO DU NOEUD 3.                                           
  30 : *     QUALIT  (S)  RAPPORT DE SURFACES, PONDERE DE FACON A OBTENIR UN           
  31 : *                  MAXIMUM DE 1 POUR UN TRIANGLE EQUILATERAL.                   
  32 : *                                                                               
  33 :       REAL*8 QUALIT
  34 : *                                                                               
  35 : * AUTEUR, DATE DE CREATION:                                                     
  36 : * -------------------------                                                     
  37 : *                                                                               
  38 : *     PASCAL MANIGOT     5 OCTOBRE 1990                                         
  39 : *                                                                               
  40 : ************************************************************************        
  41 : *                                                                               
  42 :       IDIMP1 = IDIM + 1                                                         
  43 :       X12 = XCOOR((NOD2-1)*IDIMP1+1)                                            
  44 :      &    - XCOOR((NOD1-1)*IDIMP1+1)                                            
  45 :       X13 = XCOOR((NOD3-1)*IDIMP1+1)                                            
  46 :      &    - XCOOR((NOD1-1)*IDIMP1+1)                                            
  47 :       X23 = X13 - X12                                                           
  48 :       Y12 = XCOOR((NOD2-1)*IDIMP1+2)                                            
  49 :      &    - XCOOR((NOD1-1)*IDIMP1+2)                                            
  50 :       Y13 = XCOOR((NOD3-1)*IDIMP1+2)                                            
  51 :      &    - XCOOR((NOD1-1)*IDIMP1+2)                                            
  52 :       Y23 = Y13 - Y12                                                           
  53 :       IF (IDIM.EQ.3) THEN                                                       
  54 :          Z12 = XCOOR((NOD2-1)*IDIMP1+3)                                         
  55 :      &       - XCOOR((NOD1-1)*IDIMP1+3)                                         
  56 :          Z13 = XCOOR((NOD3-1)*IDIMP1+3)                                         
  57 :      &       - XCOOR((NOD1-1)*IDIMP1+3)                                         
  58 :          Z23 = Z13 - Z12                                                        
  59 :       ELSE                                                                      
  60 :          Z12 = 0.                                                               
  61 :          Z13 = 0.                                                               
  62 :          Z23 = 0.                                                               
  63 :       END IF                                                                    
  64 : *                                                                               
  65 :       SURFX2 = SQRT ( (Y12*Z13 - Y13*Z12) **2                                   
  66 :      &           + (Z12*X13 - Z13*X12) **2                                      
  67 :      &           + (X12*Y13 - X13*Y12) **2 )                                    
  68 :       SURFMA = MAX ( X12**2 + Y12**2 + Z12**2 ,                                 
  69 :      &               X13**2 + Y13**2 + Z13**2 ,                                 
  70 :      &               X23**2 + Y23**2 + Z23**2 )                                 
  71 :       QUALIT = SURFX2 / SURFMA / 0.866                                          
  72 : *                                                                               
  73 :       END                                                                       
  74 :  
  75 :