Télécharger devtr1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVTR1 SOURCE CHAT 05/01/12 22:47:45 5004
  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. IF (ICHRES(1).EQ.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. * end do
  77. IF (ICHRES(2).EQ.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. IF (ICHRES(3).EQ.1) THEN
  85. KRES = KRES + 1
  86. DO 14 I=1,NA1
  87. XRES(KRES,I,IINS2) = Q1(I,2)
  88. 14 CONTINUE
  89. * end do
  90. ENDIF
  91. IF (ICHRES(4).EQ.1) THEN
  92. KRES = KRES + 1
  93. DO 16 I=1,NA1
  94. XRES(KRES,I,IINS2) = Q2(I,2)
  95. 16 CONTINUE
  96. * end do
  97. ENDIF
  98. IF (ICHRES(5).EQ.1) THEN
  99. KRES = KRES + 1
  100. DO 18 I=1,NA1
  101. XRES(KRES,I,IINS2) = Q3(I,1)
  102. 18 CONTINUE
  103. * end do
  104. ENDIF
  105. IF (ICHRES(6).EQ.1) THEN
  106. KRES = KRES + 1
  107. DO 20 I=1,NA1
  108. XRES(KRES,I,IINS2) = Q3(I,2)
  109. 20 CONTINUE
  110. * end do
  111. ENDIF
  112. ENDIF
  113.  
  114. c ianis
  115. cc travaux
  116. IF (ICHRES(7).EQ.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. IF (ICHRES(7).EQ.1) THEN
  123. KRES = KRES + 1
  124. DO 70 I=1,NA1
  125. XRES(KRES,I,IINS2) = WINT(I,1)
  126. 70 CONTINUE
  127. ENDIF
  128.  
  129.  
  130. IF (ICHRES(9).EQ.1) THEN
  131. DO 30 IL = 1,NLSA
  132. IIL = INULA(IL)
  133. II = 0
  134. DO 32 IV = 1,NTVAR
  135. IF (ILIREA(IL,IV).EQ.1) THEN
  136. II = II + 1
  137. XRESLA(IL,IINS2,II) = XVALA(IIL,1,IV)
  138. ENDIF
  139. 32 CONTINUE
  140. * end do
  141. 30 CONTINUE
  142. * end do
  143. ENDIF
  144. IF (ICHRES(10).EQ.1) THEN
  145. DO 40 IL = 1,NLSB
  146. IIL = INULB(IL)
  147. II = 0
  148. DO 42 IV = 1,NTVAR
  149. IF (ILIREB(IL,IV).EQ.1) THEN
  150. II = II + 1
  151. XRESLB(IL,IINS2,II) = XVALB(IIL,1,IV)
  152. ELSE
  153. IF (ILIREB(IL,IV).EQ.2) THEN
  154. DO 43 IP=1,NPLB
  155. DO 44 ID=1,2
  156. II = II + 1
  157. XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,1,IP)
  158. 44 CONTINUE
  159. 43 CONTINUE
  160. ENDIF
  161. *
  162. ENDIF
  163. 42 CONTINUE
  164. * end do
  165. 40 CONTINUE
  166. * end do
  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.  

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