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

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