Télécharger @circons.procedur

Retour à la liste

Numérotation des lignes :

  1. * @CIRCONS PROCEDUR PASCAL 12/10/18 21:15:01 7532
  2. *---------------------------------------------------------------------*
  3. * NOM : @CIRCONS *
  4. * *
  5. * DESCRIPTION : Procedure calculant le centre et le rayon du cercle *
  6. * (sphere) circonscrit(e) a un element de type TRI3 *
  7. * (TET4) en 2D (3D). *
  8. * *
  9. * SYNTAXE : PT1 R1 = @CIRCONS ELT1 ; *
  10. * *
  11. * - ELT1 = MAILLAGE, 1 element de type TRI3 ou TET4 ; *
  12. * - PT1 = POINT, centre du cercle (sphere) circonscrit(e) ; *
  13. * - R1 = FLOTTANT, rayon du cercle (sphere) circonscrit(e) ; *
  14. * *
  15. * LANGAGE : GIBIANE-CAST3M *
  16. * AUTEUR : S. PASCAL (CEA/DEN/DM2S/SEMT/LM2S) *
  17. * COURRIEL : serge.pascal@cea.fr *
  18. *---------------------------------------------------------------------*
  19. * VERSION : v1, 22/09/2006, version initiale *
  20. * HISTORIQUE : v1, 22/09/2006, creation *
  21. * HISTORIQUE : *
  22. * HISTORIQUE : *
  23. *---------------------------------------------------------------------*
  24. * Priere de PRENDRE LE TEMPS de completer les commentaires *
  25. * en cas de modification de ce sous-programme afin de faciliter *
  26. * la maintenance ! *
  27. *---------------------------------------------------------------------*
  28. 'DEBP' @CIRCONS ;
  29. 'ARGU' ELT1*'MAILLAGE' ;
  30. ELT1 = 'CHAN' 'POI1' ELT1 ;
  31. DIM1 = 'VALE' 'DIME' ;
  32. 'SI' (DIM1 'EGA' 2) ;
  33. PT1 = ELT1 'POIN' 1 ;
  34. PT2 = ELT1 'POIN' 2 ;
  35. PT3 = ELT1 'POIN' 3 ;
  36. VP1 = PT2 'MOIN' PT3 ;
  37. VP2 = PT1 'MOIN' PT3 ;
  38. DET1 = 'PMIX' VP1 VP2 ;
  39. 'SI' (('ABS' DET1) '<' 1.E-8) ;
  40. VP3 = PT2 'MOIN' PT1 ;
  41. DET1 = 'PMIX' VP2 VP3 ;
  42. 'SI' (('ABS' DET1) '<' 1.E-8) ;
  43. DET1 = 'PMIX' VP3 VP1 ;
  44. PTX = PT1 ;
  45. PT1 = PT3 ;
  46. PT3 = PT2 ;
  47. PT2 = PTX ;
  48. VP2 = VP1 ;
  49. VP1 = VP3 ;
  50. 'SINO' ;
  51. PTX = PT1 ;
  52. PT1 = PT2 ;
  53. PT2 = PT3 ;
  54. PT3 = PTX ;
  55. VP1 = VP2 ;
  56. VP2 = VP3 ;
  57. 'FINS' ;
  58. 'FINS' ;
  59. PM1 = 0.5 * (PT3 'PLUS' PT2) ;
  60. PM2 = 0.5 * (PT1 'PLUS' PT3) ;
  61. XN1M1 = 'PSCA' VP1 PM1 ;
  62. YN2M2 = 'PSCA' VP2 PM2 ;
  63. XCELT1 = ((VP2 'COOR' 2) * XN1M1) - ((VP1 'COOR' 2) * YN2M2) ;
  64. YCELT1 = ((VP1 'COOR' 1) * YN2M2) - ((VP2 'COOR' 1) * XN1M1) ;
  65. CELT1 = XCELT1 YCELT1 ;
  66. CELT1 = CELT1 / DET1 ;
  67. RELT1 = 'NORM' (PT1 'MOIN' CELT1) ;
  68. 'SINO' ;
  69. 'SI' (DIM1 'EGA' 3) ;
  70. PT1 = ELT1 'POIN' 1 ;
  71. PT2 = ELT1 'POIN' 2 ;
  72. PT3 = ELT1 'POIN' 3 ;
  73. PT4 = ELT1 'POIN' 4 ;
  74. P4MP1 = PT4 'MOIN' PT1 ;
  75. P4MP2 = PT4 'MOIN' PT2 ;
  76. P4MP3 = PT4 'MOIN' PT3 ;
  77. A11 = P4MP1 'COOR' 1 ;
  78. A21 = P4MP2 'COOR' 1 ;
  79. A31 = P4MP3 'COOR' 1 ;
  80. A12 = P4MP1 'COOR' 2 ;
  81. A22 = P4MP2 'COOR' 2 ;
  82. A32 = P4MP3 'COOR' 2 ;
  83. A13 = P4MP1 'COOR' 3 ;
  84. A23 = P4MP2 'COOR' 3 ;
  85. A33 = P4MP3 'COOR' 3 ;
  86. W1 = (A22 * A33) - (A32 * A23) ;
  87. W2 = (A31 * A23) - (A21 * A33) ;
  88. W3 = (A21 * A32) - (A31 * A22) ;
  89. FF1 = 0.5 / ((A11 * W1) + (A12 * W2) + (A13 * W3)) ;
  90. B11 = W1 ;
  91. B21 = W2 ;
  92. B31 = W3 ;
  93. B12 = (A32 * A13) - (A12 * A33) ;
  94. B22 = (A11 * A33) - (A31 * A13) ;
  95. B32 = (A31 * A12) - (A11 * A32) ;
  96. B13 = (A12 * A23) - (A22 * A13) ;
  97. B23 = (A21 * A13) - (A11 * A23) ;
  98. B33 = (A11 * A22) - (A21 * A12) ;
  99. N2PT1 = ('NORM' PT1) ** 2 ;
  100. N2PT2 = ('NORM' PT2) ** 2 ;
  101. N2PT3 = ('NORM' PT3) ** 2 ;
  102. N2PT4 = ('NORM' PT4) ** 2 ;
  103. FX1 = N2PT4 - N2PT1 ;
  104. FY1 = N2PT4 - N2PT2 ;
  105. FZ1 = N2PT4 - N2PT3 ;
  106. CELT1 = ((B11 * FX1) + (B12 * FY1) + (B13 * FZ1))
  107. ((B21 * FX1) + (B22 * FY1) + (B23 * FZ1))
  108. ((B31 * FX1) + (B32 * FY1) + (B33 * FZ1)) ;
  109. CELT1 = FF1 * CELT1 ;
  110. RELT1 = 'NORM' (PT1 'MOIN' CELT1) ;
  111. 'FINS' ;
  112. 'FINS' ;
  113. 'RESP' CELT1 RELT1 ;
  114. 'FINP' ;
  115. *---------------------------------------------------------------------*
  116. * FIN PROCEDURE @CIRCONS
  117.  

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