Télécharger dyne28.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE28 SOURCE CHAT 05/01/12 23:16:40 5004
  2. SUBROUTINE DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
  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. * Cr{ation d'un rep}re orthonorm{ dans un plan. *
  11. * *
  12. * Param}tres: *
  13. * *
  14. * e INOR vecteur perpendiculaire aux profils *
  15. * e ISUP point support *
  16. * es XPALB tableau de description des liaisons sur base B *
  17. * e NLIAB nombre total de liaisons sur base B *
  18. * e I num{ro de la liaison trait{e *
  19. * e ID1 indice de tableau *
  20. * *
  21. * *
  22. * Auteur, date de cr{ation: *
  23. * *
  24. * Lionel VIVAN, le 1 f{vrier 1991. *
  25. * *
  26. *--------------------------------------------------------------------*
  27. -INC CCOPTIO
  28. -INC SMCOORD
  29. *
  30. REAL*8 XPALB(NLIAB,*)
  31. PARAMETER ( ZERO = 0.D0 )
  32. *
  33. ID2 = ID1 + IDIM
  34. ID3 = ID1 + 2*IDIM
  35. ID4 = ID1 + 3*IDIM
  36. ID5 = ID1 + 4*IDIM
  37. ID6 = ID1 + 5*IDIM
  38. *
  39. * normalisation de la normale
  40. *
  41. IPNO = (IDIM + 1) * (INOR - 1)
  42. IPSU = (IDIM + 1) * (ISUP - 1)
  43. PS = 0.D0
  44. DO 10 ID = 1,IDIM
  45. XC = XCOOR(IPNO + ID)
  46. PS = PS + XC * XC
  47. XPALB(I,ID1+ID) = XCOOR(IPSU + ID)
  48. 10 CONTINUE
  49. * end do
  50. IF (PS.LE.ZERO) THEN
  51. CALL ERREUR(162)
  52. RETURN
  53. ENDIF
  54. PS = SQRT(PS)
  55. DO 12 ID = 1,IDIM
  56. XPALB(I,ID5+ID) = XCOOR(IPNO + ID) / PS
  57. 12 CONTINUE
  58. * end do
  59. *
  60. * Le premier vecteur orthonorm{ est form{ par le premier {l{ment
  61. PS = ZERO
  62. ID61 = ID6 + IDIM
  63. DO 14 ID = 1,IDIM
  64. XPALB(I,ID2+ID) = XPALB(I,ID6+ID)
  65. XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
  66. PS = PS + XXX * XXX
  67. 14 CONTINUE
  68. * end do
  69. IF (PS.LE.ZERO) THEN
  70. CALL ERREUR(162)
  71. RETURN
  72. ENDIF
  73. PS = SQRT(PS)
  74. DO 16 ID = 1,IDIM
  75. XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
  76. XPALB(I,ID3+ID) = XXX / PS
  77. 16 CONTINUE
  78. * end do
  79. *
  80. * Le second vecteur orthonorm{ est form{ par le produit vectoriel
  81. XPALB(I,ID4+1) = XPALB(I,ID5+2)*XPALB(I,ID3+3) -
  82. & XPALB(I,ID5+3)*XPALB(I,ID3+2)
  83. XPALB(I,ID4+2) = XPALB(I,ID5+3)*XPALB(I,ID3+1) -
  84. & XPALB(I,ID5+1)*XPALB(I,ID3+3)
  85. XPALB(I,ID4+3) = XPALB(I,ID5+1)*XPALB(I,ID3+2) -
  86. & XPALB(I,ID5+2)*XPALB(I,ID3+1)
  87. *
  88. END
  89.  
  90.  

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