Télécharger devlb2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEVLB2 SOURCE CHAT 05/01/12 22:46:19 5004
  2. SUBROUTINE DEVLB2(IPLIB,IPALB,XPALB,XPTB,NLIAB,IND,IDIMB,
  3. & NPLB,XABSCI,XORDON,NIP)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Opérateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Initialisation du tableau contenant les paramètres de liaison *
  12. * *
  13. * Paramètres: *
  14. * *
  15. * e IPALB Renseigne sur la liaison. *
  16. * e XPALB Tableau contenant les paramètres de la liaison. *
  17. * e NLIAB Nombre de liaisons sur la base B. *
  18. * e IDIMB Nombre de directions. *
  19. * e IND Indice du pas. *
  20. * *
  21. * *
  22. * Auteur, date de création: *
  23. * *
  24. * Bertrand BEAUFILS : le 27 juillet 1990 *
  25. * Ibrahim Pinto, 05/97 , liaisons ligne_cercle *
  26. *--------------------------------------------------------------------*
  27. *
  28.  
  29.  
  30. INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
  31. REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),XPTP2(3)
  32. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*)
  33. *
  34.  
  35.  
  36. IND2 = IND + 1
  37. *
  38. * Boucle sur le nombre de liaisons
  39. *
  40. DO 10 I = 1,NLIAB
  41. ITYP = IPALB(I,1)
  42. *
  43. * ------ choc élémentaire POINT_CERCLE_FROTTEMENT
  44. *
  45. IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN
  46. NPOI = IPLIB(I,1)
  47. IDIM = IPALB(I,3)
  48. IF (ITYP.EQ.23) THEN
  49. ID1 = 6
  50. ELSE
  51. ID1 = 7
  52. ENDIF
  53. ID7 = ID1 + 6*IDIM
  54. DO 230 ID=1,IDIM
  55. * déjà effectué dans devcoi , avec prise en compte de
  56. * la rotation initiale
  57. * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID)
  58. XPALB(I,ID7+ID) = XPTB(NPOI,IND,ID)
  59. 230 CONTINUE
  60. * end do
  61.  
  62.  
  63. *
  64. * ------ choc élémentaire POINT_CERCLE_MOBILE
  65. *
  66. ELSE IF (ITYP.EQ.33 .OR. ITYP.EQ.34) THEN
  67. NPOA = IPLIB(I,1)
  68. NPOB = IPLIB(I,2)
  69. IDIM = IPALB(I,3)
  70. IF (ITYP.EQ.33) THEN
  71. ID1 = 6
  72. ELSE
  73. ID1 = 7
  74. ENDIF
  75. ID7 = ID1 + 6*IDIM
  76. DO 330 ID=1,IDIM
  77. * XPTB(NPOa,IND2,ID) = XPTB(NPOa,IND,ID)
  78. * XPTB(NPOb,IND2,ID) = XPTB(NPOb,IND,ID)
  79. XPALB(I,ID7+ID) = XPTB(NPOa,IND,ID)
  80. & - XPTB(NPOb,IND,ID)
  81. 330 CONTINUE
  82.  
  83. *
  84. * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT
  85. *
  86. ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
  87. NPOI = IPLIB(I,1)
  88. IDIM = IPALB(I,3)
  89. IF (ITYP.EQ.25) THEN
  90. ID1 = 6
  91. ELSE
  92. ID1 = 7
  93. ENDIF
  94. ID2 = ID1 + IDIM
  95. ID3 = ID1 + 2*IDIM
  96. ID7 = ID1 + 6*IDIM
  97. ID10 = ID1 + 9*IDIM
  98. XRAYT = XPALB(I,ID10+1)
  99. * Calcul du déplacement du point fibre neutre dans le plan du cercle
  100. * Calcul de la normale de choc
  101. PSXPN = 0.D0
  102. DO 250 ID = 1,IDIM
  103. PSXPN = PSXPN + ( XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID) )
  104. 250 CONTINUE
  105. * end do
  106. PSXPME = 0.D0
  107. DO 252 ID = 1,IDIM
  108. XXPME = ( XPTB(NPOI,IND,ID) - ( PSXPN * XPALB(I,ID1+ID) ) )
  109. & - XPALB(I,ID2+ID)
  110. XPALB(I,ID3+ID) = XXPME
  111. PSXPME = PSXPME + ( XXPME * XXPME )
  112. 252 CONTINUE
  113. * end do
  114. PSXPME = SQRT(PSXPME)
  115. IF (PSXPME.GT.1D-20) THEN
  116. DO 254 ID = 1,IDIM
  117. XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME
  118. 254 CONTINUE
  119. * end do
  120. ENDIF
  121. * Calcul du déplacement du point de contact au pas courant
  122. XPTP2(1) = XPTB(NPOI,IND,1) +
  123. & ( XPALB(I,ID3+1) * XRAYT )
  124. XPTP2(2) = XPTB(NPOI,IND,2) +
  125. & ( XPALB(I,ID3+2) * XRAYT )
  126. XPTP2(3) = XPTB(NPOI,IND,3) +
  127. & ( XPALB(I,ID3+3) * XRAYT )
  128. * Initialisation de la position origine adherence
  129. DO 256 ID=1,IDIM
  130. * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID)
  131. XPALB(I,ID7+ID) = XPTP2(ID)
  132. 256 CONTINUE
  133. * end do
  134. *
  135. * ------ choc élémentaire POINT_POINT_FROTTEMENT
  136. *
  137. ELSE IF ((abs(ITYP)).EQ.13 .or.ityp.eq.113) THEN
  138. NPOa = IPLIB(I,1)
  139. NPOb = IPLIB(I,2)
  140. IDIM = IPALB(I,3)
  141. ID1 = 7
  142. ID5 = ID1 + 4*IDIM
  143. DO 31 ID=1,IDIM
  144. * XPTB(NPOa,IND2,ID) = XPTB(NPOa,IND,ID)
  145. * XPTB(NPOb,IND2,ID) = XPTB(NPOb,IND,ID)
  146. XPALB(I,ID5+ID) = XPTB(NPOa,IND,ID)
  147. & - XPTB(NPOb,IND,ID)
  148. 31 CONTINUE
  149. *
  150. * ------ choc élémentaire POINT_PLAN_FROTTEMENT
  151. *
  152. ELSE IF (ITYP.EQ.3 ) THEN
  153. NPOI = IPLIB(I,1)
  154. IDIM = IPALB(I,3)
  155. ID1 = 7
  156. ID5 = ID1 + 4*IDIM
  157. DO 30 ID=1,IDIM
  158. * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID)
  159. XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID)
  160. 30 CONTINUE
  161. * end do
  162. *
  163. * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT
  164. *
  165. ELSE IF (ITYP.EQ.5 .OR. ITYP.EQ.6) THEN
  166. NPOI = IPLIB(I,1)
  167. IDIM = IPALB(I,3)
  168. IF (ITYP.EQ.5) THEN
  169. ID1 = 6
  170. ELSE
  171. ID1 = 7
  172. ENDIF
  173. ID5 = ID1 + 4*IDIM
  174. ID8 = ID1 + 7*IDIM
  175. XRAYT = XPALB(I,ID8+1)
  176. * calcul du déplacement du point de contact au pas courant
  177. XPTP2(1) = XPTB(NPOI,IND,1) +
  178. & ( ( XPTB(NPOI,IND,5) * XPALB(I,ID1+3) * XRAYT ) -
  179. & ( XPTB(NPOI,IND,6) * XPALB(I,ID1+2) * XRAYT ) )
  180. XPTP2(2) = XPTB(NPOI,IND,2) +
  181. & ( ( XPTB(NPOI,IND,6) * XPALB(I,ID1+1) * XRAYT ) -
  182. & ( XPTB(NPOI,IND,4) * XPALB(I,ID1+3) * XRAYT ) )
  183. XPTP2(3) = XPTB(NPOI,IND,3) +
  184. & ( ( XPTB(NPOI,IND,4) * XPALB(I,ID1+2) * XRAYT ) -
  185. & ( XPTB(NPOI,IND,5) * XPALB(I,ID1+1) * XRAYT ) )
  186. DO 50 ID = 1,IDIM
  187. * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID)
  188. XPALB(I,ID5+ID) = XPTP2(ID)
  189. 50 CONTINUE
  190. * end do
  191. *
  192. * ------ choc élémentaire POINT_PLAN_FLUIDE
  193. *
  194. ELSE IF (ITYP.EQ.7) THEN
  195. IDIM = IPALB(I,3)
  196. ID1 = 6 + IDIM
  197. XPALB(I,ID1+1) = 0.D0
  198. XPALB(I,ID1+2) = 0.D0
  199. XPALB(I,ID1+3) = 0.D0
  200.  
  201. ** ianis
  202. ELSE IF (ITYP.EQ.100) THEN
  203. XPALB(I,(5 + IDIMB)) = 0.D0
  204. *
  205. * ------ choc elementaire POINT_POINT_ ... _PLASTIQUE
  206. *
  207. ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.50) THEN
  208. IDIM = IPALB(I,3)
  209. XPALB(I,2+IDIM) = 0.D0
  210. XPALB(I,3+IDIM) = XABSCI(I,2)
  211. XPALB(I,4+IDIM) = 0.D0
  212. *
  213. ELSE IF (ITYP.EQ.17 .OR. ITYP.EQ.51) THEN
  214. IDIM = IPALB(I,3)
  215. XPALB(I,3+IDIM) = 0.D0
  216. XPALB(I,4+IDIM) = XABSCI(I,2)
  217. XPALB(I,5+IDIM) = 0.D0
  218. *
  219. * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT
  220. *
  221. ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN
  222. NNOEMA = IPALB(I,21)
  223. NNOEES = IPALB(I,22)
  224. * Initialisation de la recherche du noeud maitre voisin
  225. IGLOBA = 1
  226. DO 340 INOE=1,NNOEES
  227. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  228. & NPLB,IGLOBA,0)
  229. 340 CONTINUE
  230. DO 342 INOE=1,NNOEMA
  231. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  232. & NPLB,IGLOBA,1)
  233. 342 CONTINUE
  234.  
  235.  
  236.  
  237.  
  238. *
  239. * ------ choc élémentaire LIGNE_CERCLE
  240. *
  241.  
  242.  
  243.  
  244. ELSE IF (ITYP.EQ.37.OR.ITYP.EQ.38
  245. & .OR. ITYP.EQ.39.OR.ITYP.EQ.40) THEN
  246. NNOEMA = IPALB(I,21)
  247. NNOEES = IPALB(I,22)
  248. * Initialisation de la recherche du noeud maitre voisin
  249. IGLOBA = 1
  250. DO 440 INOE=1,NNOEES
  251. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  252. & NPLB,IGLOBA,0)
  253. 440 CONTINUE
  254. DO 442 INOE=1,NNOEMA
  255. CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,
  256. & NPLB,IGLOBA,1)
  257. 442 CONTINUE
  258.  
  259.  
  260.  
  261.  
  262. * ------ choc ...........
  263. *
  264. * ELSE IF (ITYP.EQ. ) THEN
  265. * .......
  266. * .......
  267. *
  268. ENDIF
  269. 10 CONTINUE
  270.  
  271. * end do
  272. *
  273. END
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  

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