Télécharger devrco.eso

Retour à la liste

Numérotation des lignes :

devrco
  1. C DEVRCO SOURCE BP208322 20/09/18 21:15:42 10718
  2. SUBROUTINE DEVRCO(Q1,Q2,NA1,XPTB,NPLB,XPHILB,NSB,NPLSB,NA2,IDIMB,
  3. & IBASB,IPLSB,INMSB,IORSB,IND,IAROTA)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Recombinaison des deplacements aux points de choc. *
  12. * *
  13. * Param}tres: *
  14. * *
  15. * e Q1 Tableau des deplacements generalises. *
  16. * e NA1 Nombre total d'inconnues en base A. *
  17. * es XPTB Tableau des deplacements des points sur base B. *
  18. *new: et de la vitesse *
  19. * e NPLB Nombre total de points intervenant dans les liaisons. *
  20. * e XPHILB Tableau des vecteurs propres aux points de liaisons. *
  21. * e NSB Nombre de sous base. *
  22. * e NPLSB Nombre total de points intervenant dans les liaisons *
  23. * dans une sous base. *
  24. * e NA2 Nombre total d'inconnues dans une sous base. *
  25. * e IDIMB Nombre total de ddl retenus. *
  26. * e IBASB Indique dans quelle sous base appartient le point de *
  27. * liaison. *
  28. * e INMSB Indique le nombre d'inconnues de la sous base. *
  29. * e IORSB Donne l'indice du premier mode dans l'ensemble des *
  30. * modes. *
  31. * e IPLSB Dans une sous base, indique la position du point de *
  32. * liaison. *
  33. * e IND Indice du pas. *
  34. * *
  35. *--------------------------------------------------------------------*
  36. *
  37. INTEGER IBASB(*),INMSB(*),IORSB(*),IPLSB(*),IAROTA(*)
  38. REAL*8 XPHILB(NSB,NPLSB,NA2,*),Q1(NA1,*),Q2(NA1,*),XPTB(NPLB,2,*)
  39. *
  40. c boucle sur les points de la liaison
  41. DO 10 IP = 1,NPLB
  42. ISB = IBASB(IP)
  43. NA3 = INMSB(ISB)
  44. INA1 = IORSB(ISB) - 1
  45. IPLB = IPLSB(IP)
  46. IROT = IAROTA(ISB)
  47. cbp sortie de la boucle des calculs de cos et sin
  48. IF (IROT.NE.0) THEN
  49. XANGLE=Q1(IROT,IND)
  50. VITROT=Q2(IROT,IND)
  51. XCOS =COS(XANGLE)
  52. XSIN =SIN(XANGLE)
  53. XCOS1 =XCOS - 1.
  54. ENDIF
  55. c boucle sur les ddls
  56. DO 20 ID = 1,IDIMB
  57. XRET = 0.D0
  58. XRETV= 0.D0
  59. c boucle sur les modes
  60. DO 30 IN = 1,NA3
  61. INN = INA1 + IN
  62. XRET = XRET + XPHILB(ISB,IPLB,IN,ID) * Q1(INN,IND)
  63. XRETV= XRETV+ XPHILB(ISB,IPLB,IN,ID) * Q2(INN,IND)
  64. 30 CONTINUE
  65. * Prise en compte des effets de rotation pour les corps rigides
  66. IF (IROT.NE.0) THEN
  67. cbp XANGLE=Q1(IROT,IND)
  68. * Déplacements dus à la rotation
  69. cbp XRET =XRET + XPHILB(ISB,IPLB,NA3+1,ID)* (COS(XANGLE)-1)
  70. cbp XRET =XRET + XPHILB(ISB,IPLB,NA3+2,ID)* SIN(XANGLE)
  71. XRET =XRET + XPHILB(ISB,IPLB,NA3+1,ID)*XCOS1
  72. XRET =XRET + XPHILB(ISB,IPLB,NA3+2,ID)*XSIN
  73. XRETV=XRETV+VITROT*(XCOS*XPHILB(ISB,IPLB,NA3+2,ID)
  74. & -XSIN*XPHILB(ISB,IPLB,NA3+1,ID))
  75. ENDIF
  76. XPTB(IP,1,ID) = XRET
  77. XPTB(IP,2,ID) = XRETV
  78. 20 CONTINUE
  79. 10 CONTINUE
  80. *
  81. END
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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