Télécharger devtr1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVTR1 SOURCE BP208322 17/07/18 21:15:09 9498
  2. SUBROUTINE DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  3. & NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  4. & XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,
  5. & ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,
  6. & WEXT,WINT,XCHPFB,NPLB)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. *--------------------------------------------------------------------*
  10. * *
  11. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  12. * ________________________________________________ *
  13. * *
  14. * Transfert des quantités calculées durant le pas dans le *
  15. * tableau de sauvegarde, si l'on souhaite les garder ... *
  16. * *
  17. * Paramètres: *
  18. * *
  19. * e Q1(.,.) Vecteur de déplacements généralisés *
  20. * e Q2(.,.) Vecteur de vitesses généralisés *
  21. * e Q3(.,.) Vecteur de accélérations généralisés *
  22. * e NA1 Nombre total d'inconnues en base A *
  23. * e IINS2 Numéro du pas de sortie *
  24. * e NINS On veut une sortie tous les NINS pas de calcul *
  25. * e FTOTA Forces extérieures totalisées en base A *
  26. * es XRES Valeurs des variables sauvegardées *
  27. * e ICHRES Indique quelles variables seront sauvegardées *
  28. * e NRES Nombre de variables ( principales et auxilliaires ) *
  29. * e NCRES Nombre de valeurs prises par les variables *
  30. * e NPRES Nombre de pas de sortie *
  31. * es XREP Valeurs des variables de reprise de calcul *
  32. * e NREP Nombre de variables de reprise *
  33. * e XMREP Paramètres de liaison nécessaire @ une reprise *
  34. * e IMREP Paramètres de liaison nécessaire @ une reprise *
  35. * e XPALB Paramètres de liaison *
  36. * e IPALB Paramètres de liaison *
  37. * e XVALA Tableau contenant les variables internes de liaison A *
  38. * e INULA Tableau contenant les repères des liaisons *
  39. * e NLIAA Nombre de liaisons sur la base A *
  40. * e NLSA Nombre de liaisons en sortie base A *
  41. * es XRESLA Valeurs de variables de liaisons sauvegardées base A *
  42. * e XVALB Tableau contenant les variables internes de liaison B *
  43. * e INULB Tableau contenant les repères des liaisons *
  44. * e NLIAB Nombre de liaisons sur la base B *
  45. * e NLSB Nombre de liaisons en sortie base B *
  46. * es XRESLB Valeurs de variables de liaisons sauvegardées base B *
  47. * e,s WEXT travail des forces exterieures
  48. * e,s WINT travail des forces interieures (rigidite et
  49. * amortissement et forces de liaison )
  50. * *
  51. * Auteur, date de création: *
  52. * *
  53. * Denis ROBERT-MOUGIN, le 31 mai 1989. *
  54. * *
  55. *--------------------------------------------------------------------*
  56. REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*)
  57. REAL*8 XVALA(NLIAA,4,*),XRESLA(NLSA,NPRES,*)
  58. REAL*8 XVALB(NLIAB,4,*),XRESLB(NLSB,NPRES,*)
  59. REAL*8 FTOTA(NA1,*),XRES(NRES,NCRES,*),XREP(NREP,*)
  60. REAL*8 XPALB(NLIAB,*),XMREP(NLIAB,4,*)
  61. INTEGER ICHRES(*),INULA(*),INULB(*)
  62. INTEGER ILIREA(NLSA,*),ILIREB(NLSB,*)
  63. INTEGER IPALB(NLIAB,*),IMREP(NLIAB,*)
  64. REAL*8 WEXT(NA1,2),WINT(NA1,2),XCHPFB(2,NLIAB,4,*)
  65. *
  66. * Sauvegarde pour un pas courant :
  67. *
  68. IF (NRES.NE.0) THEN
  69. KRES = 0
  70.  
  71. c +deplacement
  72. IF (ICHRES(1).GE.1) THEN
  73. KRES = KRES + 1
  74. DO 10 I=1,NA1
  75. XRES(KRES,I,IINS2) = Q1(I,1)
  76. 10 CONTINUE
  77. ENDIF
  78. c +vitesse
  79. IF (ICHRES(2).GE.1) THEN
  80. KRES = KRES + 1
  81. DO 12 I=1,NA1
  82. XRES(KRES,I,IINS2) = Q2(I,1)
  83. 12 CONTINUE
  84. * end do
  85. ENDIF
  86. c +deplacement demi-pas
  87. IF (ICHRES(3).GE.1) THEN
  88. KRES = KRES + 1
  89. DO 14 I=1,NA1
  90. XRES(KRES,I,IINS2) = Q1(I,2)
  91. 14 CONTINUE
  92. ENDIF
  93. c +vitesse demi-pas
  94. IF (ICHRES(4).GE.1) THEN
  95. KRES = KRES + 1
  96. DO 16 I=1,NA1
  97. XRES(KRES,I,IINS2) = Q2(I,2)
  98. 16 CONTINUE
  99. ENDIF
  100. c +acceleration
  101. IF (ICHRES(5).GE.1) THEN
  102. KRES = KRES + 1
  103. DO 18 I=1,NA1
  104. XRES(KRES,I,IINS2) = Q3(I,1)
  105. 18 CONTINUE
  106. ENDIF
  107. c +acceleration demi-pas
  108. IF (ICHRES(6).GE.1) THEN
  109. KRES = KRES + 1
  110. DO 20 I=1,NA1
  111. XRES(KRES,I,IINS2) = Q3(I,2)
  112. 20 CONTINUE
  113. ENDIF
  114.  
  115. c +travail exterieur
  116. IF (ICHRES(7).GE.1) THEN
  117. KRES = KRES + 1
  118. DO 60 I=1,NA1
  119. XRES(KRES,I,IINS2) = WEXT(I,1)
  120. 60 CONTINUE
  121. ENDIF
  122. c +travail interieur
  123. IF (ICHRES(8).GE.1) THEN
  124. KRES = KRES + 1
  125. DO 70 I=1,NA1
  126. XRES(KRES,I,IINS2) = WINT(I,1)
  127. 70 CONTINUE
  128. ENDIF
  129.  
  130. ENDIF
  131.  
  132. c +liaisons_A
  133. IF (ICHRES(9).GE.1) THEN
  134. DO 30 IL = 1,NLSA
  135. IIL = INULA(IL)
  136. II = 0
  137. DO 32 IV = 1,NTVAR
  138. IF (ILIREA(IL,IV).EQ.1) THEN
  139. II = II + 1
  140. XRESLA(IL,IINS2,II) = XVALA(IIL,1,IV)
  141. ENDIF
  142. 32 CONTINUE
  143. 30 CONTINUE
  144. ENDIF
  145. c +liaisons_B
  146. IF (ICHRES(10).GE.1) THEN
  147. DO 40 IL = 1,NLSB
  148. IIL = INULB(IL)
  149. II = 0
  150. DO 42 IV = 1,NTVAR
  151. IF (ILIREB(IL,IV).EQ.1) THEN
  152. II = II + 1
  153. XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV)
  154. ELSE
  155. IF (ILIREB(IL,IV).EQ.2) THEN
  156. DO 43 IP=1,NPLB
  157. DO 44 ID=1,2
  158. II = II + 1
  159. XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,1,IP)
  160. 44 CONTINUE
  161. 43 CONTINUE
  162. ENDIF
  163. *
  164. ENDIF
  165. 42 CONTINUE
  166. 40 CONTINUE
  167. ENDIF
  168. *
  169. * Sauvegarde pour une reprise
  170. *
  171. IF (IINS2.EQ.NPRES) THEN
  172. DO 50 I=1,NA1
  173. XREP(1,I) = Q1(I,1)
  174. XREP(2,I) = Q2(I,1)
  175. XREP(3,I) = Q1(I,2)
  176. XREP(4,I) = Q2(I,2)
  177. XREP(5,I) = Q3(I,1)
  178. XREP(6,I) = Q3(I,2)
  179. XREP(7,I) = FTOTA(I,1)
  180. XREP(8,I) = FTOTA(I,2)
  181. XREP(9,I) = WEXT(I,1)
  182. XREP(10,I)= WINT(I,1)
  183. 50 CONTINUE
  184. * end do
  185. IF (NLIAB.NE.0) THEN
  186. DO 51 I = 1,NLIAB
  187. ITYP = IPALB(I,1)
  188. IMREP(I,1) = ITYP
  189. IMREP(I,2) = IPALB(I,2)
  190. *
  191. * ------ choc élémentaire POINT_CERCLE_FROTTEMENT sans amortissement
  192. *
  193. IF (ITYP.EQ.23) THEN
  194. IDIM = IPALB(I,3)
  195. ID0 = 6 + 6*IDIM
  196. ID1 = 6 + 7*IDIM
  197. ID2 = 6 + 8*IDIM
  198. *
  199. * ------ choc élémentaire POINT_CERCLE_FROTTEMENT avec amortissement
  200. *
  201. ELSE IF (ITYP.EQ.24) THEN
  202. IDIM = IPALB(I,3)
  203. ID0 = 7 + 6*IDIM
  204. ID1 = 7 + 7*IDIM
  205. ID2 = 7 + 8*IDIM
  206. *
  207. * ------ choc élémentaire POINT_PLAN_FROTTEMENT
  208. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT avec amortissement
  209. * ------ choc élémentaire POINT_POINT_FROTTEMENT
  210. *
  211. ELSE IF (ITYP.EQ.3 .or. ityp.eq.13
  212. & .or. ityp.eq.113 .or. ityp.eq.-13. or.ityp.eq.6) THEN
  213. IDIM = IPALB(I,3)
  214. ID0 = 7 + 4*IDIM
  215. ID1 = 7 + 5*IDIM
  216. ID2 = 7 + 6*IDIM
  217.  
  218. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT sans amortissement
  219. ELSE IF (ITYP.EQ.5 ) THEN
  220. IDIM = IPALB(I,3)
  221. ID0 = 6 + 4*IDIM
  222. ID1 = 6 + 5*IDIM
  223. ID2 = 6 + 6*IDIM
  224.  
  225. *
  226. * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT
  227. *
  228. * ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
  229. *
  230. * Ne sert pas pour l 'instant car modele d'ODEN de frottement
  231.  
  232.  
  233. * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT
  234.  
  235. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  236. IDIM = IPALB(I,3)
  237. IF (ITYP.EQ.25) THEN
  238. IDD = 6
  239. ELSE
  240. IDD = 7
  241. ENDIF
  242. ID0 = IDD + 6*IDIM
  243. ID1 = IDD + 7*IDIM
  244. ID2 = IDD + 8*IDIM
  245. ID3 = IDD + 2*IDIM
  246. DO 82 ID = 1,IDIMB
  247. XMREP(I,1,ID) = XPALB(I,ID0+ID)
  248. XMREP(I,2,ID) = XPALB(I,ID1+ID)
  249. XMREP(I,3,ID) = XPALB(I,ID2+ID)
  250. XMREP(I,4,ID) = XPALB(I,ID3+ID)
  251. 82 CONTINUE
  252. * end do
  253. GOTO 51
  254.  
  255.  
  256. * ------ choc élémentaire POINT_PLAN_FLUIDE
  257. *
  258. ELSE IF (ITYP.EQ.7) THEN
  259. IDIM = IPALB(I,3)
  260. ID1 = 6 + IDIM
  261. XMREP(I,1,1) = XPALB(I,ID1+1)
  262. XMREP(I,2,1) = XPALB(I,ID1+2)
  263. XMREP(I,3,1) = XPALB(I,ID1+3)
  264. GOTO 51
  265. C si ityp = 100, on sauvegarde le depl. plastique
  266. C directement dans devso4
  267. C NW idem si ITYP = 50/51 ou 16/17 --> dans devso4
  268. C
  269. *
  270. *
  271. * ------ choc ....
  272. *
  273. * ELSE IF (ITYP.EQ. ) THEN
  274. * ...
  275. *
  276. ELSE
  277. GOTO 51
  278. ENDIF
  279. C NW on boucle sur ID = 1,IDIMB
  280. *
  281. DO 52 ID = 1,IDIMB
  282. XMREP(I,1,ID) = XPALB(I,ID0+ID)
  283. XMREP(I,2,ID) = XPALB(I,ID1+ID)
  284. XMREP(I,3,ID) = XPALB(I,ID2+ID)
  285. 52 CONTINUE
  286. * end do
  287. 51 CONTINUE
  288. * end do
  289. ENDIF
  290. ENDIF
  291. *
  292. END
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  

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