Télécharger dyne33.eso

Retour à la liste

Numérotation des lignes :

dyne33
  1. C DYNE33 SOURCE CHAT 05/01/12 23:17:23 5004
  2. SUBROUTINE DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Calcule la section du profil mobile *
  11. * *
  12. * Param}tres: *
  13. * *
  14. * e XPALB tableau de description des liaisons sur base B *
  15. * e IPALB tableau de description des liaisons sur base B *
  16. * e NLIAB nombre total de liaisons *
  17. * s XSECT section *
  18. * *
  19. * *
  20. * Auteur, date de cr{ation: *
  21. * *
  22. * Lionel VIVAN, le 1 f{vrier 1991. *
  23. * *
  24. *--------------------------------------------------------------------*
  25. *
  26. INTEGER IPALB(NLIAB,*)
  27. REAL*8 XPALB(NLIAB,*)
  28. PARAMETER ( ZERO = 0.D0 )
  29. *
  30. IDIM = IPALB(I,3)
  31. NOMBN1 = IPALB(I,4)
  32. NOMBN2 = IPALB(I,5)
  33. ID2 = ID1 + IDIM
  34. ID3 = ID1 + 2*IDIM
  35. ID4 = ID1 + 3*IDIM
  36. ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
  37. * calcul du barycentre du profil mobile
  38. XBARY = ZERO
  39. YBARY = ZERO
  40. IPT1 = ID7
  41. DO 8 IN = 1,NOMBN2
  42. XP1 = ZERO
  43. YP1 = ZERO
  44. DO 10 ID = 1,IDIM
  45. XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
  46. XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  47. YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  48. 10 CONTINUE
  49. * end do
  50. IPT1 = IPT1 + IDIM
  51. XBARY = XBARY + XP1
  52. YBARY = YBARY + YP1
  53. 8 CONTINUE
  54. * end do
  55. XBARY = XBARY / NOMBN2
  56. YBARY = YBARY / NOMBN2
  57. *
  58. XSECT = ZERO
  59. IPT1 = ID7
  60. IPT2 = ID7 + IDIM
  61. DO 12 IS = 1,NOMBN2
  62. IF (IS.EQ.NOMBN2) IPT2 = ID7
  63. * calcul des coordonn{es dans le plan d{fini par les profils
  64. XP1 = ZERO
  65. YP1 = ZERO
  66. XP2 = ZERO
  67. YP2 = ZERO
  68. DO 14 ID = 1,IDIM
  69. XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
  70. XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
  71. XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  72. YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  73. XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
  74. YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
  75. 14 CONTINUE
  76. * end do
  77. XP1P2 = XP2 - XP1
  78. YP1P2 = YP2 - YP1
  79. DA = SQRT( (XP1P2 ** 2) + (YP1P2 ** 2 ) )
  80. XP2G = XBARY - XP2
  81. YP2G = YBARY - YP2
  82. DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
  83. XGP1 = XP1 - XBARY
  84. YGP1 = YP1 - YBARY
  85. DC = SQRT( (XGP1 ** 2) + (YGP1 ** 2) )
  86. PERI = 0.5 * ( DA + DB + DC )
  87. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  88. XSECT = XSECT + SQRT(SURF)
  89. *
  90. IPT1 = IPT2
  91. IPT2 = IPT2 + IDIM
  92. 12 CONTINUE
  93. * end do
  94. *
  95. END
  96.  
  97.  

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