Télécharger dyne29.eso

Retour à la liste

Numérotation des lignes :

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

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