Télécharger devfb3.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFB3 SOURCE BP208322 19/02/25 21:15:33 10120
  2. SUBROUTINE DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  3. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  4. & FEXPSM,NPC1,I,iannul)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. * *
  9. * operateur dyne : algorithme de fu - de vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * calcul des forces de choc sur base b pour les liaisons *
  13. * de type point_cercle. *
  14. * *
  15. * param}tres: *
  16. * *
  17. * e ityp type de la liaison. *
  18. * es ftotb forces exterieures totalisees sur la base b. *
  19. * e xptb tableau des deplacements des points *
  20. * e ipalb renseigne sur la liaison. *
  21. * e iplib tableau contenant les numeros "dyne" de la liaison. *
  22. * e xpalb tableau contenant les parametres de la liaison. *
  23. * es xvalb tableau contenant les variables internes de liaisons. *
  24. * e nliab nombre de liaisons sur la base b. *
  25. * e nplb nombre total de points intervenant dans les liaisons. *
  26. * e ind indice du pas. *
  27. * e i num{ro de la liaison. *
  28. * *
  29. * *
  30. * auteur, date de creation: *
  31. * *
  32. * lionel vivan : le 22 septembre 1989 : creation *
  33. * bertrand beaufils : le 31 mai 1990 : ajout frottement sec*
  34. * I. Politopoulos : juin 1996 : ajout point_cercle_mobile *
  35. * *
  36. *--------------------------------------------------------------------*
  37. *
  38. -INC CCREEL
  39. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  40. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
  41. REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  42. REAL*8 XPTP2(3),XPTPM2(3),XFNT(3)
  43. REAL*8 XVPC0(3),XN2(3),XVPCT(3)
  44. *
  45. * --- choc elementaire point_cercle
  46. * avec ou sans amortissement
  47. *
  48. IF (ITYP.EQ.21 .OR. ITYP.EQ.22) THEN
  49. NPOI = IPLIB(I,1)
  50. IDIM = IPALB(I,3)
  51. XRAID = XPALB(I,1)
  52. XJEU = XPALB(I,2)
  53.  
  54. IF (ITYP.EQ.21) THEN
  55. ID1 = 2
  56. ELSE
  57. XAMO = XPALB(I,3)
  58. ID1 = 3
  59. ENDIF
  60. ID2 = ID1 + IDIM
  61. PS = 0.D0
  62. DO 210 ID = 1,IDIM
  63. IDD1 = 3 + ID
  64. XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
  65. PS = PS + XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID)
  66. 210 CONTINUE
  67. * end do
  68. XPME = 0.D0
  69. PSXPME = 0.D0
  70. DO 212 ID = 1,IDIM
  71. XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
  72. XPME = XPRIM - XPALB(I,ID2+ID)
  73. PSXPME = PSXPME + XPME * XPME
  74. 212 CONTINUE
  75. * end do
  76. XDEP = SQRT(PSXPME)
  77. IF (ITYP.EQ.21) THEN
  78. CALL DYCHE2(XDEP,XRAID,XJEU, XFL,iannul)
  79. ELSE
  80. XDEPM1 = 0.D0
  81. * IF (XDEP.GT.1D-20) THEN
  82. IF (XDEP.GT.xpetit) THEN
  83. PS2 = 0.D0
  84. * correction gayffier 4/04/96 xdepm1 mal calculé
  85. DO 213 ID=1,IDIM
  86. PS2 = PS2 + XPTB(NPOI,IND2,ID) * XPALB(I,ID1+ID)
  87. 213 CONTINUE
  88. DO 214 ID = 1,IDIM
  89. XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
  90. XPME = XPRIM - XPALB(I,ID2+ID)
  91. XNOR = XPME / XDEP
  92. XDEPM1 = XDEPM1 + (XPTB(NPOI,IND2,ID)
  93. & -PS2*XPALB(I,ID1+ID)-XPALB(I,ID2+ID))*XNOR
  94. 214 CONTINUE
  95. * end do
  96. ENDIF
  97. XVIT = (XDEP - XDEPM1) / PDTS2
  98. XVALB(I,IND,3) = XVIT
  99. CALL DYCHA2(XDEP,XVIT,XRAID,XJEU,XAMO, XFL,iannul)
  100. ENDIF
  101. XVALB(I,IND,1) = XFL
  102. * IF (XDEP.GE.XJEU .AND. XDEP.GT.1D-20) THEN
  103. IF (XDEP.GE.XJEU.AND.XDEP.GT.xpetit) THEN
  104. XPME = 0.D0
  105. DO 216 ID = 1,IDIM
  106. XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
  107. XPME = XPRIM - XPALB(I,ID2+ID)
  108. XNOR = XPME / XDEP
  109. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFL * XNOR
  110. 216 CONTINUE
  111. * end do
  112. ENDIF
  113. *
  114. * --- choc elementaire point_cercle_frottement
  115. * avec ou sans amortissement
  116. *
  117. cbp ELSE IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN
  118. ELSE IF (ITYP.EQ.23 .OR. ITYP.EQ.24
  119. & .or. ITYP.EQ.123 .OR. ITYP.EQ.124) THEN
  120. NPOI = IPLIB(I,1)
  121. IGP = IPALB(I,2)
  122. IDIM = IPALB(I,3)
  123. cbp INTER = IPALB(I,4)
  124. if (ITYP.LT.100) then
  125. INTER=1
  126. else
  127. INTER=0
  128. endif
  129. IF (ITYP.EQ.23 .or. ITYP.EQ.123) THEN
  130. ID1 = 6
  131. ELSE
  132. ID1 = 7
  133. ENDIF
  134. ID2 = ID1 + IDIM
  135. ID3 = ID1 + 2*IDIM
  136. ID4 = ID1 + 3*IDIM
  137. ID5 = ID1 + 4*IDIM
  138. ID6 = ID1 + 5*IDIM
  139. ID7 = ID1 + 6*IDIM
  140. ID8 = ID1 + 7*IDIM
  141. ID9 = ID1 + 8*IDIM
  142. * si glissement au pas precedent, reactualisation de la position
  143. * origine d'adherence
  144. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  145. DO 230 ID=1,IDIM
  146. XPALB(I,ID7+ID) = XPTB(NPOI,IND,ID)
  147. 230 CONTINUE
  148. * end do
  149. ENDIF
  150. * calcul du deplacement sur la normale au plan de section droite
  151. * (normale perpendiculaire au plan du cercle)
  152. PS = 0.D0
  153. DO 232 ID = 1,IDIM
  154. IDD2 = 3 + ID
  155. XVALB(I,IND,IDD2) = XPTB(NPOI,IND,ID)
  156. XPALB(I,ID4+ID) = XPTB(NPOI,IND,ID) - XPTB(NPOI,IND2,ID)
  157. XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID) - XPALB(I,ID7+ID)
  158. PS = PS + XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID)
  159. 232 CONTINUE
  160. * end do
  161. * calcul de la normale au plan tangent du contact, et de la valeur du
  162. * deplacement suivant cette normale
  163. XPME = 0.D0
  164. PSXPME = 0.D0
  165. DO 234 ID = 1,IDIM
  166. XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
  167. XPME = XPRIM - XPALB(I,ID2+ID)
  168. XPALB(I,ID3+ID) = XPME
  169. PSXPME = PSXPME + XPME * XPME
  170. 234 CONTINUE
  171. * end do
  172. XDEP = SQRT(PSXPME)
  173. * IF(XDEP.GT.1.D-20) THEN
  174. IF(XDEP.GT.xpetit) THEN
  175. DO 236 ID = 1,IDIM
  176. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / XDEP
  177. 236 CONTINUE
  178. * end do
  179. ENDIF
  180. * calcul de la vitesse tangentielle par derivee a gauche
  181. PSN = 0.D0
  182. PSN0 = 0.D0
  183. DO 238 ID = 1,IDIM
  184. PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
  185. PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
  186. 238 CONTINUE
  187. * end do
  188. DO 240 ID = 1,IDIM
  189. XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
  190. & PSN * XPALB(I,ID3+ID))/PDTS2
  191. XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
  192. & PSN0 * XPALB(I,ID3+ID)
  193. 240 CONTINUE
  194. * end do
  195. * calcul de la force de choc
  196. IF (ITYP.EQ.23 .or. ITYP.EQ.123) THEN
  197. CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER,
  198. & XFN,XFT,XPUS,iannul)
  199. ELSE
  200. XVITN = PSN / PDTS2
  201. XVALB(I,IND,3) = XVITN
  202. CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
  203. & ,XFN,XFT,XPUS,iannul)
  204. ENDIF
  205. XVALB(I,IND,1) = XFN
  206. XVALB(I,IND,10) = ABS(XFT)
  207. XVALB(I,IND,12) = XPUS
  208. IPALB(I,2) = IGP
  209.  
  210. IF (IGP .EQ. 1) THEN
  211. PS = 0.D0
  212. DO 20 ID = 1,IDIM
  213. PS = PS + (XPALB(I,ID4+ID)*XPALB(I,ID4+ID))
  214. 20 CONTINUE
  215. XVITT = SQRT(PS)
  216. ELSE
  217. XVITT = 0.D0
  218. ENDIF
  219. XVALB(I,IND,11) = XVITT
  220. * si glissement, memorisation de la vitesse tangentielle et de la force
  221. * tangentielle
  222. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  223. DO 242 ID = 1,IDIM
  224. XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
  225. XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
  226. 242 CONTINUE
  227. * end do
  228. ENDIF
  229. DO 244 ID = 1,IDIM
  230. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFN*XPALB(I,ID3+ID)
  231. & + XPALB(I,ID6+ID)
  232. 244 CONTINUE
  233.  
  234. * --- choc elementaire point_cercle_mobile
  235. * avec ou sans amortissement
  236. * on neglige la rotation (torsion) du cercle
  237.  
  238. cbp ELSE IF (ITYP.EQ.33 .OR. ITYP.EQ.34) THEN
  239. ELSE IF (ITYP.EQ.33 .OR. ITYP.EQ.34
  240. & .or. ITYP.EQ.133 .OR. ITYP.EQ.134) THEN
  241. NPOA = IPLIB(I,1)
  242. NPOB = IPLIB(I,2)
  243. IGP = IPALB(I,2)
  244. IDIM = IPALB(I,3)
  245. cbp INTER = IPALB(I,4)
  246. if (ITYP.LT.100) then
  247. INTER=1
  248. else
  249. INTER=0
  250. endif
  251. IF (ITYP.EQ.33 .or. ITYP.EQ.133) THEN
  252. ID1 = 6
  253. ELSE
  254. ID1 = 7
  255. ENDIF
  256. ID2 = ID1 + IDIM
  257. ID3 = ID1 + 2*IDIM
  258. ID4 = ID1 + 3*IDIM
  259. ID5 = ID1 + 4*IDIM
  260. ID6 = ID1 + 5*IDIM
  261. ID7 = ID1 + 6*IDIM
  262. ID8 = ID1 + 7*IDIM
  263. ID9 = ID1 + 8*IDIM
  264. * si pas d'adherence (c.a.d. glissement ou pas de contact) au pas precedent,
  265. * reactualisation de la position ecart origine d'adherence
  266. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  267. DO 330 ID=1,IDIM
  268. XPALB(I,ID7+ID) = (XPTB(NPOA,IND,ID) +
  269. & FEXPSM(NPOA,NPA,IND1,ID) )
  270. & - ( XPTB(NPOB,IND,ID) +
  271. & FEXPSM(NPOB,NPA,IND1,ID))
  272. 330 CONTINUE
  273. * end do
  274. ENDIF
  275. * calcul du deplacement relatif (PS) sur la normale au plan de section droite
  276. PS = 0.D0
  277. DO 332 ID = 1,IDIM
  278. IDD2 = 3 + ID
  279. XDE2 = XPTB(NPOA,IND,ID) - XPTB(NPOB,IND,ID)
  280. XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  281. & - FEXPSM(NPOb,NPA,IND1,ID)
  282. XVALB(I,IND,IDD2) = XDE2
  283. XDM2 = XPTB(NPOA,IND2,ID) - xptb (npob,ind2,id)
  284. XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
  285. & - FEXPSM(NPOb,NPAM1,INDM1,ID)
  286. XPALB(I,ID4+ID) = XDE2 - XDM2
  287. XPALB(I,ID5+ID) = XDE2 - XPALB(I,ID7+ID)
  288. PS = PS + XDE2 * XPALB(I,ID1+ID)
  289. 332 CONTINUE
  290. * end do
  291.  
  292. * calcul de la valeur du deplacement relatif suivant la normale
  293. * au plan tangent du contact (on tient compte de l'excentrement)
  294. XPME = 0.D0
  295. PSXPME = 0.D0
  296. DO 334 ID = 1,IDIM
  297. XDE2 = XPTB(NPOA,IND,ID) - XPTB(NPOB,IND,ID)
  298. XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  299. & - FEXPSM(NPOb,NPA,IND1,ID)
  300. XPRIM = XDE2 - PS * XPALB(I,ID1+ID)
  301. XPME = XPRIM - (XPALB(I,ID2+ID) -
  302. & XPALB(I,ID2+ID)*XPALB(I,ID1+ID))
  303. XPALB(I,ID3+ID) = XPME
  304. PSXPME = PSXPME + XPME * XPME
  305. 334 CONTINUE
  306. * end do
  307. XDEP = SQRT(PSXPME)
  308.  
  309. * normale au plan tangent
  310. * IF(XDEP.GT.1.D-20) THEN
  311. IF(XDEP.GT.xpetit) THEN
  312. DO 336 ID = 1,IDIM
  313. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / XDEP
  314. 336 CONTINUE
  315. * end do
  316. ENDIF
  317. * calcul de la vitesse relative tangentielle par derivee a gauche
  318. PSN = 0.D0
  319. PSN0 = 0.D0
  320. DO 338 ID = 1,IDIM
  321. PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
  322. PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
  323. 338 CONTINUE
  324. * end do
  325. DO 340 ID = 1,IDIM
  326. XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
  327. & PSN * XPALB(I,ID3+ID))/PDTS2
  328. XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
  329. & PSN0 * XPALB(I,ID3+ID)
  330. 340 CONTINUE
  331. * end do
  332. * calcul de la force de choc
  333. IF (ITYP.EQ.33 .or. ITYP.EQ.133) THEN
  334. CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER
  335. & ,XFN,XFT,XPUS,iannul)
  336. ELSE
  337. XVITN = PSN / PDTS2
  338. XVALB(I,IND,3) = XVITN
  339. CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
  340. & ,XFN,XFT,XPUS,iannul)
  341. ENDIF
  342. XVALB(I,IND,1) = XFN
  343. XVALB(I,IND,10) = ABS(XFT)
  344. XVALB(I,IND,12) = XPUS
  345. IPALB(I,2) = IGP
  346.  
  347. IF (IGP .EQ. 1) THEN
  348. PS = 0.D0
  349. DO 30 ID = 1,IDIM
  350. PS = PS + (XPALB(I,ID4+ID)*XPALB(I,ID4+ID))
  351. 30 CONTINUE
  352. XVITT = SQRT(PS)
  353. ELSE
  354. XVITT = 0.D0
  355. ENDIF
  356. XVALB(I,IND,11) = XVITT
  357. * si pas d'adherence (c.a.d. glissement ou pas de contact)
  358. * memorisation de la vitesse tangentielle et de la force tangentielle
  359. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  360. DO 342 ID = 1,IDIM
  361. XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
  362. XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
  363. 342 CONTINUE
  364. * end do
  365. ENDIF
  366.  
  367. DO 344 ID = 1,IDIM
  368. FTOTB(NPOA,ID) = FTOTB(NPOA,ID) + XFN*XPALB(I,ID3+ID)
  369. & + XPALB(I,ID6+ID)
  370. FTOTB(NPOB,ID) = FTOTB(NPOB,ID) - XFN*XPALB(I,ID3+ID)
  371. & - XPALB(I,ID6+ID)
  372. 344 CONTINUE
  373.  
  374. *
  375. * --- choc elementaire cercle_cercle_frottement
  376. * avec ou sans amortissement
  377. *
  378. cbp ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  379. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26
  380. & .or. ITYP.EQ.125 .OR. ITYP.EQ.126) THEN
  381. NPOI = IPLIB(I,1)
  382. IGP = IPALB(I,2)
  383. IDIM = IPALB(I,3)
  384. cbp INTER = IPALB(I,4)
  385. if (ITYP.LT.100) then
  386. INTER=1
  387. else
  388. INTER=0
  389. endif
  390. IF (ITYP.EQ.25 .or. ITYP.EQ.125) THEN
  391. ID1 = 6
  392. ELSE
  393. ID1 = 7
  394. ENDIF
  395. ID2 = ID1 + IDIM
  396. ID3 = ID1 + 2*IDIM
  397. ID4 = ID1 + 3*IDIM
  398. ID5 = ID1 + 4*IDIM
  399. ID6 = ID1 + 5*IDIM
  400. ID7 = ID1 + 6*IDIM
  401. ID8 = ID1 + 7*IDIM
  402. ID9 = ID1 + 8*IDIM
  403. ID10 = ID1 + 9*IDIM
  404. XRAYT = XPALB(I,ID10+1)
  405. XREXT = XPALB(I,2)
  406. * calcul du deplacement du point fibre neutre dans le plan du cercle
  407. * recuperation de la normale de choc au pas precedent
  408. DO 249 ID = 1,IDIM
  409. XN2(ID)= XPALB(I,ID3+ID)
  410. 249 CONTINUE
  411. * calcul de la normale de choc au pas courant
  412. PSXPN = 0.D0
  413. DO 250 ID = 1,IDIM
  414. PSXPN = PSXPN + ( XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID) )
  415. 250 CONTINUE
  416. * end do
  417. PSXPME = 0.D0
  418. DO 254 ID = 1,IDIM
  419. XXPME = ( XPTB(NPOI,IND,ID) - ( PSXPN * XPALB(I,ID1+ID) ) )
  420. & - XPALB(I,ID2+ID)
  421. XPALB(I,ID3+ID) = XXPME
  422. PSXPME = PSXPME + ( XXPME * XXPME )
  423. 254 CONTINUE
  424. * end do
  425. PSXPME = SQRT(PSXPME)
  426. * IF (PSXPME.GT.1D-20) THEN
  427. IF (PSXPME.GT.xpetit) THEN
  428. DO 256 ID = 1,IDIM
  429. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME
  430. 256 CONTINUE
  431. * end do
  432. ENDIF
  433. * valeur du deplacement du point de contact suivant la normale
  434. XDEP = PSXPME + XRAYT
  435. * calcul du deplacement du point de contact au pas courant
  436. XPTP2(1) = XPTB(NPOI,IND,1) + (XPALB(I,ID3+1)*XRAYT)
  437. XPTP2(2) = XPTB(NPOI,IND,2) + (XPALB(I,ID3+2)*XRAYT)
  438. XPTP2(3) = XPTB(NPOI,IND,3) + (XPALB(I,ID3+3)*XRAYT)
  439. * calcul du deplacement du point de contact au pas precedent
  440. XPTPM2(1) = XPTB(NPOI,IND2,1) + (XN2(1)*XRAYT)
  441. XPTPM2(2) = XPTB(NPOI,IND2,2) + (XN2(2)*XRAYT)
  442. XPTPM2(3) = XPTB(NPOI,IND2,3) + (XN2(3)*XRAYT)
  443. * Vitesse *(-1) du point de contact appartenant a la structure mobile
  444. * due a la rotation absolue
  445. XVPC0(1) = (1.D0/ PDTS2) *
  446. & ( ( XPTB(NPOI,IND2,5) * XPALB(I,ID3+3) * XRAYT ) -
  447. & ( XPTB(NPOI,IND2,6) * XPALB(I,ID3+2) * XRAYT ) -
  448. & ( XPTB(NPOI,IND ,5) * XPALB(I,ID3+3) * XRAYT ) +
  449. & ( XPTB(NPOI,IND ,6) * XPALB(I,ID3+2) * XRAYT ) )
  450. XVPC0(2) = (1.D0/ PDTS2) *
  451. & ( ( XPTB(NPOI,IND2,6) * XPALB(I,ID3+1) * XRAYT ) -
  452. & ( XPTB(NPOI,IND2,4) * XPALB(I,ID3+3) * XRAYT ) -
  453. & ( XPTB(NPOI,IND ,6) * XPALB(I,ID3+1) * XRAYT ) +
  454. & ( XPTB(NPOI,IND ,4) * XPALB(I,ID3+3) * XRAYT ) )
  455. XVPC0(3) = (1.D0/ PDTS2) *
  456. & ( ( XPTB(NPOI,IND2,4) * XPALB(I,ID3+2) * XRAYT ) -
  457. & ( XPTB(NPOI,IND2,5) * XPALB(I,ID3+1) * XRAYT ) -
  458. & ( XPTB(NPOI,IND ,4) * XPALB(I,ID3+2) * XRAYT ) +
  459. & ( XPTB(NPOI,IND ,5) * XPALB(I,ID3+1) * XRAYT ) )
  460. * si glissement au pas precedent, reactualisation de la position
  461. * origine d'adherence a l'aide du point de contact
  462. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  463. DO 257 ID=1,IDIM
  464. XPALB(I,ID7+ID) = XPTP2(ID)
  465. 257 CONTINUE
  466. ELSE
  467. PXVPC0 = 0.D0
  468. DO 258 ID = 1,IDIM
  469. PXVPC0 = PXVPC0 + XVPC0(ID)*XPALB(I,ID1+ID)
  470. 258 CONTINUE
  471. DO 259 ID = 1,IDIM
  472. XVPCT(ID) = XVPC0(ID) - PXVPC0 * XPALB(I,ID1+ID)
  473. 259 CONTINUE
  474. XPALB(I,ID7+1) = XPALB(I,ID7+1) +
  475. & (XVPCT(1)*PDTS2)*(XREXT/(XREXT-XRAYT))
  476. XPALB(I,ID7+2) = XPALB(I,ID7+2) +
  477. & (XVPCT(2)*PDTS2)*(XREXT/(XREXT-XRAYT))
  478. XPALB(I,ID7+3) = XPALB(I,ID7+3) +
  479. & (XVPCT(3)*PDTS2)*(XREXT/(XREXT-XRAYT))
  480. ENDIF
  481. * calcul du deplacement sur la normale au plan de section droite
  482. * et de l'ecart a la position orgine adherencee
  483. DO 260 ID = 1,IDIM
  484. IDD1 = 3 + ID
  485. IDD2 = 6 + ID
  486. IDD3 = 15 + ID
  487. XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
  488. XVALB(I,IND,IDD2) = (XPTP2(ID) - XPTPM2(ID) ) / PDTS2
  489. XVALB(I,IND,IDD3) = XPTB(NPOI,IND,ID+3)
  490. XPALB(I,ID4+ID) = XPTP2(ID) - XPTPM2(ID)
  491. & - (XVPC0(ID) * PDTS2)
  492. XPALB(I,ID5+ID) = XPTP2(ID) - XPALB(I,ID7+ID)
  493. 260 CONTINUE
  494. * end do
  495. * calcul de la vitesse tangentielle par derivee a gauche
  496. * et de l'ecart a la position orgine adherencee
  497. PSN = 0.D0
  498. PSN0 = 0.D0
  499. DO 262 ID = 1,IDIM
  500. PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
  501. PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
  502. 262 CONTINUE
  503. * end do
  504. DO 264 ID = 1,IDIM
  505. XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
  506. & PSN * XPALB(I,ID3+ID))/PDTS2
  507. XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
  508. & PSN0 * XPALB(I,ID3+ID)
  509. 264 CONTINUE
  510. * end do
  511. * calcul de la force de choc
  512. IF (ITYP.EQ.25 .or. ITYP.EQ.125) THEN
  513. CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER
  514. & ,XFN,XFT,XPUS,iannul)
  515. ELSE
  516. XVITN = PSN / PDTS2
  517. XVALB(I,IND,3) = XVITN
  518. CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
  519. & ,XFN,XFT,XPUS,iannul)
  520. ENDIF
  521. XVALB(I,IND,1) = XFN
  522. XVALB(I,IND,10) = ABS(XFT)
  523. XVALB(I,IND,12) = XPUS
  524. IPALB(I,2) = IGP
  525. * si glissement, memorisation de la vitesse tangentielle et de la force
  526. * tangentielle
  527. IF (IGP.EQ.1) THEN
  528. DO 266 ID = 1,IDIM
  529. XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
  530. XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
  531. 266 CONTINUE
  532. ELSE
  533. DO 267 ID = 1,IDIM
  534. XPALB(I,ID9+ID) = 0.D0
  535. 267 CONTINUE
  536. * end do
  537. ENDIF
  538. DO 268 ID = 1,IDIM
  539. XFOR = ( XFN * XPALB(I,ID3+ID) ) + XPALB(I,ID6+ID)
  540. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFOR
  541. XFNT(ID) = XPALB (I ,ID6+ID)
  542. 268 CONTINUE
  543. * end do
  544. XAPP1 = XRAYT * XPALB(I,ID3+1)
  545. XAPP2 = XRAYT * XPALB(I,ID3+2)
  546. XAPP3 = XRAYT * XPALB(I,ID3+3)
  547. XAPFP1 = ( XAPP2 * XFNT(3) ) - ( XAPP3 * XFNT(2) )
  548. XAPFP2 = ( XAPP3 * XFNT(1) ) - ( XAPP1 * XFNT(3) )
  549. XAPFP3 = ( XAPP1 * XFNT(2) ) - ( XAPP2 * XFNT(1) )
  550. XVALB(I,IND,13) = XAPFP1
  551. XVALB(I,IND,14) = XAPFP2
  552. XVALB(I,IND,15) = XAPFP3
  553. FTOTB(NPOI,4) = FTOTB(NPOI,4) + XAPFP1
  554. FTOTB(NPOI,5) = FTOTB(NPOI,5) + XAPFP2
  555. FTOTB(NPOI,6) = FTOTB(NPOI,6) + XAPFP3
  556. *
  557. * --- choc ...........
  558. *
  559. * else if (ityp.eq. ) then
  560. * .......
  561. * .......
  562. *
  563. ENDIF
  564. *
  565. END
  566.  
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  

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