Télécharger d2vlf2.eso

Retour à la liste

Numérotation des lignes :

d2vlf2
  1. C D2VLF2 SOURCE BP208322 20/09/18 21:15:16 10718
  2. C DEVLF2 SOURCE LAVARENN 96/10/30 21:18:02 2349
  3.  
  4. SUBROUTINE D2VLF2(Q1,Q2,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  5. & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,PDT,T,
  6. & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,IND,
  7. & FEXPSM,NPC1,IERRD,FTEST2,XABSCI,XORDON,NIP,
  8. & IAROTA,RIGIDE,FEXB,XCHPFB,
  9. & KTOTXB,KTOTVB)
  10.  
  11. *--------------------------------------------------------------------*
  12. * *
  13. * Opérateur DYNE : algorithme differences centrees *
  14. * Initialisation des forces de choc base B *
  15. *--------------------------------------------------------------------*
  16. * *
  17. * Paramètres: *
  18. * *
  19. * e Q1(.,.) Vecteur des déplacements généralisés.
  20. * e Q2 vecteur des vitesses generalises *
  21. * es FTOTA Forces extérieures totalisées sur la base A. *
  22. * e NA1 Nombre total d'inconnues en base A. *
  23. * e IPALB Renseigne sur le type de la liaison. *
  24. * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
  25. * e IAROTA Indique la position des modes de rotation *
  26. * e XPALB Tableau contenant les paramètres de la liaison. *
  27. * es XVALB Tableau contenant les variables internes des liaisons *
  28. * e NLIAB Nombre de liaisons sur la base B. *
  29. * e XPHILB Tableau des vecteurs propres aux points de liaisons. *
  30. * e JPLIB Tableau contenant les numéros "GIBI" des liaisons. *
  31. * e NPLB Nombre total de points intervenant dans les liaisons. *
  32. * e IDIMB Nombre de directions. *
  33. * e IND Indice du pas. *
  34. * e XABSCI Tableau contenant les abscisses de la loi plastique *
  35. * pour la liaison point-point- ... -plastique *
  36. * e XORDON Tableau contenant les ordonnees de la loi plastique *
  37. * pour la liaison point-point- ... -plastique *
  38. * e RIGIDE Vrai si l'on a un corps rigide *
  39. * *
  40. * - FTEST2 Tableau local FTEST de la subroutine D2VLB1 *
  41. * *
  42. *--------------------------------------------------------------------*
  43. *
  44. IMPLICIT INTEGER(I-N)
  45. IMPLICIT REAL*8(A-H,O-Z)
  46.  
  47. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*),JPLIB(*)
  48. INTEGER IBASB(*),IPLSB(*),INMSB(*),IORSB(*),IAROTA(*)
  49. REAL*8 XPALB(NLIAB,*),Q1(NA1,*),Q2(NA1,*),FTOTA(NA1,*)
  50. REAL*8 XVALB(NLIAB,4,*),XPHILB(NSB,NPLSB,NA2,*),XPTB(NPLB,2,*)
  51. REAL*8 FTOTB(NPLB,*),FTOTBA(*),FEXPSM(NPLB,NPC1,2,*)
  52. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*)
  53. REAL*8 XCHPFB(2,NLIAB,4,NPLB)
  54. REAL*8 FTEST2(NPLB,6)
  55. LOGICAL RIGIDE
  56. REAL*8 KTOTXB(NPLB,IDIMB,IDIMB),KTOTVB(NPLB,IDIMB,IDIMB)
  57. *
  58. *--------------------------------------------------------------------*
  59. * Initialisations a 0
  60. *--------------------------------------------------------------------*
  61. *
  62. DO ID = 1,IDIMB
  63. DO IP = 1,NPLB
  64. FTOTB(IP,ID) = 0.D0
  65. ENDDO
  66. ENDDO
  67.  
  68. cbp : on n'utilise pas KTOTXB ni KTOTVB ici
  69. c IF (HBM) THEN
  70. c DO ij=1,IDIMB
  71. c DO ii=1,IDIMB
  72. c DO ip=1,NPLB
  73. c KTOTXB(ip,ii,ij)=0.D0
  74. c KTOTVB(ip,ii,ij)=0.D0
  75. c ENDDO
  76. c ENDDO
  77. c ENDDO
  78. c ENDIF
  79.  
  80. *--------------------------------------------------------------------*
  81. * Recombinaison des deplacements aux points de choc
  82. *--------------------------------------------------------------------*
  83.  
  84. IF (IDIMB.EQ.6) THEN
  85. IDIM=3
  86. ELSE
  87. IDIM=2
  88. ENDIF
  89.  
  90. *old CALL D2VCOI(Q1,Q2,PDT,NA1,XPTB,NPLB,XPHILB,NSB,NPLSB,NA2,IDIMB,
  91. c & IBASB,IPLSB,INMSB,IORSB,IND,IAROTA)
  92. CALL DEVRCO(Q1,Q2,NA1,XPTB,NPLB,XPHILB,NSB,NPLSB,NA2,IDIMB,
  93. & IBASB,IPLSB,INMSB,IORSB,IND,IAROTA)
  94. * --> XPTB(:,1)=x_n XPTB(:,2,:)=\dot{q}_n
  95.  
  96. *
  97. *--------------------------------------------------------------------*
  98. * Initialisation des tableaux contenants les paramètres de liaison
  99. *--------------------------------------------------------------------*
  100. *
  101. CALL DEVLB2(IPLIB,IPALB,XPALB,XPTB,NLIAB,IND,IDIMB,NPLB,
  102. & XABSCI,XORDON,NIP)
  103. *
  104. *--------------------------------------------------------------------*
  105. * Calcul des forces de choc sur base B
  106. *--------------------------------------------------------------------*
  107. *
  108. CALL D2VLB1(FTOTB,XPTB,IPALB,IPLIB,JPLIB,XPALB,XVALB,NLIAB,
  109. & NPLB,IDIMB,PDT,NPAS,IND,FEXPSM,NPC1,IERRD,
  110. & FTEST2,XABSCI,XORDON,NIP,XCHPFB,
  111. & KTOTXB,KTOTVB,.false.)
  112.  
  113. IF (IERRD.NE.0) RETURN
  114.  
  115. *--------------------------------------------------------------------*
  116. * Calcul des moments dans le cas des modes de rotation rigide
  117. *--------------------------------------------------------------------*
  118. IF (RIGIDE) THEN
  119. CALL DEVMOM(FTOTB,Q1,FEXB,XPHILB,IAROTA,IBASB,IPLSB,INMSB,
  120. & NA2,NA1,NSB,NPLSB,NPLB,1,IDIM)
  121. ENDIF
  122.  
  123. *--------------------------------------------------------------------*
  124. * Projection des forces base B sur base A
  125. *--------------------------------------------------------------------*
  126.  
  127. CALL DEVPRO(XPHILB,FTOTB,FTOTBA,IBASB,INMSB,IPLSB,IORSB,NSB,
  128. & NPLSB,NA2,IDIMB,NPLB,NA1)
  129.  
  130. *--------------------------------------------------------------------*
  131. * Ajout des forces projetees aux forces exterieures sur base A
  132. *--------------------------------------------------------------------*
  133.  
  134. DO I = 1,NA1
  135. FTOTA(I,IND) = FTOTA(I,IND) + FTOTBA(I)
  136. ENDDO
  137.  
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  

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