Télécharger devpas.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVPAS SOURCE BP208322 18/12/20 21:15:36 10048
  2. *
  3. SUBROUTINE DEVPAS(NA1,NPC1,XK,XASM,XM,PDT,T,NPAS,FTOTA,
  4. * & FEXA,IFEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  5. & FEXA,NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  6. & NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,FTOTB,
  7. & FTOTBA,XPTB,FEXPSM,
  8. & FINERT,IERRD,FTEST,FTOTA0,FTEST2,FTOTB0,KTQ,
  9. & XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,KTPHI,XCHPFB,XOPM1,NB1,
  10. & NB1K,NB1C,NB1M)
  11. *
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8(A-H,O-Z)
  14. *--------------------------------------------------------------------*
  15. * *
  16. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  17. * ________________________________________________ *
  18. * *
  19. * Calcul d'un pas de temps, appel aux s-p spécifiques. *
  20. * *
  21. * Paramètres: *
  22. * *
  23. * es Q1(,) Vecteur des déplacements généralisés *
  24. * es Q2(,) Vecteur des vitesses généralisées *
  25. * es Q3(,) Vecteur des accélérations généralisées *
  26. * es NA1 Nombre total d'inconnues en base A *
  27. * es NPC1 Nombre de pas de calcul *
  28. * es XK Vecteur des raideurs généralisées *
  29. * es XASM Vecteur des amortissements généralisés *
  30. * es XM Vecteur des masses généralisées *
  31. * e PDT pas de temps *
  32. * e T temps *
  33. * e NPAS Numéro du pas de temps *
  34. * es FTOTA Forces extérieures totalisées, sur la base A *
  35. * es FEXA Evolution des forces extérieures en base A *
  36. * e FTEXB Evolution des forces extérieures en base B *
  37. * e FEXB Forces extérieures sur la base B, servant au calcul *
  38. * des moments pour les corps rigides. *
  39. * e RIGIDE Vrai si corps rigide, faux sinon *
  40. * es IFEXA Numéro du mode correspondant au point de chargement *
  41. * (supprime le 2018-12-14 par bp)
  42. * es NPFEXA Nombre de points de chargement *
  43. * e NLIAA Nombre de liaisons sur la base A *
  44. * e NLSA Nombre de liaisons A en sortie *
  45. * e IPALA Tableau renseignant sur le type de liaison (base A) *
  46. * e IPLIA Tableau contenant les numéros "DYNE" des points *
  47. * e XPALA Tableau contenant les paramètres des liaisons *
  48. * es XVALA Tableau contenant les variables internes de liaison A *
  49. * XPHILB Vecteur des deformees modales *
  50. * e NLIAB Nombre de liaisons sur la base B *
  51. * e NLSB Nombre de liaisons base B en sortie *
  52. * e NPLB Nombre total de points de liaisons (base B) *
  53. * e IDIMB Nombre de directions *
  54. * e IPALB Tableau renseignant sur le type de liaison *
  55. * e IPLIB Tableau contenant les numeros "DYNE" des points *
  56. * e JPLIB Tableau contenant les numeros "GIBI" des points *
  57. * e XPALB Tableau contenant les parametres des liaisons (base B) *
  58. * es XVALB Tableau contenant les variables internes de liaison B *
  59. * FTOTB Forces exterieures totalisees sur la base B *
  60. * e XABSCI Tableau contenant les abscisses de la loi plastique *
  61. * e XORDON Tableau contenant les ordonnees de la loi plastique *
  62. * e NIP Nbr de points dans l'evolution de la loi plastique *
  63. * FTOTBA Forces totales base B projetees base A *
  64. * XPTB Deplacements des points de liaison *
  65. * IBASB Appartenance des points de liaison a une sous-base *
  66. * IPLSB Position du point de liaison dans la sous-base *
  67. * INMSB Nombre de modes dans la sous-base *
  68. * IORSB Position du 1er mode de la sous-base dans ens. modes *
  69. * IAROTA Indique la position des modes de rotation *
  70. * NSB Nombre de sous-bases *
  71. * NPLSB Nombre de points de liaison par sous-base *
  72. * NA2 Nombre d'inconnues dans la sous-base *
  73. * FEXPSM Pseudo-Modes base B *
  74. * FINERT Forces d'inertie base B *
  75. * IERRD Indicateur d'erreur *
  76. * - FTEST Tableau local FTEST de la subroutine DEVLFA *
  77. * - FTOTA0 Tableau local FTOTA0 de la subroutine DEVLFA *
  78. * - FTEST2 Tableau local FTEST de la subroutine DEVLB1 *
  79. * - FTOTB0 Tableau local FTOTB0 de la subroutine DEVLB1 *
  80. * e,s WEXT travail des forces exterieures
  81. * e,s WINT travail des forces interieures (rigidite et
  82. * amortissement et forces de liaison )
  83. * *
  84. * Auteur, date de création: *
  85. * *
  86. * Denis ROBERT-MOUGIN, le 26 mai 1989. *
  87. * *
  88. *--------------------------------------------------------------------*
  89. *
  90. SEGMENT,MTPHI
  91. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  92. INTEGER IAROTA(NSB)
  93. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  94. ENDSEGMENT
  95. *
  96. SEGMENT,MTQ
  97. REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  98. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  99. ENDSEGMENT
  100. *
  101. c INTEGER IFEXA(*),IPALA(NLIAA,*),IPLIA(NLIAA,*)
  102. INTEGER IPALA(NLIAA,*),IPLIA(NLIAA,*)
  103. INTEGER IPALB(NLIAB,*),IPLIB(NLIAA,*),JPLIB(*)
  104. * REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*)
  105. REAL*8 XVALA(NLIAA,4,*),XPALA(NLIAA,*),XM(NA1,*),XK(NA1,*)
  106. REAL*8 XPALB(NLIAB,*),XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  107. REAL*8 XASM(NA1,*),FTOTA(NA1,*),FEXA(NPFEXA,NPC1,*)
  108. REAL*8 FTOTB(NPLB,*),FTOTBA(*),XPTB(NPLB,4,*),FINERT(NA1,*)
  109. * REAL*8 WEXT(NA1,2),WINT(NA1,2)
  110. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*),FEXB(NPLB,2,*)
  111. REAL*8 FTEXB(NPLB,NPC1,2,*),XCHPFB(2,NLIAB,4,NPLB)
  112. REAL*8 XOPM1(NB1,NB1,*),FAMOR(NA1,4)
  113. *
  114. LOGICAL RIGIDE
  115. c LOGICAL LWRITE
  116. c LWRITE=.FALSE.
  117. c LWRITE=(NPAS.le.50).or.(mod(NPAS,100).eq.0)
  118. c if(LWRITE) write(*,*) '---- DEVPAS : PAS',NPAS
  119. c if(NPAS.eq.1) write(*,*) 'NB1*=',NB1K,NB1C,NB1M,NB1
  120. *
  121. MTQ = KTQ
  122. MTPHI = KTPHI
  123. NSB = XPHILB(/1)
  124. NPLSB = XPHILB(/2)
  125. NA2 = XPHILB(/3)
  126. IVINIT = 0
  127.  
  128.  
  129. *--------------------------------------------------------------------*
  130. III = 2
  131. *
  132. * Force amortissement généralisées pour le premier demi-pas de temps
  133. * FAMOR(,4) = C * \dot{q}_-1/2
  134. c if(LWRITE) write(*,*) 'Q2(:,4) =',(Q2(iou,4),iou=1,NA1)
  135. CALL DEVLC0(Q2,XASM,FAMOR,NA1,NB1C,4)
  136. c if(LWRITE) write(*,*) 'FAMOR(:,4) =',(FAMOR(iou,4),iou=1,NA1)
  137. * FAMOR(,3) = C * \dot{q}_0
  138. CALL DEVLC0(Q2,XASM,FAMOR,NA1,NB1C,3)
  139. c if(LWRITE) write(*,*) 'FAMOR(:,3) =',(FAMOR(iou,3),iou=1,NA1)
  140. *
  141. * Déplacements généralisés pour le premier demi-pas de temps
  142. * Q_1/2 = Q_0 + dt/2 * \dot Q_0
  143. * + dt^2/24 * M^-1 * (4F_0 - F_-1/2 - 4FAMOR_0 + FAMOR_-1/2)
  144. c if(LWRITE) write(*,*) 'FTOTA(:,4) =',(FTOTA(iou,4),iou=1,NA1)
  145. c if(LWRITE) write(*,*) 'FTOTA(:,3) =',(FTOTA(iou,3),iou=1,NA1)
  146. c if(LWRITE) write(*,*) 'Q1(:,3) =',(Q1(iou,3),iou=1,NA1)
  147. c if(LWRITE) write(*,*) 'Q2(:,3) =',(Q2(iou,3),iou=1,NA1)
  148. IF(NB1.NE.1) THEN
  149. CALL DEVEQ5(Q1,Q2,NA1,XM,PDT,NPAS,FTOTA,FAMOR,XOPM1,NB1,NB1M)
  150. ELSE
  151. CALL DEVEQ1(Q1,Q2,NA1,XASM,XM,PDT,NPAS,FTOTA,FINERT)
  152. ENDIF
  153. c if(LWRITE) write(*,*) 'Q1(:,2) =',(Q1(iou,2),iou=1,NA1)
  154. c if(LWRITE) write(*,*) '----'
  155. *
  156. * Totalisation des forces extérieures pour la base A
  157. * pour la fin du pas :
  158. * F_1/2 = FEXT_1/2 et F_1 = FEXT_1
  159. * CALL DEVFXA(FEXA,IFEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB,
  160. CALL DEVFXA(FEXA,FTOTA,NPFEXA,NA1,NPC1,NPAS,FTEXB,FEXB,
  161. & NPLB,IDIMB,RIGIDE)
  162. c if(LWRITE) write(*,*) 'FEXT_1/2=',(FTOTA(iou,2),iou=1,NA1)
  163. *
  164. * Ajout des forces de raideur a l'issue du premier demi-pas
  165. * F_1/2 = FEXT_1/2 - K Q_1/2
  166. CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,III)
  167. *
  168. * Ajout des forces de liaison
  169. * F_1/2 = FEXT_1/2 + FLIAI_1/2
  170. IF (NLIAA.NE.0) THEN
  171. CALL DEVLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA,
  172. & NLIAA,PDT,T,NPAS,III,FINERT,IVINIT,FTEST,FTOTA0)
  173. ENDIF
  174. IF (NLIAB.NE.0) THEN
  175. CALL DEVLFB(Q1,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  176. & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,PDT,T,
  177. & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III,
  178. & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0,
  179. & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB)
  180. IF (IERRD.NE.0) RETURN
  181. ENDIF
  182. c if(LWRITE) write(*,*) 'FTOTA(:,2) =',(FTOTA(iou,2),iou=1,NA1)
  183. *
  184. * Vitesses généralisées pour le premier demi-pas de temps
  185. * \dot{q}_1/2 = ...
  186. IF(NB1.NE.1) THEN
  187. CALL DEVEQ6(Q2,NA1,XM,PDT,NPAS,FTOTA,FAMOR,
  188. & XOPM1,NB1,NB1M)
  189. ELSE
  190. CALL DEVEQ2(Q2,NA1,XASM,XM,PDT,NPAS,FTOTA,FINERT)
  191. ENDIF
  192. c if(LWRITE) write(*,*) 'Q2(:,2) =',(Q2(iou,2),iou=1,NA1)
  193.  
  194. * FAMOR(,2) = C * \dot{q}_1/2
  195. CALL DEVLC0(Q2,XASM,FAMOR,NA1,NB1C,2)
  196.  
  197. * accelerations généralisées pour le premier demi-pas de temps
  198. * \ddot{q}_1/2 = M^-1 * (F_1/2 - FAMOR_0)
  199. c -cas M pleine
  200. IF(NB1M.NE.1) THEN
  201. DO 12 I = 1,NA1
  202. Q3(I,2) = 0.D0
  203. DO 12 IB = 1,NB1
  204. Q3(I,2) = Q3(I,2)
  205. c lequel est juste? y en a t'il vraiment un ?
  206. c & + XOPM1(I,IB,3)*(FTOTA(IB,III) - FAMOR(IB,3))
  207. & + XOPM1(I,IB,3)*(FTOTA(IB,III) - FAMOR(IB,III))
  208. 12 CONTINUE
  209. c -cas M diagonal
  210. ELSE
  211. DO 10 I = 1,NA1
  212. c lequel est juste? y en a t'il vraiment un ?
  213. c Q3(I,2) = ( FTOTA(I,III) - FAMOR(I,3) )
  214. Q3(I,2) = ( FTOTA(I,III) - FAMOR(I,III) )
  215. & / ( XM(I,1) - FINERT(I,III) )
  216. 10 CONTINUE
  217. ENDIF
  218. c if(LWRITE) write(*,*) 'Q3(:,2) =',(Q3(iou,2),iou=1,NA1)
  219.  
  220. c calcul des travaux pour le premier demi-pas de temps
  221. CALL DEVENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT,
  222. & FAMOR,NPC1)
  223.  
  224.  
  225. *--------------------------------------------------------------------*
  226. III = 1
  227.  
  228. c if(LWRITE) write(*,*) 'FEXT_1=',(FTOTA(iou,1),iou=1,NA1)
  229. * Déplacements généralisés pour le second demi-pas de temps
  230. * q_1 = ...
  231. IF(NB1.NE.1) THEN
  232. CALL DEVEQ7(Q1,Q2,NA1,XM,PDT,NPAS,FTOTA,FAMOR,XOPM1,NB1,NB1M)
  233. ELSE
  234. CALL DEVEQ3(Q1,Q2,NA1,XASM,XM,PDT,NPAS,FTOTA,FINERT)
  235. ENDIF
  236. c if(LWRITE) write(*,*) 'Q1(:,1) =',(Q1(iou,1),iou=1,NA1)
  237. *
  238. * Ajout des forces de raideur a l'issue du deuxième demi-pas
  239. * F_1 = FEXT_1 - K Q_1
  240. CALL DEVLK0(Q1,XK,FTOTA,NA1,NB1K,III)
  241. *
  242. * Ajout des forces de liaison
  243. * F_1 = FEXT_1 + FLIAI_1
  244. IF (NLIAA.NE.0) THEN
  245. CALL DEVLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA,
  246. & NLIAA,PDT,T,NPAS,III,FINERT,IVINIT,FTEST,FTOTA0)
  247. ENDIF
  248. IF (NLIAB.NE.0) THEN
  249. CALL DEVLFB(Q1,FTOTA,NA1,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  250. & XPHILB,JPLIB,NPLB,IDIMB,FTOTB,FTOTBA,XPTB,PDT,T,
  251. & NPAS,IBASB,IPLSB,INMSB,IORSB,NSB,NPLSB,NA2,III,
  252. & FEXPSM,NPC1,IERRD,FTEST2,FTOTB0,
  253. & XABSCI,XORDON,NIP,FEXB,RIGIDE,IAROTA,XCHPFB)
  254. IF (IERRD.NE.0) RETURN
  255. ENDIF
  256. c if(LWRITE) write(*,*) 'FTOTA(:,1) =',(FTOTA(iou,1),iou=1,NA1)
  257. *
  258. * Vitesses généralisées pour le second demi-pas de temps
  259. * \dot{q}_1 = ...
  260. IF(NB1.NE.1) THEN
  261. CALL DEVEQ8(Q2,NA1,XM,PDT,NPAS,FTOTA,FAMOR,XOPM1,NB1,NB1M)
  262. ELSE
  263. CALL DEVEQ4(Q2,NA1,XASM,XM,PDT,NPAS,FTOTA,FINERT)
  264. ENDIF
  265. c if(LWRITE) write(*,*) 'Q2(:,1) =',(Q2(iou,1),iou=1,NA1)
  266. *
  267. * accelerations généralisees pour le second demi-pas de temps
  268. * \dodt{q}_1 = M 1 * (F_1 - FAMOR_1)
  269. CALL DEVLC0(Q2,XASM,FAMOR,NA1,NB1C,III)
  270. c -cas M (ou C) pleine
  271. IF(NB1M.NE.1) THEN
  272. DO 22 I = 1,NA1
  273. Q3(I,1) = 0.D0
  274. DO 22 IB = 1,NB1
  275. Q3(I,1) = Q3(I,1)
  276. & + XOPM1(I,IB,3)*(FTOTA(IB,III) - FAMOR(IB,III))
  277. 22 CONTINUE
  278. c -cas M diagonal
  279. ELSE
  280. DO 20 I = 1,NA1
  281. Q3(I,1) = ( FTOTA(I,III) - FAMOR(I,III) )
  282. & / ( XM(I,1) - FINERT(I,III) )
  283. 20 CONTINUE
  284. ENDIF
  285. c if(LWRITE) write(*,*) 'Q3(:,1) =',(Q3(iou,1),iou=1,NA1)
  286.  
  287. c calcul des travaux pour le premier demi-pas de temps
  288.  
  289. CALL DEVENE (NA1,III,NPAS,FEXA,Q1,Q2,FTOTA,WEXT,WINT,
  290. & FAMOR,NPC1)
  291. *
  292. END
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  

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