Download gtaill.eso

Back to the list

   1 : C GTAILL    SOURCE    CHAT      06/03/29    21:22:43     5360           
   2 :       SUBROUTINE GTAILL(IT, N, C, IDIMC, TAILLE, iarr )
   3 : C     *****************************************************************
   4 : C     OBJET : CALCULE LA TAILLE D'UN SIMPLEX 
   5 : C     EN ENTREE :
   6 : C       IT      : NUMERO DES NOEUDS DE L'ELEMENT
   7 : C       N       : NOMBRE DE NOEUDS DE L'ELEMENT
   8 : C       C       : COORDONNEES DES NOEUDS
   9 : C       IDIMC    : DIMENSION DE L'ESPACE
  10 : C     EN SORTIE :
  11 : C       TAILLE  : LONGUEUR D'UN SEGMENT EN 1D,2D ET 3D
  12 : C                 SURFACE D'UN TRIANGLE EN 2D ET 3D
  13 : C                 VOLUME D'UN TETRAEDRE (3D)
  14 : C       iarr    : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES
  15 : C     *****************************************************************
  16 :       IMPLICIT INTEGER(I-N)
  17 :       INTEGER IT(*),N,IDIMC,iarr
  18 :       REAL*8    C(*),TAILLE
  19 : C
  20 :       DIMENSION X(12)
  21 :       INTEGER I,J
  22 :       REAL*8    X,VX,VY,VZ 
  23 : C
  24 :       iarr = 0
  25 :       TAILLE = 0.0D0
  26 :       DO 10 I=1,(N-1)
  27 :         DO 20 J=1,IDIMC
  28 :           X((I-1)*IDIMC+J) = C(((IT(I+1)-1)*IDIMC)+J) 
  29 :      >                    - C(((IT(I)-1)*IDIMC)+J)
  30 :    20   CONTINUE
  31 :    10 CONTINUE 
  32 :       IF( IDIMC .EQ. 3 )THEN 
  33 :         VX = (X(2) * X(6)) - (X(5) * X(3))
  34 :         VY = (X(3) * X(4)) - (X(6) * X(1))
  35 :         VZ = (X(1) * X(5)) - (X(4) * X(2))
  36 :       ENDIF
  37 : C
  38 : C     CAS DU SEGMENT (1D, 2D, 3D)
  39 : C        
  40 :       IF( N. EQ. 2 )THEN
  41 :         IF( IDIMC .EQ. 1 )THEN
  42 :            TAILLE = X(1)
  43 :         ELSE IF( IDIMC .EQ. 2 )THEN
  44 :            TAILLE = SQRT( (X(1) * X(1)) + (X(2) * X(2)) )
  45 :         ELSE IF( IDIMC .EQ. 3 )THEN
  46 :            TAILLE = SQRT((X(1)*X(1)) + (X(2)*X(2)) + (X(3)*X(3)))
  47 :         ELSE 
  48 :           iarr = -1 
  49 :         ENDIF 
  50 : C
  51 : C     CAS DU TRIANGLE (2D, 3D)
  52 : C
  53 :       ELSE IF( N.EQ.3 ) THEN 
  54 :         IF( IDIMC .EQ. 2 )THEN 
  55 :           TAILLE = ((X(1) * X(4)) - (X(2) * X(3))) / 2.D0
  56 :         ELSE IF( IDIMC .EQ. 3 )THEN
  57 :           TAILLE = SQRT((VX * VX) + ( VY * VY )) / 2.D0
  58 :         ELSE 
  59 :           iarr = -1
  60 :         ENDIF
  61 : C
  62 : C     CAS DU TETRAEDRE (3D)
  63 : C
  64 :       ELSE IF( N. EQ. 4 )THEN       
  65 :         TAILLE = ((VX * X(7)) + (VY * X(8)) + (VZ * X(9))) / 6.D0
  66 :         IF( IDIMC .NE. 3 )iarr = -1
  67 :       ENDIF
  68 :       END
  69 :  
  70 :  
  71 :  
  72 :  

© Cast3M 2003 - All rights reserved.
Disclaimer