Télécharger dyne14.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE14 SOURCE BP208322 17/05/24 21:15:00 9439
  2. SUBROUTINE DYNE14(ITREFR,KTLIAB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage du tableau contenant les paramètres de liaison en *
  11. * cas de reprise. *
  12. * *
  13. * Paramètres: *
  14. * *
  15. * IPALB Renseigne sur la liaison. *
  16. * XPALB Tableau contenant les paramètres de la liaison. *
  17. * NLIAB Nombre de liaisons sur la base B. *
  18. * IDIM Nombre de directions. *
  19. * *
  20. * *
  21. * Auteur, date de création: *
  22. * *
  23. * Bertrand BEAUFILS : le 31 juillet 1990 *
  24. * Ibrahim Pinto, 05/97 , liaisons segment_cercle *
  25. *--------------------------------------------------------------------*
  26. *
  27. -INC CCOPTIO
  28. -INC SMCOORD
  29. -INC SMLENTI
  30. *
  31.  
  32.  
  33. LOGICAL L0,L1
  34. SEGMENT,MTLIAB
  35. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  36. REAL*8 XPALB(NLIAB,NXPALB)
  37. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  38. ENDSEGMENT
  39. *
  40.  
  41.  
  42. MTLIAB = KTLIAB
  43. NLIAB = XPALB(/1)
  44. *
  45. * Boucle sur le nombre de liaisons
  46. *
  47. ID0 = 0
  48. ID1 = 0
  49. ID2 = 0
  50. DO 10 I = 1,NLIAB
  51. ITYP = IPALB(I,1)
  52. CALL ACCTAB(ITREFR,'ENTIER',I,X0,' ',L0,IP0,
  53. & 'TABLE',I1,X1,' ',L1,ITREFI)
  54. IF (IERR.NE.0) RETURN
  55. CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0,
  56. & 'ENTIER',ITYPR,X1,' ',L1,ITR)
  57. IF (IERR.NE.0) RETURN
  58. IF (ITYP.NE.ITYPR) THEN
  59. call erreur(21)
  60. RETURN
  61. ENDIF
  62. *
  63. * ------ choc élémentaire POINT ou POINT_CERCLE_MOBILE
  64. * sans amortissement
  65. *
  66. IF (ITYP.EQ.23. OR. ITYP.EQ.33) THEN
  67. IDIM = IPALB(I,3)
  68. ID0 = 6 + 6*IDIM
  69. ID1 = 6 + 7*IDIM
  70. ID2 = 6 + 8*IDIM
  71.  
  72. *
  73. * ------ choc élémentaire POINT ou POINT_CERCLE_MOBILE
  74. * avec amortissement
  75. *
  76. ELSE IF (ITYP.EQ.24 .OR. ITYP.EQ.34) THEN
  77. IDIM = IPALB(I,3)
  78. ID0 = 7 + 6*IDIM
  79. ID1 = 7 + 7*IDIM
  80. ID2 = 7 + 8*IDIM
  81. *
  82. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT
  83. ELSE IF (ITYP.EQ.5) THEN
  84. IDIM = IPALB(I,3)
  85. ID0 = 6 + 4*IDIM
  86. ID1 = 6 + 5*IDIM
  87. ID2 = 6 + 6*IDIM
  88. *
  89. * ------ choc élémentaire POINT_PLAN_FROTTEMENT,
  90. * POINT_POINT_FROTTEMENT et autres liaisons...
  91. *
  92. ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.6 .or. ityp .eq. 13 .or.
  93. & ITYP.EQ.103 .OR. ITYP.EQ.113) THEN
  94. IDIM = IPALB(I,3)
  95. ID0 = 7 + 4*IDIM
  96. ID1 = 7 + 5*IDIM
  97. ID2 = 7 + 6*IDIM
  98.  
  99. *
  100. * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT
  101. *
  102. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  103. IF (ITYP.EQ.23) THEN
  104. IDD = 6
  105. ELSE
  106. IDD = 7
  107. ENDIF
  108. IDIM = IPALB(I,3)
  109. ID0 = IDD + 6*IDIM
  110. ID1 = IDD + 7*IDIM
  111. ID2 = IDD + 8*IDIM
  112. ID3 = IDD + 2*IDIM
  113.  
  114. CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE',
  115. & L0,IP0,'POINT',I1,X1,' ',L1,IPOR0)
  116. IF (IERR.NE.0) RETURN
  117. IPN0 = (IDIM + 1) * (IPOR0 - 1)
  118.  
  119. CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0,
  120. & 'POINT',I1,X1,' ',L1,IPOR1)
  121. IF (IERR.NE.0) RETURN
  122. IPN1 = (IDIM + 1) * (IPOR1 - 1)
  123.  
  124.  
  125. CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE',
  126. & L0,IP0,'POINT',I1,X1,' ',L1,IPOR2)
  127. IF (IERR.NE.0) RETURN
  128. IPN2 = (IDIM + 1) * (IPOR2 - 1)
  129.  
  130. CALL ACCTAB(ITREFI,'MOT',I0,X0,'NORMALE_DE_CHOC',
  131. & L0,IP0,'POINT',I1,X1,' ',L1,IPOR3)
  132. IF (IERR.NE.0) RETURN
  133. IPN3 = (IDIM + 1) * (IPOR3 - 1)
  134.  
  135. DO 40 ID = 1,IDIM
  136. XPALB(I,ID0+ID) = XCOOR(IPN0 + ID)
  137. XPALB(I,ID1+ID) = XCOOR(IPN1 + ID)
  138. XPALB(I,ID2+ID) = XCOOR(IPN2 + ID)
  139. XPALB(I,ID3+ID) = XCOOR(IPN3 + ID)
  140. 40 CONTINUE
  141. * end do
  142.  
  143. CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0,
  144. & 'ENTIER',IGP,X1,' ',L1,IRP)
  145. IF (IERR.NE.0) RETURN
  146. IPALB(I,2) = IGP
  147. *
  148. GOTO 10
  149.  
  150. *
  151. *
  152. *
  153. * ------ CHOC éLéMENTAIRE POINT_PLAN_FLUIDE
  154. *
  155. ELSE IF (ITYP.EQ.7) THEN
  156. IDIM = IPALB(I,3)
  157. ID1 = 6 + IDIM
  158. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_1/2',L0,IP0,
  159. & 'POINT',I1,X1,' ',L1,IPDEP)
  160. IF (IERR.NE.0) RETURN
  161. CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_1/2',L0,IP0,
  162. & 'POINT',I1,X1,' ',L1,IPVIT)
  163. IF (IERR.NE.0) RETURN
  164. CALL ACCTAB(ITREFI,'MOT',I0,X0,'ACCELERATION_1/2',L0,IP0,
  165. & 'POINT',I1,X1,' ',L1,IPACC)
  166. IF (IERR.NE.0) RETURN
  167. IPND = (IDIM + 1) * (IPDEP - 1)
  168. IPNV = (IDIM + 1) * (IPVIT - 1)
  169. IPNA = (IDIM + 1) * (IPACC - 1)
  170. XPALB(I,ID1+1) = XCOOR(IPND + 1)
  171. XPALB(I,ID1+2) = XCOOR(IPNV + 1)
  172. XPALB(I,ID1+3) = XCOOR(IPNA + 1)
  173. GOTO 10
  174. ** ianis
  175. *
  176. * ------ choc élémentaire POINT_PLAN avec plasticite
  177. *
  178. ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101 ) THEN
  179. C chargement du deplacement plastique
  180. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE',
  181. & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2)
  182. IF (IERR.NE.0) RETURN
  183. IDIM = IPALB(I,3)
  184. id1 = 4
  185. XPALB(I,(ID1+IDIM+1)) = XDPLAS
  186. GOTO 10
  187. *
  188. * ------ choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE
  189. *
  190. ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN
  191. C chargement du deplacement plastique et de la limite elastique
  192. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE',
  193. & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2)
  194. IF (IERR.NE.0) RETURN
  195. *
  196. * le depl limite elastique ne sert plus a rien
  197. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_LIMITE_ELASTIQUE',
  198. & L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2)
  199. IF (IERR.NE.0) RETURN
  200. CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE_CUMULE',
  201. & L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2)
  202. IF (IERR.NE.0) RETURN
  203. idim = IPALB(I,3)
  204. if (ityp.eq.16) nn = 4 + idim
  205. if (ityp.eq.17) nn = 5 + idim
  206. XPALB(I,nn-2) = XDPLAS
  207. XPALB(I,nn-1) = XELA
  208. XPALB(I,nn) = XDPLAC
  209. GOTO 10
  210. *
  211. * ------ choc elementaire POINT_POINT_ROTATION_PLASTIQUE
  212. *
  213. ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN
  214. * chargement de la rotation plastique et de la limite elastique
  215. CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE',
  216. & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2)
  217. IF (IERR.NE.0) RETURN
  218. *
  219. * la rot limite elastique ne sert plus a rien
  220. CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_LIMITE_ELASTIQUE',
  221. & L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2)
  222. IF (IERR.NE.0) RETURN
  223. CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE_CUMULE',
  224. & L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2)
  225. IF (IERR.NE.0) RETURN
  226. idim = IPALB(I,3)
  227. if (ityp.eq.50) nn = 4 + idim
  228. if (ityp.eq.51) nn = 5 + idim
  229. XPALB(I,nn-2) = XDPLAS
  230. XPALB(I,nn-1) = XELA
  231. XPALB(I,nn) = XDPLAC
  232.  
  233. GOTO 10
  234. C
  235. * -------choc élémentaire LIGNE_LIGNE_FROTTEMENT
  236. *
  237. ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN
  238. * Chargement des noeudS leS plus proche
  239. CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0,
  240. & 'LISTENTI',I1,X1,' ',L1,IVOIS1)
  241. IF (IERR.NE.0) RETURN
  242. MLENTI = IVOIS1
  243. SEGACT,MLENTI
  244. NNOE=LECT(/1)
  245. DO 30 JVOI=1,NNOE
  246. IPALB(I,26+JVOI)=LECT(JVOI)
  247. 30 CONTINUE
  248. SEGDES,MLENTI
  249.  
  250.  
  251. * -------chocS élémentaireS SEGMENT_CERCLE_FROTTEMENT_sanreac ET ..._REACNOR
  252. *
  253. ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38
  254. & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN
  255. * Chargement des noeudS leS plus proche
  256. CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0,
  257. & 'LISTENTI',I1,X1,' ',L1,IVOIS1)
  258. IF (IERR.NE.0) RETURN
  259. MLENTI = IVOIS1
  260. SEGACT,MLENTI
  261. NNOE=LECT(/1)
  262. DO 32 JVOI=1,NNOE
  263. IPALB(I,26+JVOI)=LECT(JVOI)
  264. 32 CONTINUE
  265. SEGDES,MLENTI
  266.  
  267.  
  268.  
  269.  
  270. *
  271. *
  272. *
  273. * ------ choc ....
  274. *
  275. * ELSE IF (ITYP.EQ. ) THEN
  276. * ...
  277. *
  278. *
  279. ELSE
  280. GOTO 10
  281. ENDIF
  282. *
  283. IF (ITYP.NE.35 .AND. ITYP.NE.36 .AND. ITYP.NE.37
  284. & .AND. ITYP.NE.38 .AND. ITYP.NE.39 .AND. ITYP.NE.40) THEN
  285. *
  286. * Chargement de la position origine d'adhérence
  287. *
  288. CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE',
  289. & L0,IP0,'POINT',I1,X1,' ',L1,IPOR0)
  290. IF (IERR.NE.0) RETURN
  291. IPN0 = (IDIM + 1) * (IPOR0 - 1)
  292. *
  293. * Chargement de la vitesse tangentielle
  294. *
  295. CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0,
  296. & 'POINT',I1,X1,' ',L1,IPOR1)
  297. IF (IERR.NE.0) RETURN
  298. IPN1 = (IDIM + 1) * (IPOR1 - 1)
  299. *
  300. * Chargement de la force tangentielle
  301. *
  302. CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE',
  303. & L0,IP0,'POINT',I1,X1,' ',L1,IPOR2)
  304. IF (IERR.NE.0) RETURN
  305. IPN2 = (IDIM + 1) * (IPOR2 - 1)
  306. DO 20 ID = 1,IDIM
  307. XPALB(I,ID0+ID) = XCOOR(IPN0 + ID)
  308. XPALB(I,ID1+ID) = XCOOR(IPN1 + ID)
  309. XPALB(I,ID2+ID) = XCOOR(IPN2 + ID)
  310. 20 CONTINUE
  311. * end do
  312. ENDIF
  313. *
  314. * Chargement de l'état tangentiel de la liaison
  315. *
  316. CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0,
  317. & 'ENTIER',IGP,X1,' ',L1,IRP)
  318. IF (IERR.NE.0) RETURN
  319. IPALB(I,2) = IGP
  320. *
  321. 10 CONTINUE
  322.  
  323.  
  324. * end do
  325. *
  326. END
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  

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