Télécharger dyne36.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE36 SOURCE CHAT 05/01/12 23:17:40 5004
  2. SUBROUTINE DYNE36(NUMEL1,NUMEL2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB,
  3. & IPALB,NLIAB,I,ID1,SOMAIR)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Calcul de l'aire de la section qui n'a pas travers{ le *
  12. * maillage fixe. *
  13. * *
  14. * Param}tres: *
  15. * *
  16. * e XBARY coordonn{e du barycentre *
  17. * e YBARY coordonn{e du barycentre *
  18. * e NUMEL1 {l{ment du profil fixe *
  19. * e NUMEL2 {l{ment du profil fixe *
  20. * e XP,YP coordonn{es du point P d'intersection *
  21. * e XPP,YPP coordonn{es du point PP d'intersection *
  22. * e NLIAB nombre total de liaisons *
  23. * e I num{ro de la liaison trait{e *
  24. * s SOMAIR aire de la section *
  25. * *
  26. * Auteur, date de cr{ation: *
  27. * *
  28. * Lionel VIVAN, le 1 f{vrier 1991. *
  29. * *
  30. *--------------------------------------------------------------------*
  31. *
  32. INTEGER IPALB(NLIAB,*)
  33. REAL*8 XPALB(NLIAB,*)
  34. PARAMETER ( ZERO = 0.D0 )
  35. *
  36. ITYP = IPALB(I,1)
  37. IDIM = IPALB(I,3)
  38. NOMBN1 = IPALB(I,4)
  39. ID2 = ID1 + IDIM
  40. ID3 = ID1 + 2*IDIM
  41. ID4 = ID1 + 3*IDIM
  42. ID6 = ID1 + 5*IDIM
  43. *
  44. SOMAIR = ZERO
  45. IF (NUMEL1.EQ.NUMEL2) THEN
  46. XPPG = XBARY - XPP
  47. YPPG = YBARY - YPP
  48. DA = SQRT( (XPPG ** 2) + (YPPG ** 2) )
  49. XGP = XP - XBARY
  50. YGP = YP - YBARY
  51. DB = SQRT( (XGP ** 2) + (YGP ** 2) )
  52. XPPP = XPP - XP
  53. YPPP = YPP - YP
  54. DC = SQRT( (XPPP ** 2) + (YPPP ** 2) )
  55. PERI = 0.5 * ( DA + DB + DC )
  56. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  57. SOMAIR = SOMAIR + SQRT(SURF)
  58. *
  59. ELSE
  60. NBELEM = 0
  61. IF (ITYP.EQ.31) THEN
  62. I2 = NUMEL1
  63. 2 CONTINUE
  64. I2 = I2 + 1
  65. IF (I2.EQ.(NOMBN1+1)) I2 = 1
  66. IF (I2.EQ.NUMEL2) GOTO 4
  67. NBELEM = NBELEM + 1
  68. GOTO 2
  69. 4 CONTINUE
  70. ELSE
  71. I6 = NUMEL1
  72. 6 CONTINUE
  73. I6 = I6 - 1
  74. IF (I6.EQ.0) I6 = NOMBN1
  75. IF (I6.EQ.NUMEL2) GOTO 8
  76. NBELEM = NBELEM + 1
  77. GOTO 6
  78. 8 CONTINUE
  79. ENDIF
  80. IF (ITYP.EQ.31) THEN
  81. IEE1 = NUMEL1 + 1
  82. IF (IEE1.EQ.(NOMBN1+1)) IEE1 = 1
  83. IE1 = ID6 + IDIM*(IEE1-1)
  84. ELSE
  85. IE1 = ID6 + IDIM*(NUMEL1-1)
  86. ENDIF
  87. XE1 = ZERO
  88. YE1 = ZERO
  89. DO 10 ID = 1,IDIM
  90. XX1 = XPALB(I,IE1+ID) - XPALB(I,ID2+ID)
  91. XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
  92. YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
  93. 10 CONTINUE
  94. * end do
  95. XPE1 = XE1 - XP
  96. YPE1 = YE1 - YP
  97. DA = SQRT( (XPE1 ** 2) + (YPE1 ** 2) )
  98. XE1G = XBARY - XE1
  99. YE1G = YBARY - YE1
  100. DB = SQRT( (XE1G ** 2) + (YE1G ** 2) )
  101. XGP = XP - XBARY
  102. YGP = YP - YBARY
  103. DC = SQRT( (XGP ** 2) + (YGP ** 2) )
  104. PERI = 0.5 * ( DA + DB + DC )
  105. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  106. SOMAIR = SOMAIR + SQRT(SURF)
  107. IF (NBELEM.NE.0) THEN
  108. IE1 = NUMEL1
  109. DO 12 IE = 1,NBELEM
  110. IF (ITYP.EQ.31) THEN
  111. IE1 = IE1 + 1
  112. IF (IE1.EQ.(NOMBN1+1)) IE1 = 1
  113. IE2 = IE1 + 1
  114. IF (IE2.EQ.(NOMBN1+1)) IE2 = 1
  115. IPT1 = ID6 + IDIM*(IE1-1)
  116. IPT2 = ID6 + IDIM*(IE2-1)
  117. ELSE
  118. IE2 =IE1 - 1
  119. IF (IE2.EQ.0) IE2 = NOMBN1
  120. IPT1 = ID6 + IDIM*(IE1-1)
  121. IPT2 = ID6 + IDIM*(IE2-1)
  122. IE1 = IE1 - 1
  123. IF (IE1.EQ.0) IE1 = NOMBN1
  124. ENDIF
  125. XE1 = ZERO
  126. YE1 = ZERO
  127. XE2 = ZERO
  128. YE2 = ZERO
  129. DO 14 ID = 1,IDIM
  130. XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
  131. XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
  132. XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
  133. YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
  134. XE2 = XE2 + ( XX2 * XPALB(I,ID3+ID) )
  135. YE2 = YE2 + ( XX2 * XPALB(I,ID4+ID) )
  136. 14 CONTINUE
  137. * end do
  138. XE1E2 = XE2 - XE1
  139. YE1E2 = YE2 - YE1
  140. DA = SQRT( (XE1E2 ** 2) + (YE1E2 ** 2) )
  141. XE2G = XBARY - XE2
  142. YE2G = YBARY - YE2
  143. DB = SQRT( (XE2G ** 2) + (YE2G ** 2) )
  144. XGE1 = XE1 - XBARY
  145. YGE1 = YE1 - YBARY
  146. DC = SQRT( (XGE1 ** 2) + (YGE1 ** 2) )
  147. PERI = 0.5 * ( DA + DB + DC )
  148. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  149. SOMAIR = SOMAIR + SQRT(SURF)
  150. 12 CONTINUE
  151. * end do
  152. XE2PP = XPP - XE2
  153. YE2PP = YPP - YE2
  154. DA = SQRT( (XE2PP ** 2) + (YE2PP ** 2) )
  155. XPPG = XBARY - XPP
  156. YPPG = YBARY - YPP
  157. DB = SQRT( (XPPG ** 2) + (YPPG ** 2) )
  158. XGE2 = XE2 - XBARY
  159. YGE2 = YE2 - YBARY
  160. DC = SQRT( (XGE2 ** 2) + (YGE2 ** 2 ) )
  161. PERI = 0.5 * ( DA + DB + DC )
  162. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  163. SOMAIR = SOMAIR + SQRT(SURF)
  164. ELSE
  165. XE1PP = XPP - XE1
  166. YE1PP = YPP - YE1
  167. DA = SQRT( (XE1PP ** 2) + (YE1PP ** 2) )
  168. XPPG = XBARY - XPP
  169. YPPG = YBARY - YPP
  170. DB = SQRT( (XPPG ** 2) + (YPPG ** 2 ) )
  171. XGE1 = XE1 - XBARY
  172. YGE1 = YE1 - YBARY
  173. DC = SQRT( (XGE1 ** 2 ) + (YGE1 ** 2) )
  174. PERI = 0.5 * ( DA + DB + DC )
  175. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  176. SOMAIR = SOMAIR + SQRT(SURF)
  177. ENDIF
  178. ENDIF
  179. *
  180. END
  181.  
  182.  

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