Télécharger la plaquette Cast3M


fr en

Télécharger longca.eso

Retour à la liste

Numérotation des lignes : 

longca

  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