Télécharger dyne34.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE34 SOURCE CHAT 05/01/12 23:17:29 5004
  2. SUBROUTINE DYNE34(IPOIN1,IPOIN2,NUMEL1,NUMEL2,XP,YP,XPP,YPP,
  3. & XPALB,IPALB,XPTB,NLIAB,NPLB,I,NPOI,ID1,IP1,IND,
  4. & XBARY,YBARY)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. * *
  9. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * calcule les coordonn{es du barycentre form{ par les points *
  13. * IPOIN1, IPOIN2, P, PP, NUMEL1 et NUMEL2. *
  14. * *
  15. * Param}tres: *
  16. * *
  17. * e IPOIN1 point du profil mobile *
  18. * e IPOIN2 point du profil mobile *
  19. * e NUMEL1 {l{ment du profil fixe *
  20. * e NUMEL2 {l{ment du profil fixe *
  21. * e I num{ro de la liaison trait{e *
  22. * e XP,YP coordonn{es du point P d'intersection *
  23. * e XPP,YPP coordonn{es du point PP d'intersection *
  24. * e NLIAB nombre total de liaisons *
  25. * s XBARY coordonn{e suivant X *
  26. * s YBARY coordonn{e suivant Y *
  27. * *
  28. * Auteur, date de cr{ation: *
  29. * *
  30. * Lionel VIVAN, le 1 f{vrier 1991. *
  31. * *
  32. *--------------------------------------------------------------------*
  33. *
  34. INTEGER IPALB(NLIAB,*)
  35. REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
  36. PARAMETER ( ZERO = 0.D0 )
  37. *
  38. ITYP = IPALB(I,1)
  39. IDIM = IPALB(I,3)
  40. NOMBN1 = IPALB(I,4)
  41. NOMBN2 = IPALB(I,5)
  42. ID2 = ID1 + IDIM
  43. ID3 = ID1 + 2*IDIM
  44. ID4 = ID1 + 3*IDIM
  45. ID6 = ID1 + 5*IDIM
  46. ID7 = ID6 + IDIM*NOMBN1
  47. *
  48. XBARY = XP + XPP
  49. YBARY = YP + YPP
  50. ICAS = 0
  51. IF (IPOIN1.EQ.IPOIN2 ) THEN
  52. NBPOIN = 1
  53. ELSE IF (IPOIN1.GT.IPOIN2 ) THEN
  54. ICAS = 1
  55. NBPOIN = 2
  56. I2 = IPOIN1
  57. 2 CONTINUE
  58. I2 = I2 - 1
  59. IF (I2.EQ.0) I2 = NOMBN2
  60. IF (I2.EQ.IPOIN2) GOTO 4
  61. NBPOIN = NBPOIN + 1
  62. GOTO 2
  63. 4 CONTINUE
  64. ELSE
  65. ICAS = 2
  66. NBPOIN = 2
  67. I6 = IPOIN2
  68. 6 CONTINUE
  69. I6 = I6 + 1
  70. IF (I6.EQ.(NOMBN2+1)) I6 = 1
  71. IF (I6.EQ.IPOIN1) GOTO 8
  72. NBPOIN = NBPOIN + 1
  73. GOTO 6
  74. 8 CONTINUE
  75. ENDIF
  76. IF (ICAS.EQ.1) THEN
  77. IPT1 = IPOIN1
  78. ELSE
  79. IPT1 = IPOIN2
  80. ENDIF
  81. DO 10 IP = 1,NBPOIN
  82. IF (IPT1.EQ.(NOMBN2+1)) IPT1 = 1
  83. IF (IPT1.EQ.0) IPT1 = NOMBN2
  84. IPT2 = ID7 + IDIM*(IPT1-1)
  85. XP1 = ZERO
  86. YP1 = ZERO
  87. DO 12 ID = 1,IDIM
  88. XX1 = XPTB(NPOI,IND,ID) + XPALB(I,IPT2+ID)
  89. & - XPALB(I,ID2+ID)
  90. XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
  91. YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
  92. 12 CONTINUE
  93. * end do
  94. XBARY = XBARY + XP1
  95. YBARY = YBARY + YP1
  96. IF (ICAS.EQ.1) THEN
  97. IPT1 = IPT1 - 1
  98. ELSE
  99. IPT1 = IPT1 + 1
  100. ENDIF
  101. 10 CONTINUE
  102. * end do
  103. NBPOI2 = 0
  104. IF (NUMEL1.NE.NUMEL2) THEN
  105. NBPOI2 = 1
  106. IF (ITYP.EQ.31) THEN
  107. * les num{ros d'{l{ments croissent
  108. I6 = NUMEL1
  109. 40 CONTINUE
  110. I6 = I6 + 1
  111. IF (I6.EQ.(NOMBN1+1)) I6 = 1
  112. IF (I6.EQ.NUMEL2) GOTO 42
  113. NBPOI2 = NBPOI2 + 1
  114. GOTO 40
  115. 42 CONTINUE
  116. ELSE
  117. * les num{ros d'{l{ments d{croissent
  118. I2 = NUMEL1
  119. 30 CONTINUE
  120. I2 = I2 - 1
  121. IF (I2.EQ.0) I2 = NOMBN1
  122. IF (I2.EQ.NUMEL2) GOTO 32
  123. NBPOI2 = NBPOI2 + 1
  124. GOTO 30
  125. 32 CONTINUE
  126. ENDIF
  127. IE1 = NUMEL1
  128. DO 20 IE = 1,NBPOI2
  129. IF (ITYP.EQ.31) THEN
  130. * les num{ros d'{l{ments croissent
  131. IE1 = IE1 + 1
  132. IF (IE1.EQ.(NOMBN1+1)) IE1 = 1
  133. IE2 = ID6 + IDIM*(IE1-1)
  134. ELSE
  135. * les num{ros d'{l{ments d{croissent
  136. IE2 = ID6 + IDIM*(IE1-1)
  137. IE1 = IE1 - 1
  138. IF (IE1.EQ.0) IE1 = NOMBN1
  139. ENDIF
  140. XE1 = ZERO
  141. YE1 = ZERO
  142. DO 22 ID = 1,IDIM
  143. XX1 = XPALB(I,IE2+ID) - XPALB(I,ID2+ID)
  144. XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
  145. YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
  146. 22 CONTINUE
  147. * end do
  148. XBARY = XBARY + XE1
  149. YBARY = YBARY + YE1
  150. 20 CONTINUE
  151. * end do
  152. ENDIF
  153. NBPOIT = 2 + NBPOIN + NBPOI2
  154. XBARY = XBARY / NBPOIT
  155. YBARY = YBARY / NBPOIT
  156. *
  157. END
  158.  
  159.  

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