Télécharger devfb3.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFB3 SOURCE CHAT 05/01/12 22:45:25 5004
  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. ELSE IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN
  118. NPOI = IPLIB(I,1)
  119. IGP = IPALB(I,2)
  120. IDIM = IPALB(I,3)
  121. INTER = IPALB(I,4)
  122. IF (ITYP.EQ.23) THEN
  123. ID1 = 6
  124. ELSE
  125. ID1 = 7
  126. ENDIF
  127. ID2 = ID1 + IDIM
  128. ID3 = ID1 + 2*IDIM
  129. ID4 = ID1 + 3*IDIM
  130. ID5 = ID1 + 4*IDIM
  131. ID6 = ID1 + 5*IDIM
  132. ID7 = ID1 + 6*IDIM
  133. ID8 = ID1 + 7*IDIM
  134. ID9 = ID1 + 8*IDIM
  135. * si glissement au pas precedent, reactualisation de la position
  136. * origine d'adherence
  137. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  138. DO 230 ID=1,IDIM
  139. XPALB(I,ID7+ID) = XPTB(NPOI,IND,ID)
  140. 230 CONTINUE
  141. * end do
  142. ENDIF
  143. * calcul du deplacement sur la normale au plan de section droite
  144. PS = 0.D0
  145. DO 232 ID = 1,IDIM
  146. IDD2 = 3 + ID
  147. XVALB(I,IND,IDD2) = XPTB(NPOI,IND,ID)
  148. XPALB(I,ID4+ID) = XPTB(NPOI,IND,ID) - XPTB(NPOI,IND2,ID)
  149. XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID) - XPALB(I,ID7+ID)
  150. PS = PS + XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID)
  151. 232 CONTINUE
  152. * end do
  153. * calcul de la normale au plan tangent du contact, et de la valeur du
  154. * deplacement suivant cette normale
  155. XPME = 0.D0
  156. PSXPME = 0.D0
  157. DO 234 ID = 1,IDIM
  158. XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
  159. XPME = XPRIM - XPALB(I,ID2+ID)
  160. XPALB(I,ID3+ID) = XPME
  161. PSXPME = PSXPME + XPME * XPME
  162. 234 CONTINUE
  163. * end do
  164. XDEP = SQRT(PSXPME)
  165. * IF(XDEP.GT.1.D-20) THEN
  166. IF(XDEP.GT.xpetit) THEN
  167. DO 236 ID = 1,IDIM
  168. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / XDEP
  169. 236 CONTINUE
  170. * end do
  171. ENDIF
  172. * calcul de la vitesse tangentielle par derivee a gauche
  173. PSN = 0.D0
  174. PSN0 = 0.D0
  175. DO 238 ID = 1,IDIM
  176. PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
  177. PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
  178. 238 CONTINUE
  179. * end do
  180. DO 240 ID = 1,IDIM
  181. XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
  182. & PSN * XPALB(I,ID3+ID))/PDTS2
  183. XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
  184. & PSN0 * XPALB(I,ID3+ID)
  185. 240 CONTINUE
  186. * end do
  187. * calcul de la force de choc
  188. IF (ITYP.EQ.23) THEN
  189. CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER,
  190. & XFN,XFT,XPUS,iannul)
  191. ELSE
  192. XVITN = PSN / PDTS2
  193. XVALB(I,IND,3) = XVITN
  194. CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
  195. & ,XFN,XFT,XPUS,iannul)
  196. ENDIF
  197. XVALB(I,IND,1) = XFN
  198. XVALB(I,IND,10) = ABS(XFT)
  199. XVALB(I,IND,12) = XPUS
  200. IPALB(I,2) = IGP
  201.  
  202. IF (IGP .EQ. 1) THEN
  203. PS = 0.D0
  204. DO 20 ID = 1,IDIM
  205. PS = PS + (XPALB(I,ID4+ID)*XPALB(I,ID4+ID))
  206. 20 CONTINUE
  207. XVITT = SQRT(PS)
  208. ELSE
  209. XVITT = 0.D0
  210. ENDIF
  211. XVALB(I,IND,11) = XVITT
  212. * si glissement, memorisation de la vitesse tangentielle et de la force
  213. * tangentielle
  214. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  215. DO 242 ID = 1,IDIM
  216. XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
  217. XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
  218. 242 CONTINUE
  219. * end do
  220. ENDIF
  221. DO 244 ID = 1,IDIM
  222. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFN*XPALB(I,ID3+ID)
  223. & + XPALB(I,ID6+ID)
  224. 244 CONTINUE
  225.  
  226. * --- choc elementaire point_cercle_mobile
  227. * avec ou sans amortissement
  228. * on neglige la rotation (torsion) du cercle
  229.  
  230. ELSE IF (ITYP.EQ.33 .OR. ITYP.EQ.34) THEN
  231. NPOA = IPLIB(I,1)
  232. NPOB = IPLIB(I,2)
  233. IGP = IPALB(I,2)
  234. IDIM = IPALB(I,3)
  235. INTER = IPALB(I,4)
  236. IF (ITYP.EQ.33) THEN
  237. ID1 = 6
  238. ELSE
  239. ID1 = 7
  240. ENDIF
  241. ID2 = ID1 + IDIM
  242. ID3 = ID1 + 2*IDIM
  243. ID4 = ID1 + 3*IDIM
  244. ID5 = ID1 + 4*IDIM
  245. ID6 = ID1 + 5*IDIM
  246. ID7 = ID1 + 6*IDIM
  247. ID8 = ID1 + 7*IDIM
  248. ID9 = ID1 + 8*IDIM
  249. * si pas d'adherence (c.a.d. glissement ou pas de contact) au pas precedent,
  250. * reactualisation de la position ecart origine d'adherence
  251. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  252. DO 330 ID=1,IDIM
  253. XPALB(I,ID7+ID) = (XPTB(NPOA,IND,ID) +
  254. & FEXPSM(NPOA,NPA,IND1,ID) )
  255. & - ( XPTB(NPOB,IND,ID) +
  256. & FEXPSM(NPOB,NPA,IND1,ID))
  257. 330 CONTINUE
  258. * end do
  259. ENDIF
  260. * calcul du deplacement relatif (PS) sur la normale au plan de section droite
  261. PS = 0.D0
  262. DO 332 ID = 1,IDIM
  263. IDD2 = 3 + ID
  264. XDE2 = XPTB(NPOA,IND,ID) - XPTB(NPOB,IND,ID)
  265. XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  266. & - FEXPSM(NPOb,NPA,IND1,ID)
  267. XVALB(I,IND,IDD2) = XDE2
  268. XDM2 = XPTB(NPOA,IND2,ID) - xptb (npob,ind2,id)
  269. XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
  270. & - FEXPSM(NPOb,NPAM1,INDM1,ID)
  271. XPALB(I,ID4+ID) = XDE2 - XDM2
  272. XPALB(I,ID5+ID) = XDE2 - XPALB(I,ID7+ID)
  273. PS = PS + XDE2 * XPALB(I,ID1+ID)
  274. 332 CONTINUE
  275. * end do
  276.  
  277. * calcul de la valeur du deplacement relatif suivant la normale
  278. * au plan tangent du contact (on tient compte de l'excentrement)
  279. XPME = 0.D0
  280. PSXPME = 0.D0
  281. DO 334 ID = 1,IDIM
  282. XDE2 = XPTB(NPOA,IND,ID) - XPTB(NPOB,IND,ID)
  283. XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  284. & - FEXPSM(NPOb,NPA,IND1,ID)
  285. XPRIM = XDE2 - PS * XPALB(I,ID1+ID)
  286. XPME = XPRIM - (XPALB(I,ID2+ID) -
  287. & XPALB(I,ID2+ID)*XPALB(I,ID1+ID))
  288. XPALB(I,ID3+ID) = XPME
  289. PSXPME = PSXPME + XPME * XPME
  290. 334 CONTINUE
  291. * end do
  292. XDEP = SQRT(PSXPME)
  293.  
  294. * normale au plan tangent
  295. * IF(XDEP.GT.1.D-20) THEN
  296. IF(XDEP.GT.xpetit) THEN
  297. DO 336 ID = 1,IDIM
  298. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / XDEP
  299. 336 CONTINUE
  300. * end do
  301. ENDIF
  302. * calcul de la vitesse relative tangentielle par derivee a gauche
  303. PSN = 0.D0
  304. PSN0 = 0.D0
  305. DO 338 ID = 1,IDIM
  306. PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
  307. PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
  308. 338 CONTINUE
  309. * end do
  310. DO 340 ID = 1,IDIM
  311. XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
  312. & PSN * XPALB(I,ID3+ID))/PDTS2
  313. XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
  314. & PSN0 * XPALB(I,ID3+ID)
  315. 340 CONTINUE
  316. * end do
  317. * calcul de la force de choc
  318. IF (ITYP.EQ.33) THEN
  319. CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER
  320. & ,XFN,XFT,XPUS,iannul)
  321. ELSE
  322. XVITN = PSN / PDTS2
  323. XVALB(I,IND,3) = XVITN
  324. CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
  325. & ,XFN,XFT,XPUS,iannul)
  326. ENDIF
  327. XVALB(I,IND,1) = XFN
  328. XVALB(I,IND,10) = ABS(XFT)
  329. XVALB(I,IND,12) = XPUS
  330. IPALB(I,2) = IGP
  331.  
  332. IF (IGP .EQ. 1) THEN
  333. PS = 0.D0
  334. DO 30 ID = 1,IDIM
  335. PS = PS + (XPALB(I,ID4+ID)*XPALB(I,ID4+ID))
  336. 30 CONTINUE
  337. XVITT = SQRT(PS)
  338. ELSE
  339. XVITT = 0.D0
  340. ENDIF
  341. XVALB(I,IND,11) = XVITT
  342. * si pas d'adherence (c.a.d. glissement ou pas de contact)
  343. * memorisation de la vitesse tangentielle et de la force tangentielle
  344. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  345. DO 342 ID = 1,IDIM
  346. XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
  347. XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
  348. 342 CONTINUE
  349. * end do
  350. ENDIF
  351.  
  352. DO 344 ID = 1,IDIM
  353. FTOTB(NPOA,ID) = FTOTB(NPOA,ID) + XFN*XPALB(I,ID3+ID)
  354. & + XPALB(I,ID6+ID)
  355. FTOTB(NPOB,ID) = FTOTB(NPOB,ID) - XFN*XPALB(I,ID3+ID)
  356. & - XPALB(I,ID6+ID)
  357. 344 CONTINUE
  358.  
  359. *
  360. * --- choc elementaire cercle_cercle_frottement
  361. * avec ou sans amortissement
  362. *
  363. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  364. NPOI = IPLIB(I,1)
  365. IGP = IPALB(I,2)
  366. IDIM = IPALB(I,3)
  367. INTER = IPALB(I,4)
  368. IF (ITYP.EQ.25) THEN
  369. ID1 = 6
  370. ELSE
  371. ID1 = 7
  372. ENDIF
  373. ID2 = ID1 + IDIM
  374. ID3 = ID1 + 2*IDIM
  375. ID4 = ID1 + 3*IDIM
  376. ID5 = ID1 + 4*IDIM
  377. ID6 = ID1 + 5*IDIM
  378. ID7 = ID1 + 6*IDIM
  379. ID8 = ID1 + 7*IDIM
  380. ID9 = ID1 + 8*IDIM
  381. ID10 = ID1 + 9*IDIM
  382. XRAYT = XPALB(I,ID10+1)
  383. XREXT = XPALB(I,2)
  384. * calcul du deplacement du point fibre neutre dans le plan du cercle
  385. * recuperation de la normale de choc au pas precedent
  386. DO 249 ID = 1,IDIM
  387. XN2(ID)= XPALB(I,ID3+ID)
  388. 249 CONTINUE
  389. * calcul de la normale de choc au pas courant
  390. PSXPN = 0.D0
  391. DO 250 ID = 1,IDIM
  392. PSXPN = PSXPN + ( XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID) )
  393. 250 CONTINUE
  394. * end do
  395. PSXPME = 0.D0
  396. DO 254 ID = 1,IDIM
  397. XXPME = ( XPTB(NPOI,IND,ID) - ( PSXPN * XPALB(I,ID1+ID) ) )
  398. & - XPALB(I,ID2+ID)
  399. XPALB(I,ID3+ID) = XXPME
  400. PSXPME = PSXPME + ( XXPME * XXPME )
  401. 254 CONTINUE
  402. * end do
  403. PSXPME = SQRT(PSXPME)
  404. * IF (PSXPME.GT.1D-20) THEN
  405. IF (PSXPME.GT.xpetit) THEN
  406. DO 256 ID = 1,IDIM
  407. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME
  408. 256 CONTINUE
  409. * end do
  410. ENDIF
  411. * valeur du deplacement du point de contact suivant la normale
  412. XDEP = PSXPME + XRAYT
  413. * calcul du deplacement du point de contact au pas courant
  414. XPTP2(1) = XPTB(NPOI,IND,1) + (XPALB(I,ID3+1)*XRAYT)
  415. XPTP2(2) = XPTB(NPOI,IND,2) + (XPALB(I,ID3+2)*XRAYT)
  416. XPTP2(3) = XPTB(NPOI,IND,3) + (XPALB(I,ID3+3)*XRAYT)
  417. * calcul du deplacement du point de contact au pas precedent
  418. XPTPM2(1) = XPTB(NPOI,IND2,1) + (XN2(1)*XRAYT)
  419. XPTPM2(2) = XPTB(NPOI,IND2,2) + (XN2(2)*XRAYT)
  420. XPTPM2(3) = XPTB(NPOI,IND2,3) + (XN2(3)*XRAYT)
  421. * Vitesse *(-1) du point de contact appartenant a la structure mobile
  422. * due a la rotation absolue
  423. XVPC0(1) = (1.D0/ PDTS2) *
  424. & ( ( XPTB(NPOI,IND2,5) * XPALB(I,ID3+3) * XRAYT ) -
  425. & ( XPTB(NPOI,IND2,6) * XPALB(I,ID3+2) * XRAYT ) -
  426. & ( XPTB(NPOI,IND ,5) * XPALB(I,ID3+3) * XRAYT ) +
  427. & ( XPTB(NPOI,IND ,6) * XPALB(I,ID3+2) * XRAYT ) )
  428. XVPC0(2) = (1.D0/ PDTS2) *
  429. & ( ( XPTB(NPOI,IND2,6) * XPALB(I,ID3+1) * XRAYT ) -
  430. & ( XPTB(NPOI,IND2,4) * XPALB(I,ID3+3) * XRAYT ) -
  431. & ( XPTB(NPOI,IND ,6) * XPALB(I,ID3+1) * XRAYT ) +
  432. & ( XPTB(NPOI,IND ,4) * XPALB(I,ID3+3) * XRAYT ) )
  433. XVPC0(3) = (1.D0/ PDTS2) *
  434. & ( ( XPTB(NPOI,IND2,4) * XPALB(I,ID3+2) * XRAYT ) -
  435. & ( XPTB(NPOI,IND2,5) * XPALB(I,ID3+1) * XRAYT ) -
  436. & ( XPTB(NPOI,IND ,4) * XPALB(I,ID3+2) * XRAYT ) +
  437. & ( XPTB(NPOI,IND ,5) * XPALB(I,ID3+1) * XRAYT ) )
  438. * si glissement au pas precedent, reactualisation de la position
  439. * origine d'adherence a l'aide du point de contact
  440. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  441. DO 257 ID=1,IDIM
  442. XPALB(I,ID7+ID) = XPTP2(ID)
  443. 257 CONTINUE
  444. ELSE
  445. PXVPC0 = 0.D0
  446. DO 258 ID = 1,IDIM
  447. PXVPC0 = PXVPC0 + XVPC0(ID)*XPALB(I,ID1+ID)
  448. 258 CONTINUE
  449. DO 259 ID = 1,IDIM
  450. XVPCT(ID) = XVPC0(ID) - PXVPC0 * XPALB(I,ID1+ID)
  451. 259 CONTINUE
  452. XPALB(I,ID7+1) = XPALB(I,ID7+1) +
  453. & (XVPCT(1)*PDTS2)*(XREXT/(XREXT-XRAYT))
  454. XPALB(I,ID7+2) = XPALB(I,ID7+2) +
  455. & (XVPCT(2)*PDTS2)*(XREXT/(XREXT-XRAYT))
  456. XPALB(I,ID7+3) = XPALB(I,ID7+3) +
  457. & (XVPCT(3)*PDTS2)*(XREXT/(XREXT-XRAYT))
  458. ENDIF
  459. * calcul du deplacement sur la normale au plan de section droite
  460. * et de l'ecart a la position orgine adherencee
  461. DO 260 ID = 1,IDIM
  462. IDD1 = 3 + ID
  463. IDD2 = 6 + ID
  464. IDD3 = 15 + ID
  465. XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
  466. XVALB(I,IND,IDD2) = (XPTP2(ID) - XPTPM2(ID) ) / PDTS2
  467. XVALB(I,IND,IDD3) = XPTB(NPOI,IND,ID+3)
  468. XPALB(I,ID4+ID) = XPTP2(ID) - XPTPM2(ID)
  469. & - (XVPC0(ID) * PDTS2)
  470. XPALB(I,ID5+ID) = XPTP2(ID) - XPALB(I,ID7+ID)
  471. 260 CONTINUE
  472. * end do
  473. * calcul de la vitesse tangentielle par derivee a gauche
  474. * et de l'ecart a la position orgine adherencee
  475. PSN = 0.D0
  476. PSN0 = 0.D0
  477. DO 262 ID = 1,IDIM
  478. PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
  479. PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
  480. 262 CONTINUE
  481. * end do
  482. DO 264 ID = 1,IDIM
  483. XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
  484. & PSN * XPALB(I,ID3+ID))/PDTS2
  485. XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
  486. & PSN0 * XPALB(I,ID3+ID)
  487. 264 CONTINUE
  488. * end do
  489. * calcul de la force de choc
  490. IF (ITYP.EQ.25) THEN
  491. CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER
  492. & ,XFN,XFT,XPUS,iannul)
  493. ELSE
  494. XVITN = PSN / PDTS2
  495. XVALB(I,IND,3) = XVITN
  496. CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
  497. & ,XFN,XFT,XPUS,iannul)
  498. ENDIF
  499. XVALB(I,IND,1) = XFN
  500. XVALB(I,IND,10) = ABS(XFT)
  501. XVALB(I,IND,12) = XPUS
  502. IPALB(I,2) = IGP
  503. * si glissement, memorisation de la vitesse tangentielle et de la force
  504. * tangentielle
  505. IF (IGP.EQ.1) THEN
  506. DO 266 ID = 1,IDIM
  507. XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
  508. XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
  509. 266 CONTINUE
  510. ELSE
  511. DO 267 ID = 1,IDIM
  512. XPALB(I,ID9+ID) = 0.D0
  513. 267 CONTINUE
  514. * end do
  515. ENDIF
  516. DO 268 ID = 1,IDIM
  517. XFOR = ( XFN * XPALB(I,ID3+ID) ) + XPALB(I,ID6+ID)
  518. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFOR
  519. XFNT(ID) = XPALB (I ,ID6+ID)
  520. 268 CONTINUE
  521. * end do
  522. XAPP1 = XRAYT * XPALB(I,ID3+1)
  523. XAPP2 = XRAYT * XPALB(I,ID3+2)
  524. XAPP3 = XRAYT * XPALB(I,ID3+3)
  525. XAPFP1 = ( XAPP2 * XFNT(3) ) - ( XAPP3 * XFNT(2) )
  526. XAPFP2 = ( XAPP3 * XFNT(1) ) - ( XAPP1 * XFNT(3) )
  527. XAPFP3 = ( XAPP1 * XFNT(2) ) - ( XAPP2 * XFNT(1) )
  528. XVALB(I,IND,13) = XAPFP1
  529. XVALB(I,IND,14) = XAPFP2
  530. XVALB(I,IND,15) = XAPFP3
  531. FTOTB(NPOI,4) = FTOTB(NPOI,4) + XAPFP1
  532. FTOTB(NPOI,5) = FTOTB(NPOI,5) + XAPFP2
  533. FTOTB(NPOI,6) = FTOTB(NPOI,6) + XAPFP3
  534. *
  535. * --- choc ...........
  536. *
  537. * else if (ityp.eq. ) then
  538. * .......
  539. * .......
  540. *
  541. ENDIF
  542. *
  543. END
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  

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