Télécharger devfb2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVFB2 SOURCE PV 08/04/18 21:15:01 6094
  2. SUBROUTINE DEVFB2(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_POINT. *
  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. * *
  34. *--------------------------------------------------------------------*
  35. *
  36. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  37. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
  38. REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
  39. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  40.  
  41. *
  42. *
  43. * --- choc {l{mentaire POINT_POINT avec amortissement
  44. *
  45. IF (ITYP.EQ.11 .OR. ITYP.EQ.111) THEN
  46. NPOA = IPLIB(I,1)
  47. NPOB = IPLIB(I,2)
  48. IDIM = IPALB(I,3)
  49. IPERM = IPALB(I,4)
  50. XRAID = XPALB(I,1)
  51. XJEU = XPALB(I,2)
  52. XAMO = XPALB(I,3)
  53. XDEP = 0.D0
  54. XDEPM1 = 0.D0
  55. DO 20 ID = 1,IDIM
  56. IDA = 3 + ID
  57. IDB = 3 + IDIM + ID
  58. XDEA = XPTB(NPOA,IND,ID)
  59. XDMA = XPTB(NPOA,IND2,ID)
  60. XDEB = XPTB(NPOB,IND,ID)
  61. XDMB = XPTB(NPOB,IND2,ID)
  62. XVALB(I,IND,IDA) = XDEA
  63. XVALB(I,IND,IDB) = XDEB
  64. XDEA = XDEA + FEXPSM(NPOA,NPA,IND1,ID)
  65. XDEB = XDEB + FEXPSM(NPOB,NPA,IND1,ID)
  66. XDMA = XDMA + FEXPSM(NPOA,NPAM1,INDM1,ID)
  67. XDMB = XDMB + FEXPSM(NPOB,NPAM1,INDM1,ID)
  68. XDEP = XDEP + (XDEA - XDEB) * XPALB(I,3+ID)
  69. XDEPM1 = XDEPM1 + (XDMA - XDMB) * XPALB(I,3+ID)
  70. 20 CONTINUE
  71. * end do
  72. XVIT = (XDEP - XDEPM1) / PDTS2
  73. XVALB(I,IND,3) = XVIT
  74. IF (ITYP.EQ.11) THEN
  75. CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,XFLA,IPERM,iannul)
  76. ELSE
  77. CALL DYCHAM2(XDEP,XVIT,XJEU,XAMO,XABSCI,XORDON,NIP,
  78. & NLIAB,I, XFLA,IPERM,iannul)
  79. ENDIF
  80. XFLB = -1.D0 * XFLA
  81. XVALB(I,IND,1) = XFLA
  82. XVALB(I,IND,2) = XFLB
  83. DO 22 ID = 1,IDIM
  84. FTOTB(NPOA,ID) = FTOTB(NPOA,ID) + XFLA * XPALB(I,3+ID)
  85. FTOTB(NPOB,ID) = FTOTB(NPOB,ID) + XFLB * XPALB(I,3+ID)
  86. 22 CONTINUE
  87. * end do
  88. *
  89. * --- choc {l{mentaire POINT_POINT_FROTTEMENT avec ou sans amortissement
  90. *
  91. ELSEIF ((ITYP.EQ.13) .or. ( ityp .eq. 113)) THEN
  92. NPOA = IPLIB(I,1)
  93. NPOB = IPLIB(I,2)
  94. IGP = IPALB(I,2)
  95. IDIM = IPALB(I,3)
  96. ID1 = 7
  97. ID2 = ID1 + IDIM
  98. ID3 = ID1 + 2*IDIM
  99. ID4 = ID1 + 3*IDIM
  100. ID5 = ID1 + 4*IDIM
  101. ID6 = ID1 + 5*IDIM
  102. ID7 = ID1 + 6*IDIM
  103. * Si glissement au pas pr{c{dent, r{actualisation de la position-ecart
  104. * origine d'adh{rence
  105. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  106. DO 30 ID=1,IDIM
  107. XPALB(I,ID5+ID) =(XPTB(NPOa,IND,ID) +
  108. & FEXPSM(NPOa,NPA,IND1,ID) )
  109. & - ( XPTB(NPOb,IND,ID) +
  110. & FEXPSM(NPOb,NPA,IND1,ID))
  111. 30 CONTINUE
  112. * end do
  113. ENDIF
  114. * Calcul de l'enfoncement relatif et de la vitesse normale relative
  115. XDEP = 0.D0
  116. PSN = 0.D0
  117. PSN0 = 0.D0
  118. DO 32 ID = 1,IDIM
  119. IDD1 = 3 + ID
  120. xvalb(i,ind,idd1) = XPTB(NPOa,IND,ID)
  121. xvalb(i,ind,idd1 + idim) = XPTB(NPOb,IND,ID)
  122. XDE2 = XPTB(NPOa,IND,ID) - xptb (npob,ind,id)
  123. XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  124. & - FEXPSM(NPOb,NPA,IND1,ID)
  125. XDm2 = XPTB(NPOa,IND2,ID) - xptb (npob,ind2,id)
  126. XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
  127. & - FEXPSM(NPOb,NPAM1,INDM1,ID)
  128. XPALB(I,ID2+ID) = XDE2 - XDM2
  129. XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
  130. XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  131. PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
  132. PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
  133. 32 CONTINUE
  134. * end do
  135. * Projette la vitesse relative
  136. * et la variation de d{placement relatif par rapport a
  137. * l' ecart origine d'adh{rence sur le plan tangent
  138. DO 34 ID = 1,IDIM
  139. XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
  140. & / PDTS2
  141. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
  142. 34 CONTINUE
  143. * end do
  144. XVITN = PSN / PDTS2
  145. XVALB(I,IND,3) = XVITN
  146. IF (ITYP.EQ.13) THEN
  147. CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS
  148. & ,iannul)
  149. ELSE
  150. CALL DYCHA41(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
  151. & XABSCI,XORDON,NIP,iannul)
  152. ENDIF
  153.  
  154. Xfla = XFN
  155. Xflb = -1d0 * XFN
  156. XVALB(I,IND,1) = XFla
  157. XVALB(I,IND,2) = XFlb
  158. XVALB(I,IND,10) = ABS(XFT)
  159. XVALB(I,IND,12) = XPUS
  160. IPALB(I,2) = IGP
  161. * Si glissement, m{morisation de la vitesse tangentielle et de la force
  162. * tangentielle
  163. IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
  164. DO 36 ID = 1,IDIM
  165. XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
  166. XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
  167. 36 CONTINUE
  168. * end do
  169. ENDIF
  170. DO 38 ID = 1,IDIM
  171. FTOTB(NPOa,ID) = FTOTB(NPOa,ID) + XFla* XPALB(I,ID1+ID)
  172. & + XPALB(I,ID4+ID)
  173. FTOTB(NPOb,ID) = FTOTB(NPOb,ID) + XFlb* XPALB(I,ID1+ID)
  174. & - XPALB(I,ID4+ID)
  175. 38 CONTINUE
  176.  
  177. *****************************************************************
  178.  
  179.  
  180. *
  181. ** modele de Nedjai. On ne garantit rien
  182.  
  183. ELSEIF (ITYP.EQ.-13) THEN
  184. NPOA = IPLIB(I,1)
  185. NPOB = IPLIB(I,2)
  186. IGP = IPALB(I,2)
  187. IDIM = IPALB(I,3)
  188. ID1 = 7
  189. ID2 = ID1 + IDIM
  190. ID3 = ID1 + 2*IDIM
  191. ID4 = ID1 + 3*IDIM
  192. ID5 = ID1 + 4*IDIM
  193. ID6 = ID1 + 5*IDIM
  194. ID7 = ID1 + 6*IDIM
  195. * Si glissement au pas pr{c{dent, r{actualisation de la position-ecart
  196. * origine d'adh{rence
  197. IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
  198. DO 130 ID=1,IDIM
  199. XPALB(I,ID5+ID) =(XPTB(NPOa,IND,ID) +
  200. & FEXPSM(NPOa,NPA,IND1,ID) )
  201. & - ( XPTB(NPOb,IND,ID) +
  202. & FEXPSM(NPOb,NPA,IND1,ID))
  203. 130 CONTINUE
  204. * end do
  205. ENDIF
  206. * Calcul de l'enfoncement relatif et de la vitesse normale relative
  207. XDEP = 0.D0
  208. PSN = 0.D0
  209. PSN0 = 0.D0
  210. DO 132 ID = 1,IDIM
  211. IDD1 = 3 + ID
  212. xvalb(i,ind,idd1) = XPTB(NPOa,IND,ID)
  213. xvalb(i,ind,idd1 + idim) = XPTB(NPOb,IND,ID)
  214. XDE2 = XPTB(NPOa,IND,ID) - xptb (npob,ind,id)
  215. XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
  216. & - FEXPSM(NPOb,NPA,IND1,ID)
  217. XDm2 = XPTB(NPOa,IND2,ID) - xptb (npob,ind2,id)
  218. XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
  219. & - FEXPSM(NPOb,NPAM1,INDM1,ID)
  220. ***
  221. * WRITE(6,*) 'devfb2 XDE2 ', XDE2
  222. * WRITE(6,*) 'devfb2 XDM2 ', XDM2
  223. ***
  224. XPALB(I,ID2+ID) = XDE2 - XDM2
  225. *A ENLEVER**XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
  226. XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
  227. PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
  228. PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
  229. 132 CONTINUE
  230. * end do
  231. * Projette la vitesse relative
  232. * et la variation de d{placement relatif par rapport a
  233. * l' ecart origine d'adh{rence sur le plan tangent
  234. DO 134 ID = 1,IDIM
  235. XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
  236. & / PDTS2
  237. *A enlever**XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
  238. **** RAJOUT D UN ORDRE D IMPRESSION
  239. *************************************
  240. * WRITE(6,*) 'devfb2 XPALB',XPALB(I,ID1+ID)
  241. * WRITE(6,*) 'devfb2 XPALB',XPALB(I,ID2+ID)
  242. * WRITE(6,*) 'devfb2 XPALB',XPALB(I,ID3+ID)
  243. 134 CONTINUE
  244. * end do
  245. XVITN = PSN / PDTS2
  246. XVALB(I,IND,3) = XVITN
  247.  
  248. ***RAJOUT DE XPAS DANS CALL DYCHA4
  249. CALL DGCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS
  250. & ,iannul,PDTS2)
  251.  
  252.  
  253. Xfla = XFN
  254. Xflb = -1d0 * XFN
  255. XVALB(I,IND,1) = XFla
  256. XVALB(I,IND,2) = XFlb
  257. XVALB(I,IND,10) = ABS(XFT)
  258. XVALB(I,IND,12) = XPUS
  259. IPALB(I,2) = IGP
  260. * Si glissement, m{morisation de la vitesse tangentielle et de la force
  261. * tangentielle
  262. *AENLEV**IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
  263. DO 136 ID = 1,IDIM
  264. **ON A REMPLACE ID6 PAR ID3 (NEDJAI)
  265. XPALB(I,ID3+ID) = XPALB(I,ID2+ID)
  266. XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
  267. 136 CONTINUE
  268. * end do
  269. **AENLEV**ENDIF
  270. DO 138 ID = 1,IDIM
  271. FTOTB(NPOa,ID) = FTOTB(NPOa,ID) + XFla* XPALB(I,ID1+ID)
  272. & + XPALB(I,ID4+ID)
  273. FTOTB(NPOb,ID) = FTOTB(NPOb,ID) + XFlb* XPALB(I,ID1+ID)
  274. & - XPALB(I,ID4+ID)
  275. 138 CONTINUE
  276.  
  277. *
  278. * --- choc ...........
  279. *
  280. * ELSE IF (ITYP.EQ. ) THEN
  281. * .......
  282. * .......
  283. *
  284. ENDIF
  285. *
  286. END
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  

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