Télécharger dyne30.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE30 SOURCE CHAT 05/01/12 23:17:07 5004
  2. SUBROUTINE DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  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. * Position initiale du profil mobile par rapport au profil fixe *
  11. * *
  12. * Param}tres: *
  13. * *
  14. * es IPALB tableau de description des liaisons sur base B *
  15. * es XPALB tableau de description des liaisons sur base B *
  16. * e NLIAB nombre total de liaisons sur base B *
  17. * e NOMBN1 nombre de points du profil fixe *
  18. * e NOMBN2 nombre de points du profil mobile *
  19. * e I num{ro de liaison trait{e *
  20. * e ID1 indice de tableau pour XPALB *
  21. * e IP1 indice de tableau pour IPALB *
  22. * *
  23. * *
  24. * Auteur, date de cr{ation: *
  25. * *
  26. * Lionel VIVAN, le 1 f{vrier 1991. *
  27. * *
  28. *--------------------------------------------------------------------*
  29. -INC CCOPTIO
  30. *
  31. INTEGER IPALB(NLIAB,*)
  32. REAL*8 XPALB(NLIAB,*)
  33. PARAMETER ( ZERO = 0.D0 )
  34. *
  35. ID2 = ID1 + IDIM
  36. ID3 = ID1 + 2*IDIM
  37. ID4 = ID1 + 3*IDIM
  38. ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
  39. ID8 = ID7 + IDIM*NOMBN2
  40. NUM1 = ID7
  41. IEL2 = IP1 + NOMBN1
  42. DO 10 IN = 1,NOMBN2
  43. * calcul des coordonn{es dans le plan d{fini par les profils
  44. X1 = ZERO
  45. Y1 = ZERO
  46. DO 12 ID = 1,IDIM
  47. XX = XPALB(I,NUM1+ID) - XPALB(I,ID2+ID)
  48. X1 = X1 + ( XX * XPALB(I,ID3+ID) )
  49. Y1 = Y1 + ( XX * XPALB(I,ID4+ID) )
  50. 12 CONTINUE
  51. * end do
  52. NUM2 = ID8
  53. DO 14 IE = 1,NOMBN1
  54. ITYP = IPALB(I,IP1+IE)
  55. XAIJ = XPALB(I,NUM2+1)
  56. XBIJ = XPALB(I,NUM2+2)
  57. IF (ITYP.EQ.1) THEN
  58. * La droite est verticale
  59. IF (X1.GT.XAIJ) THEN
  60. IPALB(I,IEL2+IE) = 1
  61. ELSE IF (X1.LT.XAIJ) THEN
  62. IPALB(I,IEL2+IE) = -1
  63. ELSE
  64. IPALB(I,IEL2+IE) = 0
  65. ENDIF
  66. ELSE IF (ITYP.EQ.2) THEN
  67. * La droite est horizontale
  68. IF (Y1.GT.XBIJ) THEN
  69. IPALB(I,IEL2+IE) = 1
  70. ELSE IF (Y1.LT.XBIJ) THEN
  71. IPALB(I,IEL2+IE) = -1
  72. ELSE
  73. IPALB(I,IEL2+IE) = 0
  74. ENDIF
  75. ELSE
  76. * La droite est quelconque
  77. RES = ( XAIJ * X1 ) + XBIJ
  78. IF (Y1.GT.RES) THEN
  79. IPALB(I,IEL2+IE) = 1
  80. ELSE IF (Y1.LT.RES) THEN
  81. IPALB(I,IEL2+IE) = -1
  82. ELSE
  83. IPALB(I,IEL2+IE) = 0
  84. ENDIF
  85. ENDIF
  86. NUM2 = NUM2 + 2
  87. 14 CONTINUE
  88. * end do
  89. IEL2 = IEL2 + NOMBN1
  90. NUM1 = NUM1 + IDIM
  91. 10 CONTINUE
  92. * end do
  93. *
  94. END
  95.  
  96.  

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