Télécharger d2vpas.eso

Retour à la liste

Numérotation des lignes :

  1. C D2VPAS SOURCE BP208322 19/02/25 21:15:24 10120
  2. c
  3. SUBROUTINE D2VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,NPAS,
  4. & FTOTA,FEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  5. & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,FTOTB,
  6. & FTOTBA,XPTB,FEXPSM,
  7. & FINERT,IERRD,FTEST,FTOTA0,FTEST2,WEXT,WINT,
  8. & XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,KTPHI,XCHPFB,
  9. & XOPM1,NB1,NB1K,NB1C,NB1M)
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. *--------------------------------------------------------------------*
  13. * *
  14. * Opérateur DYNE : algorithme des DIFFERENCES CENTREES *
  15. * ________________________________________________ *
  16. * *
  17. * Calcul d'un pas de temps, appel aux s-p spécifiques. *
  18. * *
  19. * Paramètres: *
  20. * *
  21. * es Q1(,) Vecteur des déplacements généralisés *
  22. * es Q2(,) Vecteur des vitesses généralisées *
  23. * es Q3(,) Vecteur des accélérations généralisées *
  24. * es NA1 Nombre total d'inconnues en base A *
  25. * es NPC1 Nombre de pas de calcul - 1 *
  26. * es XK Vecteur des raideurs généralisées *
  27. * es XASM Vecteur des amortissements généralisés *
  28. * es XM Vecteur des masses généralisées *
  29. * e PDT pas de temps courant *
  30. * e T temps courant *
  31. * e NPAS Numéro du pas de temps *
  32. * es FTOTA Forces extérieures totalisées, sur la base A *
  33. * es FEXA Evolution des forces extérieures en base A *
  34. * e FTEXB Evolution des forces extérieures en base B *
  35. * e FEXB Forces extérieures sur la base B, servant au calcul *
  36. * des moments pour les corps rigides. *
  37. * e RIGIDE Vrai si corps rigide, faux sinon *
  38. * es IFEXA Numéro du mode correspondant au point de chargement *
  39. * (supprime le 2018-12-14 par bp) *
  40. * es NPFEXA Nombre de points de chargement *
  41. * e NLIAA Nombre de liaisons sur la base A *
  42. * e NLSA Nombre de liaisons A en sortie *
  43. * e IPALA Tableau renseignant sur le type de liaison (base A) *
  44. * e IPLIA Tableau contenant les numéros "DYNE" des points *
  45. * e XPALA Tableau contenant les paramètres des liaisons *
  46. * es XVALA Tableau contenant les variables internes de liaison A *
  47. * XPHILB Vecteur des deformees modales *
  48. * e NLIAB Nombre de liaisons sur la base B *
  49. * e NLSB Nombre de liaisons base B en sortie *
  50. * e NPLB Nombre total de points de liaisons (base B) *
  51. * e IDIMB Nombre de directions *
  52. * e IPALB Tableau renseignant sur le type de liaison *
  53. * e IPLIB Tableau contenant les numeros "DYNE" des points *
  54. * e JPLIB Tableau contenant les numeros "GIBI" des points *
  55. * e XPALB Tableau contenant les parametres des liaisons (base B) *
  56. * es XVALB Tableau contenant les variables internes de liaison B *
  57. * FTOTB Forces exterieures totalisees sur la base B *
  58. * e XABSCI Tableau contenant les abscisses de la loi plastique *
  59. * e XORDON Tableau contenant les ordonnees de la loi plastique *
  60. * e NIP Nbr de points dans l'evolution de la loi plastique *
  61. * FTOTBA Forces totales base B projetees base A *
  62. * XPTB Deplacements des points de liaison *
  63. * IBASB Appartenance des points de liaison a une sous-base *
  64. * IPLSB Position du point de liaison dans la sous-base *
  65. * INMSB Nombre de modes dans la sous-base *
  66. * IORSB Position du 1er mode de la sous-base dans ens. modes *
  67. * IAROTA Indique la position des modes de rotation *
  68. * NSB Nombre de sous-bases *
  69. * NPLSB Nombre de points de liaison par sous-base *
  70. * NA2 Nombre d'inconnues dans la sous-base *
  71. * FEXPSM Pseudo-Modes base B *
  72. * FINERT Forces d'inertie base B *
  73. * IERRD Indicateur d'erreur *
  74. * - FTEST Tableau local FTEST de la subroutine D2VLFA *
  75. * - FTOTA0 Tableau local FTOTA0 de la subroutine D2VLFA *
  76. * - FTEST2 Tableau local FTEST de la subroutine DEVLB1 *
  77. * e,s WEXT travail des forces exterieures *
  78. * e,s WINT travail des forces interieures (rigidite et *
  79. * amortissement et forces de liaison ) *
  80. * *
  81. *--------------------------------------------------------------------*
  82. *
  83. SEGMENT,MTPHI
  84. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  85. INTEGER IAROTA(NSB)
  86. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  87. ENDSEGMENT
  88. *
  89. * INTEGER IFEXA(*),IPALA(NLIAA,*),IPLIA(NLIAA,*)
  90. INTEGER IPALA(NLIAA,*),IPLIA(NLIAA,*)
  91. INTEGER IPALB(NLIAB,*),IPLIB(NLIAA,*),JPLIB(*)
  92. REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*)
  93. REAL*8 XVALA(NLIAA,4,*),XPALA(NLIAA,*),XM(NA1,*),XK(NA1,*)
  94. REAL*8 XPALB(NLIAB,*),XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  95. REAL*8 XASM(NA1,*),FTOTA(NA1,*),FEXA(NPFEXA,NPC1,*)
  96. REAL*8 FTOTB(NPLB,*),FTOTBA(*),XPTB(NPLB,4,*),FINERT(NA1,*)
  97. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  98. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*)
  99. REAL*8 FTEXB(NPLB,NPC1,2,*),XCHPFB(2,NLIAB,4,NPLB)
  100.  
  101. REAL*8 XOPM1(NB1,NB1,*),Q2DEMI(NA1),FAMOR(NA1)
  102. *
  103. c LOGICAL LWRITE
  104. LOGICAL RIGIDE
  105. *
  106. MTPHI = KTPHI
  107. NSB = XPHILB(/1)
  108. NPLSB = XPHILB(/2)
  109. NA2 = XPHILB(/3)
  110.  
  111. C Parametres d'affichage (pour debuggage)
  112. c LWRITE=.false.
  113. c LWRITE=(NPAS.LE.20).OR.(MOD(NPAS,1000).EQ.0)
  114. c if(LWRITE) write(*,*) '-------- NPAS =',NPAS
  115.  
  116. ************************************************************************
  117. * Parametres temporels locaux
  118. ************************************************************************
  119. tdeb = T
  120. tfin = T + PDT
  121. dt = PDT
  122. dt2=dt/2.D0
  123. dt22=dt*dt2
  124.  
  125. ************************************************************************
  126. * Déplacements généralisés
  127. ************************************************************************
  128.  
  129. DO 1 I = 1,NA1
  130. q1(i,1) = q1(i,2) + q2(i,2)*dt + q3(i,2)*dt22
  131. 1 continue
  132. c if(LWRITE) write(*,*) 'Q1(:,2) =',(Q1(iou,2),iou=1,NA1)
  133. c if(LWRITE) write(*,*) 'Q2(:,2) =',(Q2(iou,2),iou=1,NA1)
  134. c if(LWRITE) write(*,*) 'Q3(:,2) =',(Q3(iou,2),iou=1,NA1)
  135. c if(LWRITE) write(*,*) '--> Q1(:,1) =',(Q1(iou,1),iou=1,NA1)
  136.  
  137.  
  138. ************************************************************************
  139. * Calcul des forces
  140. ************************************************************************
  141.  
  142. * Totalisation des forces extérieures pour la base A a la fin du pas
  143. CALL D2VFXA(FEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB,
  144. & NPLB,IDIMB,RIGIDE)
  145. c if(LWRITE) write(*,*) 'FEXA(:,1) =',(FTOTA(iou,1),iou=1,NA1)
  146.  
  147. * Ajout des forces de liaison
  148. IF (NLIAA.NE.0) THEN
  149. CALL D2VLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA,
  150. & NLIAA,dt,tfin,NPAS,1,FINERT,0,FTEST,FTOTA0)
  151. ENDIF
  152. IF (NLIAB.NE.0) THEN
  153. CALL D2VLFB(Q1,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  154. & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,dt,tfin,
  155. & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,1,
  156. & FEXPSM,NPC1,IERRD,FTEST2,
  157. & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB)
  158. IF (IERRD.NE.0) RETURN
  159. ENDIF
  160. c if(LWRITE) write(*,*) 'FTOTBA(:) =',(FTOTBA(iou),iou=1,NA1)
  161. c if(LWRITE) write(*,*) 'FTOTA(:,1) =',(FTOTA(iou,1),iou=1,NA1)
  162.  
  163. * Ajout des forces de raideur
  164. * F = F - K Q_1
  165. CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,1)
  166.  
  167. * forces d'amortissement
  168. IF (NB1C.GT.1) THEN
  169. DO 3 I=1,NA1
  170. Q2DEMI(i)=(q1(i,1) - q1(i,2))/dt
  171. 3 CONTINUE
  172. DO 4 I=1,NA1
  173. FAMOR(I) = 0.D0
  174. DO 4 J=1,NB1
  175. FAMOR(I) = FAMOR(I) + XASM(I,J) * Q2DEMI(J)
  176. 4 CONTINUE
  177. ELSE
  178. DO 41 I=1,NA1
  179. FAMOR(I) = XASM(I,1) * (q1(I,1) - q1(I,2))/dt
  180. 41 CONTINUE
  181. ENDIF
  182. c if(LWRITE) write(*,*) 'FAMOR =',(FAMOR(iou),iou=1,NA1)
  183. c if(LWRITE) write(*,*) 'FINERT =',(FINERT(iou,1),iou=1,NA1)
  184.  
  185.  
  186. ************************************************************************
  187. * Accelerations et Vitesses généralisées
  188. ************************************************************************
  189.  
  190. c -Cas C ou M pleine
  191. IF (NB1.NE.1) THEN
  192. DO 5 I=1,NA1
  193. Q3(I,1) = 0.D0
  194. DO 6 J=1,NB1
  195. Q3(I,1) = Q3(I,1) + XOPM1(I,J,1)*(FTOTA(J,1)-FAMOR(J))
  196. 6 CONTINUE
  197. * Vitesses généralisées
  198. q2(i,1) = q2(i,2) + (q3(i,2) + q3(i,1))*dt2
  199. 5 CONTINUE
  200.  
  201. c -Cas C et M diagonales
  202. ELSE
  203. DO 51 I=1,NA1
  204. c UNSM = 1.D0 / ( XM(I,1) - FINERT(I,1) )
  205. cbp : pour les "vraies" differences centrees, il faut inclure l'amortissement
  206. UNSM = 1.D0 / ( XM(I,1) + dt2*XASM(I,1) - FINERT(I,1) )
  207. Q3(I,1) = (FTOTA(I,1)-FAMOR(I)) * UNSM
  208. c Q3(I,1) = (FTOTA(I,1)-FAMOR(I)) / (XM(I,1) - FINERT(I,1))
  209. * Vitesses généralisées
  210. q2(i,1) = q2(i,2) + (q3(i,2) + q3(i,1))*dt2
  211. 51 CONTINUE
  212.  
  213. ENDIF
  214.  
  215. c if(LWRITE) write(*,*) 'Q3(:,1) =',(Q3(iou,1),iou=1,NA1)
  216. c if(LWRITE) write(*,*) 'Q2(:,1) =',(Q2(iou,1),iou=1,NA1)
  217.  
  218.  
  219. ************************************************************************
  220. * calcul des travaux + decalage pour pas suivant
  221. ************************************************************************
  222.  
  223. CALL D2VENE (NA1,1,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT,
  224. & XASM,NPC1,NB1C)
  225.  
  226.  
  227. END
  228.  
  229.  
  230.  

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