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