Télécharger longca.eso

Retour à la liste

Numérotation des lignes :

  1. C LONGCA SOURCE BP208322 16/11/18 21:19:00 9177
  2. SUBROUTINE LONGCA(IPMAIL,IB,LCAR)
  3. C
  4. C Declaration de variables
  5. C
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C
  9. REAL*8 LCAR
  10. C
  11. C Insertion des includes
  12. C Remarque : le segment MCOORD est toujours actif
  13. C
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16. -INC SMCOORD
  17. -INC SMELEME
  18. C
  19. IDIMP1 = IDIM+1
  20. C---------------------------------------------------------------------
  21. C ************************************************************
  22. C * CALCUL DE LA LONGUEUR CARACTERISTIQUE D'un ELEMENT *
  23. C ************************************************************
  24. C---------------------------------------------------------------------
  25. C
  26. MELEME = IPMAIL
  27. ****** SEGACT MELEME
  28. C
  29. C Adresse de la description des faces dans LDEL
  30. C
  31. IAD=LTEL(2,ITYPEL)
  32. C
  33. C Type de la face de l'élément courant
  34. C
  35. ITYP=LDEL(1,IAD)
  36. C
  37. C Nombre de point de la face
  38. C
  39. NPFAC=KDFAC(1,ITYP)
  40. C
  41. C Adresse de la face dans LFAC
  42. C
  43. JAD=LDEL(2,IAD)-1
  44. C
  45. C Adresse de description des triangles dans KFAC
  46. C
  47. IDEP=KDFAC(2,ITYP)
  48. C
  49. C Initialisation
  50. C
  51. ABC = 0.
  52. C
  53. C Boucle sur les triangles
  54. C
  55. IFEP=IDEP+3*(KDFAC(3,ITYP)-1)
  56. C
  57. DO 242 ITRIAN=IDEP,IFEP,3
  58. C
  59. C Extraction des trois noeuds du triangle courant
  60. C
  61. IAFA=LFAC(JAD+KFAC(ITRIAN))
  62. IBFA=LFAC(JAD+KFAC(ITRIAN+1))
  63. ICFA=LFAC(JAD+KFAC(ITRIAN+2))
  64. C
  65. C Numéro des trois noeuds dans le meleme / Position dans le MCOORD
  66. C
  67. NA = IDIMP1 * (NUM(IAFA,IB)-1)
  68. NB = IDIMP1 * (NUM(IBFA,IB)-1)
  69. NC = IDIMP1 * (NUM(ICFA,IB)-1)
  70. C
  71. C Recherche des coordonées du point B et des vecteurs BA et BC
  72. C
  73. XB=XCOOR(NB+1)
  74. YB=XCOOR(NB+2)
  75. ZB=XCOOR(NB+3)
  76.  
  77. IF (IDIM.EQ.2) ZB=0.
  78.  
  79. XBA=XCOOR(NA+1)-XB
  80. YBA=XCOOR(NA+2)-YB
  81. ZBA=XCOOR(NA+3)-ZB
  82.  
  83. IF (IDIM.EQ.2) ZBA=0.
  84.  
  85. XBC=XCOOR(NC+1)-XB
  86. YBC=XCOOR(NC+2)-YB
  87. ZBC=XCOOR(NC+3)-ZB
  88.  
  89. IF (IDIM.EQ.2) ZBC=0.
  90. C
  91. C Calcul du produit vectoriel des vecteurs BA et BC
  92. C
  93. XV=YBA*ZBC-ZBA*YBC
  94. YV=ZBA*XBC-XBA*ZBC
  95. ZV=XBA*YBC-YBA*XBC
  96. C
  97. C Calcul de l'aire du triangle (norme du produit vectoriel divisée par 2)
  98. C Nota : La division par 2 est effectuee une seule fois en sortie de boucle
  99.  
  100. C* XS=XV/2
  101. C* YS=YV/2
  102. C* ZS=ZV/2
  103. C* ABC=ABC+SQRT(XS*XS+YS*YS+ZS*ZS)
  104.  
  105. ABC = ABC+SQRT(XV*XV+YV*YV+ZV*ZV)
  106.  
  107. 242 CONTINUE
  108. C
  109. C Mise en facteur du 1/2 de l'aire de chaque triangle
  110. ABC = 0.5D0 * ABC
  111. C
  112. C Calcul de la longueur caractéristique (d'après FEENSTRA, 1994)
  113. C
  114. IF (KDEGRE(ITYPEL).EQ.2) THEN
  115. C* ALPHA=1.
  116. LCAR = SQRT(ABC)
  117. ELSE
  118. C* ALPHA=SQRT(2.)
  119. LCAR=SQRT(2.D0*ABC)
  120. ENDIF
  121. C* LCAR=ALPHA*SQRT(ABC)
  122. C
  123. C Desactivation du segment MELEME
  124. C
  125. ****** SEGDES MELEME
  126.  
  127. RETURN
  128. END
  129.  
  130.  
  131.  
  132.  
  133.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales