Télécharger dyne35.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE35 SOURCE CHAT 05/01/12 23:17:35 5004
  2. SUBROUTINE DYNE35(IPOIN1,IPOIN2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB,
  3. & IPALB,XPTB,NLIAB,NPLB,I,NPOI,ID1,IND,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 IPOIN1 point du profil mobile *
  17. * e IPOIN2 point du profil mobile *
  18. * e XBARY coordonn{e du barycentre *
  19. * e YBARY coordonn{e du barycentre *
  20. * e I num{ro de la liaison trait{e *
  21. * e XP,YP coordonn{es du point P d'intersection *
  22. * e XPP,YPP coordonn{es du point PP d'intersection *
  23. * e NLIAB nombre total de liaisons *
  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 XPTB(NPLB,4,*),XPALB(NLIAB,*)
  34. PARAMETER ( ZERO = 0.D0 )
  35. *
  36. IDIM = IPALB(I,3)
  37. NOMBN1 = IPALB(I,4)
  38. NOMBN2 = IPALB(I,5)
  39. ID2 = ID1 + IDIM
  40. ID3 = ID1 + 2*IDIM
  41. ID4 = ID1 + 3*IDIM
  42. ID6 = ID1 + 5*IDIM
  43. ID7 = ID6 + IDIM*NOMBN1
  44. IPT1 = ID7 + IDIM*(IPOIN1-1)
  45. IPT2 = ID7 + IDIM*(IPOIN2-1)
  46. *
  47. SOMAIR = ZERO
  48. XP1 = ZERO
  49. YP1 = ZERO
  50. XP2 = ZERO
  51. YP2 = ZERO
  52. DO 12 ID = 1,IDIM
  53. XX1 = XPTB(NPOI,IND,ID) + XPALB(I,IPT1+ID)
  54. & - XPALB(I,ID2+ID)
  55. XX2 = XPTB(NPOI,IND,ID) + XPALB(I,IPT2+ID)
  56. & - XPALB(I,ID2+ID)
  57. XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  58. YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  59. XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
  60. YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
  61. 12 CONTINUE
  62. * end do
  63. XPPP2 = XP2 - XPP
  64. YPPP2 = YP2 - YPP
  65. DA = SQRT( (XPPP2 ** 2) + (YPPP2 ** 2) )
  66. XP2G = XBARY - XP2
  67. YP2G = YBARY - YP2
  68. DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
  69. XGPP = XPP - XBARY
  70. YGPP = YPP - YBARY
  71. DC = SQRT( (XGPP ** 2) + (YGPP ** 2) )
  72. PERI = 0.5 * ( DA + DB + DC )
  73. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  74. SOMAIR = SOMAIR + SQRT(SURF)
  75. XP1P = XP - XP1
  76. YP1P = YP - YP1
  77. DA = SQRT( (XP1P ** 2) + (YP1P ** 2 ) )
  78. XPG = XBARY - XP
  79. YPG = YBARY - YP
  80. DB = SQRT( (XPG ** 2) + (YPG ** 2) )
  81. XGP1 = XP1 - XBARY
  82. YGP1 = YP1 - YBARY
  83. DC = SQRT( (XGP1 ** 2) + (YGP1 ** 2) )
  84. PERI = 0.5 * ( DA + DB + DC )
  85. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  86. SOMAIR = SOMAIR + SQRT(SURF)
  87. NBSURF = 0
  88. IF (IPOIN1.GT.IPOIN2 ) THEN
  89. ICAS = 1
  90. NBSURF = 1
  91. I2 = IPOIN1
  92. 2 CONTINUE
  93. I2 = I2 - 1
  94. IF (I2.EQ.0) I2 = NOMBN2
  95. IF (I2.EQ.IPOIN2) GOTO 4
  96. NBSURF = NBSURF + 1
  97. GOTO 2
  98. 4 CONTINUE
  99. ELSE IF (IPOIN1.LT.IPOIN2 ) THEN
  100. ICAS = 2
  101. NBSURF = 1
  102. I6 = IPOIN2
  103. 6 CONTINUE
  104. I6 = I6 + 1
  105. IF (I6.EQ.(NOMBN2+1)) I6 = 1
  106. IF (I6.EQ.IPOIN1) GOTO 8
  107. NBSURF = NBSURF + 1
  108. GOTO 6
  109. 8 CONTINUE
  110. ENDIF
  111. IF (NBSURF.NE.0) THEN
  112. IF (ICAS.EQ.1) THEN
  113. NUM1 = IPOIN1
  114. ELSE
  115. NUM1 = IPOIN2
  116. ENDIF
  117. DO 14 IS = 1,NBSURF
  118. IF (ICAS.EQ.1) THEN
  119. NUM2 = NUM1 - 1
  120. IF (NUM2.EQ.0) NUM2 = NOMBN2
  121. ELSE
  122. NUM2 = NUM1 + 1
  123. IF (NUM2.EQ.(NOMBN2+1)) NUM2 = 1
  124. ENDIF
  125. IPT1 = ID7 + IDIM*(NUM1-1)
  126. IPT2 = ID7 + IDIM*(NUM2-1)
  127. XP1 = ZERO
  128. YP1 = ZERO
  129. XP2 = ZERO
  130. YP2 = ZERO
  131. DO 16 ID = 1,IDIM
  132. XX1 = XPTB(NPOI,IND,ID) + XPALB(I,IPT1+ID)
  133. & - XPALB(I,ID2+ID)
  134. XX2 = XPTB(NPOI,IND,ID) + XPALB(I,IPT2+ID)
  135. & - XPALB(I,ID2+ID)
  136. XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  137. YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  138. XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
  139. YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
  140. 16 CONTINUE
  141. * end do
  142. XP2P1 = XP1 - XP2
  143. YP2P1 = YP1 - YP2
  144. DA = SQRT( (XP2P1 ** 2) + (YP2P1 ** 2 ) )
  145. XP1G = XBARY - XP1
  146. YP1G = YBARY - YP1
  147. DB = SQRT( (XP1G ** 2) + (YP1G ** 2) )
  148. XGP2 = XP2 - XBARY
  149. YGP2 = YP2 - YBARY
  150. DC = SQRT( (XGP2 ** 2) + (YGP2 ** 2) )
  151. PERI = 0.5 * ( DA + DB + DC )
  152. SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
  153. SOMAIR = SOMAIR + SQRT(SURF)
  154. NUM1 = NUM2
  155. 14 CONTINUE
  156. * end do
  157. ENDIF
  158. *
  159. END
  160.  
  161.  

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