Télécharger devfb1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFB1 SOURCE CHAT 05/01/12 22:45:16 5004
  2. SUBROUTINE DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
  3. & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
  4. & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. * *
  9. * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * Calcul des forces de choc sur base B pour les liaisons de *
  13. * type POINT_PLAN. *
  14. * *
  15. * Param}tres: *
  16. * *
  17. * e ITYP type de la liaison. *
  18. * es FTOTB Forces ext{rieures totalis{es sur la base B. *
  19. * e XPTB Tableau des d{placements des points *
  20. * e IPALB Renseigne sur la liaison. *
  21. * e IPLIB Tableau contenant les num{ros "DYNE" de la liaison. *
  22. * e XPALB Tableau contenant les param}tres 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 cr{ation: *
  31. * *
  32. * Lionel VIVAN : le 22 Septembre 1989 : Cr{ation *
  33. * Bertrand BEAUFILS : le 31 Mai 1990 : Ajout frottement sec*
  34. * *
  35. *--------------------------------------------------------------------*
  36. *
  37. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  38. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
  39. REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  40. REAL*8 XPTP2(3),XPTPP2(3),XFNT(3),XPSMP(3),XPSMPM(3)
  41. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  42. *
  43. * --- choc {l{mentaire POINT_PLAN
  44. * avec ou sans amortissement
  45. *
  46. IF (ITYP.EQ.1 .OR. ITYP.EQ.100
  47. & .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN
  48. NPOI = IPLIB(I,1)
  49. IDIM = IPALB(I,3)
  50. IPERM = IPALB(I,4)
  51. XRAID = XPALB(I,1)
  52. XJEU = XPALB(I,2)
  53. XAMO = XPALB(I,3)
  54. IF (ITYP.EQ.1 .OR. ITYP.EQ.102) THEN
  55. ID1 = 3
  56. ** ianis
  57. ELSE
  58. ID1 = 4
  59. XSEUIL = XPALB(I,ID1)
  60. XDPLAS = XPALB(I,(ID1+IDIM+1))
  61. ENDIF
  62. *
  63.  
  64. XDEP = 0.D0
  65. DO 10 ID = 1,IDIM
  66. IDD1 = 3 + ID
  67. XDE2 = XPTB(NPOI,IND,ID)
  68. XVALB(I,IND,IDD1) = XDE2
  69. XDE2 = XDE2 + FEXPSM(NPOI,NPA,IND1,ID)
  70. XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  71. 10 CONTINUE
  72. * end do
  73. XDEPM1 = 0.D0
  74. DO 12 ID = 1,IDIM
  75. XDM2 = XPTB(NPOI,IND2,ID) + FEXPSM(NPOI,NPAM1,INDM1,ID)
  76. XDEPM1 = XDEPM1 + XDM2 * XPALB(I,ID1+ID)
  77. 12 CONTINUE
  78. * end do
  79. XVIT = (XDEP - XDEPM1) / PDTS2
  80. XVALB(I,IND,3) = XVIT
  81. ** ianis
  82.  
  83. IF (ITYP.EQ.1) THEN
  84. CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,XFL,IPERM,iannul)
  85.  
  86. ELSE IF (ITYP.EQ.102) THEN
  87. CALL DYCHAM2(XDEP,XVIT,XJEU,XAMO,XABSCI,XORDON,NIP,
  88. & NLIAB,I,XFL,IPERM,iannul)
  89. ELSE IF (ITYP.EQ.101) THEN
  90. CALL DYCHPL2(XDEP,XVIT,XDPLAS,XRAID,XJEU,XAMO,XSEUIL,
  91. & XABSCI,XORDON,NIP,NLIAB,I,XFL,IPERM,iannul)
  92. ELSE IF (ITYP.EQ.100) THEN
  93. CALL DYCHPL(XDEP,XVIT,XDPLAS,XRAID,XJEU,XAMO,XSEUIL,
  94. & XFL,IPERM,iannul)
  95.  
  96. ENDIF
  97. IF (ITYP.EQ.100 .OR. ITYP.EQ.101) THEN
  98. XPALB(I,(ID1+IDIM+1)) = XDPLAS
  99. XVALB(I,IND,13) = XDPLAS
  100. ENDIF
  101. *
  102.  
  103. XVALB(I,IND,1) = XFL
  104. DO 14 ID = 1,IDIM
  105. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFL * XPALB(I,ID1+ID)
  106. 14 CONTINUE
  107. * end do
  108. *
  109. * --- choc {l{mentaire POINT_PLAN_FROTTEMENT
  110. * avec ou sans amortissement
  111. *
  112. ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.103) THEN
  113. NPOI = IPLIB(I,1)
  114. IGP = IPALB(I,2)
  115. IDIM = IPALB(I,3)
  116. ID1 = 7
  117. ID2 = ID1 + IDIM
  118. ID3 = ID1 + 2*IDIM
  119. ID4 = ID1 + 3*IDIM
  120. ID5 = ID1 + 4*IDIM
  121. ID6 = ID1 + 5*IDIM
  122. ID7 = ID1 + 6*IDIM
  123. * Si glissement au pas pr{c{dent, r{actualisation de la position
  124. * origine d'adh{rence
  125. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  126. DO 30 ID=1,IDIM
  127. XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID) +
  128. & FEXPSM(NPOI,NPA,IND1,ID)
  129. 30 CONTINUE
  130. * end do
  131. ENDIF
  132. * Calcul de l'enfoncement et de la vitesse normale
  133. XDEP = 0.D0
  134. PSN = 0.D0
  135. PSN0 = 0.D0
  136. DO 32 ID = 1,IDIM
  137. IDD1 = 3 + ID
  138. XDE2 = XPTB(NPOI,IND,ID)
  139. XDM2 = XPTB(NPOI,IND2,ID)
  140. XVALB(I,IND,IDD1) = XDE2
  141. XDE2 = XDE2 + FEXPSM(NPOI,NPA,IND1,ID)
  142. XDM2 = XDM2 + FEXPSM(NPOI,NPAM1,INDM1,ID)
  143. XPALB(I,ID2+ID) = XDE2 - XDM2
  144. XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
  145. XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  146. PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
  147. PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
  148. 32 CONTINUE
  149. * end do
  150. * Projette la vitesse et la variation de d{placement par rapport a
  151. * la position origine d'adh{rence sur le plan tangent
  152. DO 34 ID = 1,IDIM
  153. XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
  154. & / PDTS2
  155. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
  156. 34 CONTINUE
  157. * end do
  158. XVITN = PSN / PDTS2
  159. XVALB(I,IND,3) = XVITN
  160. IF (ITYP.EQ.3) THEN
  161. CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
  162. & iannul)
  163. ELSE
  164. CALL DYCHA41(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
  165. & XABSCI,XORDON,NIP,iannul)
  166. ENDIF
  167. XVALB(I,IND,1) = XFN
  168. XVALB(I,IND,10) = ABS(XFT)
  169. XVALB(I,IND,12) = XPUS
  170. IPALB(I,2) = IGP
  171.  
  172. IF (IGP .EQ. 1) THEN
  173. PS = 0.D0
  174. DO 20 ID = 1,IDIM
  175. PS = PS + (XPALB(I,ID2+ID)*XPALB(I,ID2+ID))
  176. 20 CONTINUE
  177. XVITT = SQRT(PS)
  178. ELSE
  179. XVITT = 0.D0
  180. ENDIF
  181. XVALB(I,IND,11) = XVITT
  182. * Si glissement, m{morisation de la vitesse tangentielle et de la force
  183. * tangentielle
  184. IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
  185. DO 36 ID = 1,IDIM
  186. XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
  187. XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
  188. 36 CONTINUE
  189. * end do
  190. ENDIF
  191. DO 38 ID = 1,IDIM
  192. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFN * XPALB(I,ID1+ID)
  193. & + XPALB(I,ID4+ID)
  194. 38 CONTINUE
  195. * end do
  196. *
  197. * --- choc {l{mentaire CERCLE_PLAN_FROTTEMENT
  198. * avec ou sans amortissement
  199. *
  200. ELSE IF (ITYP.EQ.5 .OR. ITYP.EQ.6) THEN
  201. NPOI = IPLIB(I,1)
  202. IGP = IPALB(I,2)
  203. IDIM = IPALB(I,3)
  204. IF (ITYP.EQ.5) THEN
  205. ID1 = 6
  206. ELSE
  207. ID1 = 7
  208. ENDIF
  209. ID2 = ID1 + IDIM
  210. ID3 = ID1 + 2*IDIM
  211. ID4 = ID1 + 3*IDIM
  212. ID5 = ID1 + 4*IDIM
  213. ID6 = ID1 + 5*IDIM
  214. ID7 = ID1 + 6*IDIM
  215. ID8 = ID1 + 1 + 7*IDIM
  216. * calcul du d{placement du point de contact au pas pr{c{dent
  217. XMP1 = XPALB(I,ID1+1) * XPALB(I,ID8)
  218. XMP2 = XPALB(I,ID1+2) * XPALB(I,ID8)
  219. XMP3 = XPALB(I,ID1+3) * XPALB(I,ID8)
  220. XPTPP2(1) = XPTB(NPOI,IND2,1) +
  221. & ( ( XPTB(NPOI,IND2,5) * XMP3 ) -
  222. & ( XPTB(NPOI,IND2,6) * XMP2 ) )
  223. XPTPP2(2) = XPTB(NPOI,IND2,2) +
  224. & ( ( XPTB(NPOI,IND2,6) * XMP1 ) -
  225. & ( XPTB(NPOI,IND2,4) * XMP3 ) )
  226. XPTPP2(3) = XPTB(NPOI,IND2,3) +
  227. & ( ( XPTB(NPOI,IND2,4) * XMP2 ) -
  228. & ( XPTB(NPOI,IND2,5) * XMP1 ) )
  229. XPSMPM(1) = FEXPSM(NPOI,NPAM1,INDM1,1) +
  230. & ( ( FEXPSM(NPOI,NPAM1,INDM1,5) * XMP3 ) -
  231. & ( FEXPSM(NPOI,NPAM1,INDM1,6) * XMP2 ) )
  232. XPSMPM(2) = FEXPSM(NPOI,NPAM1,INDM1,2) +
  233. & ( ( FEXPSM(NPOI,NPAM1,INDM1,6) * XMP1 ) -
  234. & ( FEXPSM(NPOI,NPAM1,INDM1,4) * XMP3 ) )
  235. XPSMPM(3) = FEXPSM(NPOI,NPAM1,INDM1,3) +
  236. & ( ( FEXPSM(NPOI,NPAM1,INDM1,4) * XMP2 ) -
  237. & ( FEXPSM(NPOI,NPAM1,INDM1,5) * XMP1 ) )
  238. * calcul du d{placement du point de contact au pas courant
  239. XPTP2(1) = XPTB(NPOI,IND,1) +
  240. & ( ( XPTB(NPOI,IND,5) * XMP3 ) -
  241. & ( XPTB(NPOI,IND,6) * XMP2 ) )
  242. XPTP2(2) = XPTB(NPOI,IND,2) +
  243. & ( ( XPTB(NPOI,IND,6) * XMP1 ) -
  244. & ( XPTB(NPOI,IND,4) * XMP3 ) )
  245. XPTP2(3) = XPTB(NPOI,IND,3) +
  246. & ( ( XPTB(NPOI,IND,4) * XMP2 ) -
  247. & ( XPTB(NPOI,IND,5) * XMP1 ) )
  248. XPSMP(1) = FEXPSM(NPOI,NPA,IND1,1) +
  249. & ( ( FEXPSM(NPOI,NPA,IND1,5) * XMP3 ) -
  250. & ( FEXPSM(NPOI,NPA,IND1,6) * XMP2 ) )
  251. XPSMP(2) = FEXPSM(NPOI,NPA,IND1,2) +
  252. & ( ( FEXPSM(NPOI,NPA,IND1,6) * XMP1 ) -
  253. & ( FEXPSM(NPOI,NPA,IND1,4) * XMP3 ) )
  254. XPSMP(3) = FEXPSM(NPOI,NPA,IND1,3) +
  255. & ( ( FEXPSM(NPOI,NPA,IND1,4) * XMP2 ) -
  256. & ( FEXPSM(NPOI,NPA,IND1,5) * XMP1 ) )
  257. *
  258. * Si glissement au pas pr{c{dent, r{actualisation de la position
  259. * origine d'adh{rence
  260. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  261. DO 50 ID=1,IDIM
  262. XPALB(I,ID5+ID) = XPTP2(ID) + XPSMP(ID)
  263. 50 CONTINUE
  264. * end do
  265. ENDIF
  266. * Calcul de l'enfoncement et de la vitesse normale
  267. XDEP = 0.D0
  268. PSN = 0.D0
  269. PSN0 = 0.D0
  270. DO 52 ID = 1,IDIM
  271. IDD1 = 3 + ID
  272. IDD2 = 6 + ID
  273. IDD3 = 15 + ID
  274. XDE2 = XPTP2(ID)
  275. XDM2 = XPTPP2(ID)
  276. XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
  277. XVALB(I,IND,IDD2) = (xDE2 - xdm2 ) / pdts2
  278. XVALB(I,IND,IDD3) = XPTB(NPOI,IND,ID+3)
  279. XDE2 = XDE2 + XPSMP(ID)
  280. XDM2 = XDM2 + XPSMPM(ID)
  281. XPALB(I,ID2+ID) = XDE2 - XDM2
  282. XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
  283. XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  284. PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
  285. PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
  286. 52 CONTINUE
  287. * end do
  288. * Projette la vitesse et la variation de d{placement par rapport a
  289. * la position origine d'adh{rence sur le plan tangent
  290. DO 54 ID = 1,IDIM
  291. XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
  292. & / PDTS2
  293. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
  294. 54 CONTINUE
  295. * end do
  296. IF (ITYP.EQ.5) THEN
  297. CALL DYCHE4(XDEP,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
  298. & iannul)
  299. ELSE
  300. XVITN = PSN / PDTS2
  301. XVALB(I,IND,3) = XVITN
  302. CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
  303. & iannul)
  304. ENDIF
  305. XVALB(I,IND,1) = XFN
  306. XVALB(I,IND,10) = ABS(XFT)
  307. XVALB(I,IND,12) = XPUS
  308. IPALB(I,2) = IGP
  309. * Si glissement, m{morisation de la vitesse tangentielle et de la force
  310. * tangentielle
  311. IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
  312. DO 56 ID = 1,IDIM
  313. XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
  314. XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
  315. 56 CONTINUE
  316. * end do
  317. ENDIF
  318. DO 58 ID = 1,IDIM
  319. XFOR = ( XFN * XPALB(I,ID1+ID) ) + XPALB(I,ID4+ID)
  320. XFNT(ID) = XFOR
  321. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFOR
  322. 58 CONTINUE
  323. * end do
  324. XMPFP1 = ( XMP2 * XFNT(3) ) - ( XMP3 * XFNT(2) )
  325. XMPFP2 = ( XMP3 * XFNT(1) ) - ( XMP1 * XFNT(3) )
  326. XMPFP3 = ( XMP1 * XFNT(2) ) - ( XMP2 * XFNT(1) )
  327. XVALB(I,IND,13) = XMPFP1
  328. XVALB(I,IND,14) = XMPFP2
  329. XVALB(I,IND,15) = XMPFP3
  330. FTOTB(NPOI,4) = FTOTB(NPOI,4) + XMPFP1
  331. FTOTB(NPOI,5) = FTOTB(NPOI,5) + XMPFP2
  332. FTOTB(NPOI,6) = FTOTB(NPOI,6) + XMPFP3
  333. *
  334. * --- choc {l{mentaire POINT_PLAN_FLUIDE
  335. *
  336. ELSE IF (ITYP.EQ.7) THEN
  337. NPOI = IPLIB(I,1)
  338. IDIM = IPALB(I,3)
  339. XINER = XPALB(I,1)
  340. XCONV = XPALB(I,2)
  341. XVISC = XPALB(I,3)
  342. XPCEL = XPALB(I,4)
  343. XPCRA = XPALB(I,5)
  344. XJEU = XPALB(I,6)
  345. ID1 = 6
  346. ID2 = ID1 + IDIM
  347. XDEP = 0.D0
  348. DO 70 ID = 1,IDIM
  349. XDE2 = XPTB(NPOI,IND,ID)
  350. XVALB(I,IND,ID) = XDE2
  351. XDE2 = XDE2 + FEXPSM(NPOI,NPA,IND1,ID)
  352. XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  353. 70 CONTINUE
  354. * end do
  355. XDEPM1 = XPALB(I,ID2+1)
  356. XVITM1 = XPALB(I,ID2+2)
  357. XACCM1 = XPALB(I,ID2+3)
  358. XVIT = (XDEP - XDEPM1) / PDTS2
  359. XACC = (XVIT - XVITM1) / PDTS2
  360. XPALB(I,ID2+1) = XDEP
  361. XPALB(I,ID2+2) = XVIT
  362. XPALB(I,ID2+3) = XACC
  363. XDH = XJEU - XDEP
  364. * Calcul de la force d'inertie
  365. CALL DYFINE(XDH,XDEP,XACC,XJEU,XINER,XFI,iannul)
  366. * Calcul de la force de convection
  367. CALL DYFCON(XDH,XDEP,XVIT,XJEU,XCONV,XFC,iannul)
  368. * Calcul de la force de viscosit{
  369. CALL DYFVIS(XDH,XDEP,XVIT,XJEU,XVISC,XFV,iannul)
  370. * Calcul de la force de perte de charge
  371. CALL DYFPDC(XDH,XDEP,XVIT,XJEU,XPCEL,XPCRA,XFP,iannul)
  372. *
  373. XFL = XFI + XFC + XFV + XFP
  374. DO 72 ID = 1,IDIM
  375. FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFL * XPALB(I,ID1+ID)
  376. 72 CONTINUE
  377. * end do
  378. XVALB(I,IND,IDIM+1) = XVIT
  379. XVALB(I,IND,IDIM+2) = XACC
  380. XVALB(I,IND,IDIM+3) = XFI
  381. XVALB(I,IND,IDIM+4) = XFC
  382. XVALB(I,IND,IDIM+5) = XFV
  383. XVALB(I,IND,IDIM+6) = XFP
  384. *
  385. * --- choc ...........
  386. *
  387. * ELSE IF (ITYP.EQ. ) THEN
  388. * .......
  389. * .......
  390. *
  391. ENDIF
  392. *
  393. END
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  

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