Télécharger dyn207.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN207 SOURCE BP208322 16/06/06 21:15:06 8944
  2. C DYN206 SOURCE LAVARENN 96/10/30 21:23:03 2349
  3. SUBROUTINE DYN207(I,ITLB,ITYP,KTLIAB,NPLB)
  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. * Remplissage des tableaux de description des liaisons sur *
  12. * la base à partir des informations contenues dans la *
  13. * table ILIB *
  14. * Liaison ligne_cercle avec ou sans amortissement *
  15. * *
  16. * Paramètres: *
  17. * *
  18. * e I Numéro de la liaison. *
  19. * e ITLB Table rassemblant la description d'une liaison. *
  20. * e ITYP Type de la liaison. *
  21. * s KTLIAB Segment descriptif des liaisons sur base B. *
  22. * e NPLB Nombre total de points. *
  23. * *
  24. * *
  25. * Auteur, date de création: *
  26. * *
  27. * Ibrahim PINTO,05/97 *
  28. * *
  29. *--------------------------------------------------------------------*
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMCHPOI
  34. *
  35. SEGMENT MTLIAB
  36. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  37. REAL*8 XPALB(NLIAB,NXPALB)
  38. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  39. ENDSEGMENT
  40. *
  41. SEGMENT MLIGNE
  42. INTEGER KPLIB(NPLB)
  43. ENDSEGMENT
  44. *
  45. LOGICAL L1,L0
  46. CHARACTER*8 MONAMO,MONESC,MONREC,MONRAY,CMOT,CMOT1,MONINV
  47. CHARACTER*8 MONCAL,CMOT2,CHARRE
  48. *
  49. MTLIAB = KTLIAB
  50. SEGINI MLIGNE
  51. *
  52. * --- choc élémentaire LIGNE_CERCLE_FROTTEMENT
  53. * avec ou sans amortissement
  54. *
  55. CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  56. & 'MAILLAGE',I1,X1,' ',L1,IMAI)
  57. IF (IERR.NE.0) RETURN
  58. MONESC = ' '
  59. CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  60. & MONESC,I1,X1,CHARRE,L1,IESC)
  61. IF (IERR.NE.0) RETURN
  62. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEURS',L0,IP0,
  63. & 'CHPOINT',I0,X1,' ',L1,IRAIES)
  64. IF (IERR.NE.0) RETURN
  65. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  66. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  67. IF (IERR.NE.0) RETURN
  68. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  69. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  70. IF (IERR.NE.0) RETURN
  71. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  72. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  73. IF (IERR.NE.0) RETURN
  74. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  75. & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
  76. IF (IERR.NE.0) RETURN
  77. *
  78. MONAMO = ' '
  79. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENTS',L0,IP0,
  80. & MONAMO,I1,X1,CHARRE,L1,IAMOES)
  81. IF (IERR.NE.0) RETURN
  82. *
  83. MONREC = ' '
  84. CALL ACCTAB(ITLB,'MOT',I0,X0,'RECHERCHE',L0,IP0,
  85. & MONREC,I1,X1,CMOT,L1,IP1)
  86. IF (IERR.NE.0) RETURN
  87. *
  88. MONRAY = ' '
  89. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  90. & MONRAY,I0,XRAY,CHARRE,L1,IP1)
  91. IF (IERR.NE.0) RETURN
  92.  
  93. MONCAL = ' '
  94. CALL ACCTAB(ITLB,'MOT',I0,X0,'ACTNOR',L0,IP0,
  95. & MONCAL,I1,X1,CMOT2,L1,IP1)
  96. IF (IERR.NE.0) RETURN
  97.  
  98. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  99. * pas lu la notice jusqu'au bout :
  100. IF(XRAIT.LT.0.D0) THEN
  101. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  102. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  103. WRITE(IOIMP,*)
  104. & 'utilisation du modele de frottement regularise d ODEN'
  105. ENDIF
  106. IF(XAMOT.LE.0D0) THEN
  107. c ERREUR: %m1:8 = %r1 inferieur a %r2
  108. MOTERR(1:8)='AMOR*_T*'
  109. REAERR(1)=XAMOT
  110. REAERR(2)=0.D0
  111. CALL ERREUR(41)
  112. RETURN
  113. ENDIF
  114. ENDIF
  115. *
  116. IPALB(I,1) = ITYP
  117. IPALB(I,3) = IDIM
  118. XPALB(I,3) = XGLIS
  119. XPALB(I,4) = XADHE
  120. XPALB(I,5) = XRAIT
  121. XPALB(I,6) = XAMOT
  122. *
  123. IF (MONCAL.EQ.'MOT') THEN
  124. IF (CMOT2(1:4).EQ.'VRAI') THEN
  125. IPALB(I,1)=39
  126. ENDIF
  127. ENDIF
  128.  
  129.  
  130. IF (MONAMO.EQ.'CHPOINT') THEN
  131. IPALB(I,1) = IPALB(I,1)+1
  132. ID1 = 7
  133. ELSE
  134. ID1 = 6
  135. ENDIF
  136.  
  137.  
  138. * Normale aux butees ou au cylindre enveloppant le segment
  139. IF (IDIM.EQ.3) THEN
  140. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  141. & 'POINT',I1,X1,' ',L1,INOR)
  142. IF (IERR.NE.0) RETURN
  143. IPNO = (IDIM + 1) * (INOR - 1)
  144. PS = 0.D0
  145. DO 80 ID = 1,IDIM
  146. XC = XCOOR(IPNO + ID)
  147. PS = PS + XC * XC
  148. 80 CONTINUE
  149. * end do
  150. IF (PS.LE.0.D0) THEN
  151. CALL ERREUR(162)
  152. RETURN
  153. ENDIF
  154. DO 81 ID=1,IDIM
  155. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  156. 81 CONTINUE
  157. ELSE
  158. DO 82 ID=1,IDIM
  159. XPALB(I,ID1+ID) = 0.D0
  160. 82 CONTINUE
  161. ENDIF
  162. IF (MONRAY.EQ.'FLOTTANT') THEN
  163. XPALB(I,2) = XRAY
  164. ELSE
  165. XPALB(I,2) = 0.D0
  166. ENDIF
  167. * La recherche s'effectue par défaut localement
  168. IF (MONREC.EQ.'MOT') THEN
  169. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  170. IPALB(I,23) = 1
  171. ELSE
  172. IPALB(I,23) = 0
  173. ENDIF
  174. ELSE
  175. IPALB(I,23) = 0
  176. ENDIF
  177. *
  178. * Coordonnées du maillage_maitre
  179. MELEME = IMAI
  180.  
  181. SEGACT MELEME
  182.  
  183.  
  184. * Pour savoir si le contour est fermé
  185. NELEMA = NUM(/2)
  186. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  187. NNOEMA = NELEMA
  188. IFERMA = 1
  189. ELSE
  190. NNOEMA = NELEMA +1
  191. IFERMA = 0
  192. ENDIF
  193. IPALB(I,21) = NNOEMA
  194. IPALB(I,24) = IFERMA
  195. ID2 = ID1 + 4*IDIM
  196. IPT = NUM(1,1)
  197. INPT = (IDIM+1)*(IPT-1)
  198. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  199. IPLIB(I,1) = IPLAC
  200. KPLIB(1) = IPT
  201. DO 84 ID=1,IDIM
  202. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  203. 84 CONTINUE
  204. DO 85 IE=1,(NNOEMA-1)
  205. IPT = NUM(2,IE)
  206. INPT = (IDIM+1)*(IPT-1)
  207. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  208. IPLIB(I,IE+1) = IPLAC
  209. KPLIB(IE+1) = IPT
  210. IDIE = ID2 + IE*IDIM
  211. DO 86 ID=1,IDIM
  212. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  213. 86 CONTINUE
  214. 85 CONTINUE
  215. SEGDES MELEME
  216. *
  217. * Maillage_esclave
  218. ID3 = ID2 + NNOEMA*IDIM
  219. IF (MONESC.EQ.'POINT') THEN
  220. * La ligne esclave est un point
  221. NNOEES=1
  222. IFERES=0
  223. ISYMET=-1
  224. * Lecture des coordonnées
  225. IPESC = (IDIM+1)*(IESC-1)
  226. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  227. IPLIB(I,NNOEMA+1) = IPLAC
  228. KPLIB(NNOEMA+1) = IESC
  229. DO 90 ID = 1,IDIM
  230. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  231. 90 CONTINUE
  232. *
  233. IPALB(I,22) = NNOEES
  234. IPALB(I,25) = IFERES
  235. IPALB(I,26) = ISYMET
  236. ELSE
  237. IF (MONESC.EQ.'MAILLAGE') THEN
  238. * La ligne esclave est un maillage
  239. MELEME = IESC
  240. SEGACT MELEME
  241. * Pour savoir si le contour est fermé
  242. NELEES = NUM(/2)
  243. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  244. NNOEES = NELEES
  245. IFERES = 1
  246. ELSE
  247. NNOEES = NELEES +1
  248. IFERES = 0
  249. ENDIF
  250. IPALB(I,22) = NNOEES
  251. IPALB(I,25) = IFERES
  252. * Coordonnées du maillage_esclave
  253. IPT = NUM(1,1)
  254. INPT = (IDIM+1)*(IPT-1)
  255. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  256. IPLIB(I,NNOEMA+1) = IPLAC
  257. KPLIB(NNOEMA+1) = IPT
  258. DO 94 ID=1,IDIM
  259. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  260. 94 CONTINUE
  261. DO 95 IE=1,(NNOEES-1)
  262. IPT = NUM(2,IE)
  263. INPT = (IDIM+1)*(IPT-1)
  264. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  265. IPLIB(I,NNOEMA+IE+1) = IPLAC
  266. KPLIB(NNOEMA+IE+1) = IPT
  267. IDIE = ID3 + IE*IDIM
  268. DO 96 ID=1,IDIM
  269. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  270. 96 CONTINUE
  271. 95 CONTINUE
  272. SEGDES MELEME
  273. MONINV=' '
  274. CALL ACCTAB(ITLB,'MOT',I0,X0,'INVERSION',L0,IP0,
  275. & MONINV,I1,X1,CMOT1,L1,IP1)
  276. * Le traitement symétrique ne s'effectue pas PAR DÉFAUT
  277.  
  278. IF (MONINV.EQ.'LOGIQUE') THEN
  279. IF (.NOT.L1) THEN
  280. IPALB(I,26) = -1
  281. ELSE
  282. IPALB(I,26) = 0
  283. ENDIF
  284. ELSE
  285. IPALB(I,26) = -1
  286. ENDIF
  287.  
  288. ELSE
  289. * La ligne esclave n'est ni un point ni un maillage
  290. * CALL ERREUR(...)
  291. RETURN
  292. ENDIF
  293. ENDIF
  294. * Lecture des chpoints de raideur et d amortissement
  295. * Raideurs des noeuds esclaves et maitres
  296. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  297. MCHPOI=IRAIES
  298. SEGACT,MCHPOI
  299. NSOUP=IPCHP(/1)
  300. DO 100 IPC=1,NSOUP
  301. MSOUPO=IPCHP(IPC)
  302. SEGACT,MSOUPO
  303. MELEME = IGEOC
  304. SEGACT,MELEME
  305. MPOVAL = IPOVAL
  306. SEGACT,MPOVAL
  307. NNN = NUM(/2)
  308. DO 110 INN=1,NNN
  309. IPT = NUM(1,INN)
  310. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  311. IF (IPLAC.NE.0) THEN
  312. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  313. ENDIF
  314. 110 CONTINUE
  315. SEGDES,MPOVAL,MELEME
  316. SEGDES MSOUPO
  317. 100 CONTINUE
  318. SEGDES,MCHPOI
  319. * Amortissement des noeuds esclaves et maitres
  320. ID5=ID4+NNOEMA+NNOEES
  321. IF (IPALB(I,1).EQ.38 .OR. IPALB(I,1).EQ.40) THEN
  322. MCHPOI=IAMOES
  323. SEGACT,MCHPOI
  324. NSOUP = IPCHP(/1)
  325. DO 120 IPC=1,NSOUP
  326. MSOUPO=IPCHP(IPC)
  327. SEGACT,MSOUPO
  328. MELEME = IGEOC
  329. SEGACT,MELEME
  330. MPOVAL = IPOVAL
  331. SEGACT,MPOVAL
  332. NNN=NUM(/2)
  333. DO 130 INN=1,NNN
  334. IPT = NUM(1,INN)
  335. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  336. IF (IPLAC.NE.0) THEN
  337. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  338. ENDIF
  339. 130 CONTINUE
  340. SEGDES MPOVAL,MELEME
  341. SEGDES MSOUPO
  342. 120 CONTINUE
  343. SEGDES MCHPOI
  344. ENDIF
  345. SEGSUP MLIGNE
  346. * end do
  347. *
  348. *
  349. * --- choc élémentaire ..._PLAN...
  350. *
  351. * ELSE IF (ITYP.EQ. ) THEN
  352. * ...
  353. * ...
  354. *
  355.  
  356.  
  357.  
  358. END
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  

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