Télécharger devtr1.eso

Retour à la liste

Numérotation des lignes :

devtr1
  1. C DEVTR1 SOURCE BP208322 20/03/26 21:15:36 10562
  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 : *
  12. * Transfert des quantités calculées durant le pas dans le *
  13. * tableau de sauvegarde, si l'on souhaite les garder ... *
  14. * *
  15. *--------------------------------------------------------------------*
  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. *--------------------------------------------------------------------*
  52. REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*)
  53. REAL*8 XVALA(NLIAA,4,*),XRESLA(NLSA,NPRES,*)
  54. REAL*8 XVALB(NLIAB,4,*),XRESLB(NLSB,NPRES,*)
  55. REAL*8 FTOTA(NA1,*),XRES(NRES,NCRES,*),XREP(NREP,*)
  56. REAL*8 XPALB(NLIAB,*),XMREP(NLIAB,4,*)
  57. INTEGER ICHRES(*),INULA(*),INULB(*)
  58. INTEGER ILIREA(NLSA,*),ILIREB(NLSB,*)
  59. INTEGER IPALB(NLIAB,*),IMREP(NLIAB,*)
  60. REAL*8 WEXT(NA1,2),WINT(NA1,2),XCHPFB(2,NLIAB,4,*)
  61. *
  62. *--------------------------------------------------------------------
  63. * Sauvegarde pour un pas courant :
  64. *--------------------------------------------------------------------
  65. *
  66. IF (NRES.NE.0) THEN
  67. KRES = 0
  68.  
  69. c +deplacement
  70. IF (ICHRES(1).GE.1) THEN
  71. KRES = KRES + 1
  72. DO 10 I=1,NA1
  73. XRES(KRES,I,IINS2) = Q1(I,1)
  74. 10 CONTINUE
  75. ENDIF
  76. c +vitesse
  77. IF (ICHRES(2).GE.1) THEN
  78. KRES = KRES + 1
  79. DO 12 I=1,NA1
  80. XRES(KRES,I,IINS2) = Q2(I,1)
  81. 12 CONTINUE
  82. * end do
  83. ENDIF
  84. c +deplacement demi-pas
  85. IF (ICHRES(3).GE.1) THEN
  86. KRES = KRES + 1
  87. DO 14 I=1,NA1
  88. XRES(KRES,I,IINS2) = Q1(I,2)
  89. 14 CONTINUE
  90. ENDIF
  91. c +vitesse demi-pas
  92. IF (ICHRES(4).GE.1) THEN
  93. KRES = KRES + 1
  94. DO 16 I=1,NA1
  95. XRES(KRES,I,IINS2) = Q2(I,2)
  96. 16 CONTINUE
  97. ENDIF
  98. c +acceleration
  99. IF (ICHRES(5).GE.1) THEN
  100. KRES = KRES + 1
  101. DO 18 I=1,NA1
  102. XRES(KRES,I,IINS2) = Q3(I,1)
  103. 18 CONTINUE
  104. ENDIF
  105. c +acceleration demi-pas
  106. IF (ICHRES(6).GE.1) THEN
  107. KRES = KRES + 1
  108. DO 20 I=1,NA1
  109. XRES(KRES,I,IINS2) = Q3(I,2)
  110. 20 CONTINUE
  111. ENDIF
  112.  
  113. c +travail exterieur
  114. IF (ICHRES(7).GE.1) THEN
  115. KRES = KRES + 1
  116. DO 60 I=1,NA1
  117. XRES(KRES,I,IINS2) = WEXT(I,1)
  118. 60 CONTINUE
  119. ENDIF
  120. c +travail interieur
  121. IF (ICHRES(8).GE.1) THEN
  122. KRES = KRES + 1
  123. DO 70 I=1,NA1
  124. XRES(KRES,I,IINS2) = WINT(I,1)
  125. 70 CONTINUE
  126. ENDIF
  127.  
  128. ENDIF
  129.  
  130. c +liaisons_A
  131. IF (ICHRES(9).GE.1) THEN
  132. DO 30 IL = 1,NLSA
  133. IIL = INULA(IL)
  134. II = 0
  135. DO 32 IV = 1,NTVAR
  136. IF (ILIREA(IL,IV).EQ.1) THEN
  137. II = II + 1
  138. XRESLA(IL,IINS2,II) = XVALA(IIL,1,IV)
  139. ENDIF
  140. 32 CONTINUE
  141. 30 CONTINUE
  142. ENDIF
  143.  
  144. c +liaisons_B
  145. IF (ICHRES(10).GE.1) THEN
  146. c boucle sur les liaisons B
  147. DO 40 IL = 1,NLSB
  148. IIL = INULB(IL)
  149. II = 0
  150. c boucle sur les grandeurs a sortir pour cette liaison
  151. DO 42 IV = 1,NTVAR
  152. * -sortie d'un LISTREEL
  153. IF (ILIREB(IL,IV).EQ.1) THEN
  154. II = II + 1
  155. XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV)
  156. c * --- bp debut du write ---
  157. c if(IINS2.le.2) then
  158. c write(*,*) '--------- liaison B',IL,'-------'
  159. c write(*,*) 'grandeur ',II,'issue de XVALB',IIL,IV
  160. c endif
  161. c * --- --- --- --- --- ---
  162. * -sortie d'un CHPOINT
  163. ELSEIF (ILIREB(IL,IV).EQ.2) THEN
  164. DO 43 IP=1,NPLB
  165. DO 44 ID=1,2
  166. II = II + 1
  167. XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,1,IP)
  168. 44 CONTINUE
  169. 43 CONTINUE
  170. ENDIF
  171. 42 CONTINUE
  172. 40 CONTINUE
  173. ENDIF
  174.  
  175. *
  176. *--------------------------------------------------------------------
  177. * Sauvegarde pour une reprise
  178. *--------------------------------------------------------------------
  179. *
  180. IF (IINS2.EQ.NPRES) THEN
  181. DO 50 I=1,NA1
  182. XREP(1,I) = Q1(I,1)
  183. XREP(2,I) = Q2(I,1)
  184. XREP(3,I) = Q1(I,2)
  185. XREP(4,I) = Q2(I,2)
  186. XREP(5,I) = Q3(I,1)
  187. XREP(6,I) = Q3(I,2)
  188. XREP(7,I) = FTOTA(I,1)
  189. XREP(8,I) = FTOTA(I,2)
  190. XREP(9,I) = WEXT(I,1)
  191. XREP(10,I)= WINT(I,1)
  192. 50 CONTINUE
  193. IF (NLIAB.NE.0) THEN
  194. DO 51 I = 1,NLIAB
  195. ITYP = IPALB(I,1)
  196. IMREP(I,1) = ITYP
  197. IMREP(I,2) = IPALB(I,2)
  198. *
  199. * ------ choc élémentaire POINT_PLAN_FROTTEMENT
  200. IF (ITYP.EQ.3 .OR. ITYP.EQ.103 ) THEN
  201. IDIM = IPALB(I,3)
  202. ID0 = 9 + 5*IDIM
  203. ID1 = 9 + 6*IDIM
  204. ID2 = 9 + 7*IDIM
  205. *
  206. c * ------ choc élémentaire POINT_CERCLE_FROTTEMENT sans amortissement
  207. c ELSEIF (ITYP.EQ.23.OR.ITYP.EQ.123) THEN
  208. c IDIM = IPALB(I,3)
  209. c ID0 = 6 + 6*IDIM
  210. c ID1 = 6 + 7*IDIM
  211. c ID2 = 6 + 8*IDIM
  212. cbp,2020
  213. *
  214. * ------ choc élémentaire POINT_CERCLE_FROTTEMENT avec amortissement
  215. ELSE IF (ITYP.EQ.24.OR.ITYP.EQ.124) THEN
  216. IDIM = IPALB(I,3)
  217. c ID0 = 7 + 6*IDIM
  218. c ID1 = 7 + 7*IDIM
  219. c ID2 = 7 + 8*IDIM
  220. ID0 = 10 + 6*IDIM
  221. ID1 = 10 + 7*IDIM
  222. ID2 = 10 + 8*IDIM
  223.  
  224. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT avec amortissement
  225. * ------ choc élémentaire POINT_POINT_FROTTEMENT
  226. ELSE IF (ITYP.EQ.13.OR. ITYP.EQ.113 .OR. ITYP.EQ.-13
  227. & .OR.ITYP.EQ.6) THEN
  228. IDIM = IPALB(I,3)
  229. ID0 = 7 + 4*IDIM
  230. ID1 = 7 + 5*IDIM
  231. ID2 = 7 + 6*IDIM
  232.  
  233. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT sans amortissement
  234. ELSE IF (ITYP.EQ.5 ) THEN
  235. IDIM = IPALB(I,3)
  236. ID0 = 6 + 4*IDIM
  237. ID1 = 6 + 5*IDIM
  238. ID2 = 6 + 6*IDIM
  239. *
  240. * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT
  241. *
  242. * ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36) THEN
  243. *
  244. * Ne sert pas pour l 'instant car modele d'ODEN de frottement
  245.  
  246.  
  247. * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT
  248.  
  249. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26
  250. & .or. ITYP.EQ.125 .OR. ITYP.EQ.126) THEN
  251. IDIM = IPALB(I,3)
  252. IF (ITYP.EQ.25) THEN
  253. IDD = 6
  254. ELSE
  255. IDD = 7
  256. ENDIF
  257. ID0 = IDD + 6*IDIM
  258. ID1 = IDD + 7*IDIM
  259. ID2 = IDD + 8*IDIM
  260. ID3 = IDD + 2*IDIM
  261. DO 82 ID = 1,IDIMB
  262. XMREP(I,1,ID) = XPALB(I,ID0+ID)
  263. XMREP(I,2,ID) = XPALB(I,ID1+ID)
  264. XMREP(I,3,ID) = XPALB(I,ID2+ID)
  265. XMREP(I,4,ID) = XPALB(I,ID3+ID)
  266. 82 CONTINUE
  267. * end do
  268. GOTO 51
  269.  
  270. * ------ choc élémentaire POINT_PLAN_FLUIDE
  271. *
  272. ELSE IF (ITYP.EQ.7) THEN
  273. IDIM = IPALB(I,3)
  274. ID1 = 6 + IDIM
  275. XMREP(I,1,1) = XPALB(I,ID1+1)
  276. XMREP(I,2,1) = XPALB(I,ID1+2)
  277. XMREP(I,3,1) = XPALB(I,ID1+3)
  278. GOTO 51
  279. C si ityp = 100, on sauvegarde le depl. plastique
  280. C directement dans devso4
  281. C NW idem si ITYP = 50/51 ou 16/17 --> dans devso4
  282. C
  283. *
  284. *
  285. * ------ choc ....
  286. *
  287. * ELSE IF (ITYP.EQ. ) THEN
  288. * ...
  289. *
  290. ELSE
  291. GOTO 51
  292. ENDIF
  293.  
  294. c ID0+j : x_adhe
  295. c ID1+j : Vglissement
  296. c ID2+j : Fglissement
  297. DO 52 ID = 1,IDIMB
  298. XMREP(I,1,ID) = XPALB(I,ID0+ID)
  299. XMREP(I,2,ID) = XPALB(I,ID1+ID)
  300. XMREP(I,3,ID) = XPALB(I,ID2+ID)
  301. 52 CONTINUE
  302. * end do
  303. 51 CONTINUE
  304. * end do
  305. ENDIF
  306. ENDIF
  307. *
  308. END
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  

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