Télécharger dyne28.eso

Retour à la liste

Numérotation des lignes :

dyne28
  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.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. *
  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. ID5 = ID1 + 4*IDIM
  39. ID6 = ID1 + 5*IDIM
  40. *
  41. * normalisation de la normale
  42. *
  43. IPNO = (IDIM + 1) * (INOR - 1)
  44. IPSU = (IDIM + 1) * (ISUP - 1)
  45. PS = 0.D0
  46. DO 10 ID = 1,IDIM
  47. XC = XCOOR(IPNO + ID)
  48. PS = PS + XC * XC
  49. XPALB(I,ID1+ID) = XCOOR(IPSU + ID)
  50. 10 CONTINUE
  51. * end do
  52. IF (PS.LE.ZERO) THEN
  53. CALL ERREUR(162)
  54. RETURN
  55. ENDIF
  56. PS = SQRT(PS)
  57. DO 12 ID = 1,IDIM
  58. XPALB(I,ID5+ID) = XCOOR(IPNO + ID) / PS
  59. 12 CONTINUE
  60. * end do
  61. *
  62. * Le premier vecteur orthonorm{ est form{ par le premier {l{ment
  63. PS = ZERO
  64. ID61 = ID6 + IDIM
  65. DO 14 ID = 1,IDIM
  66. XPALB(I,ID2+ID) = XPALB(I,ID6+ID)
  67. XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
  68. PS = PS + XXX * XXX
  69. 14 CONTINUE
  70. * end do
  71. IF (PS.LE.ZERO) THEN
  72. CALL ERREUR(162)
  73. RETURN
  74. ENDIF
  75. PS = SQRT(PS)
  76. DO 16 ID = 1,IDIM
  77. XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
  78. XPALB(I,ID3+ID) = XXX / PS
  79. 16 CONTINUE
  80. * end do
  81. *
  82. * Le second vecteur orthonorm{ est form{ par le produit vectoriel
  83. XPALB(I,ID4+1) = XPALB(I,ID5+2)*XPALB(I,ID3+3) -
  84. & XPALB(I,ID5+3)*XPALB(I,ID3+2)
  85. XPALB(I,ID4+2) = XPALB(I,ID5+3)*XPALB(I,ID3+1) -
  86. & XPALB(I,ID5+1)*XPALB(I,ID3+3)
  87. XPALB(I,ID4+3) = XPALB(I,ID5+1)*XPALB(I,ID3+2) -
  88. & XPALB(I,ID5+2)*XPALB(I,ID3+1)
  89. *
  90. END
  91.  
  92.  

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