Télécharger dyn203.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN203 SOURCE BP208322 19/02/25 21:15:53 10120
  2. SUBROUTINE DYN203(I,ITLB,ITYP,KTLIAB,NPLB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage des tableaux de description des liaisons sur *
  11. * la base @ partir des informations contenues dans la *
  12. * table ITLB (liaison de type ..._CERCLE). *
  13. * Liaison POINT_CERCLE avec ou sans amortissement *
  14. * Liaison POINT_CERCLE_FROTTEMENT avec ou sans amortissement *
  15. * Liaison POINT_CERCLE_MOBILE avec ou sans amortissement *
  16. * Liaison CERCLE_CERCLE_FROTTEMENT avec ou sans amortissement *
  17. * *
  18. * Param}tres: *
  19. * *
  20. * e I Numero de la liaison. *
  21. * e ITLB Table rassemblant la description d'une liaison. *
  22. * e ITYP Type de la liaison. *
  23. * s KTLIAB Segment descriptif des liaisons sur base B. *
  24. * e NPLB Nombre total de points. *
  25. * *
  26. * *
  27. * Auteur, date de creation: *
  28. * *
  29. * Lionel VIVAN, le 5 Decembre 1990. *
  30. * *
  31. *--------------------------------------------------------------------*
  32. -INC CCOPTIO
  33. -INC SMCOORD
  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. LOGICAL L1,L0,LINTER
  42. CHARACTER*8 MONAMO,MONINTER,CHARRE
  43. *
  44. LINTER=.TRUE.
  45. PS=0.D0
  46. MTLIAB = KTLIAB
  47. *
  48. * --- choc elementaire POINT_CERCLE avec ou sans amortissement
  49. *
  50. IF (ITYP.EQ.21) THEN
  51. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  52. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  53. IF (IERR.NE.0) RETURN
  54. CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  55. & 'POINT',I1,X1,CHARRE,L1,IEXC)
  56. IF (IERR.NE.0) RETURN
  57. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  58. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  59. IF (IERR.NE.0) RETURN
  60. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  61. & 'FLOTTANT',I0,XRAID,CHARRE,L1,IP1)
  62. IF (IERR.NE.0) RETURN
  63. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  64. & 'FLOTTANT',I0,XRAYO,CHARRE,L1,IP1)
  65. IF (IERR.NE.0) RETURN
  66. *
  67. MONAMO = ' '
  68. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  69. & MONAMO,I0,XAMON,CHARRE,L1,IP1)
  70. IF (IERR.NE.0) RETURN
  71. *
  72. IPALB(I,1) = ITYP
  73. IPALB(I,3) = IDIM
  74. XPALB(I,1) = XRAID
  75. XPALB(I,2) = XRAYO
  76. *
  77. * normalisation de la normale
  78. *
  79. IPNV = (IDIM + 1) * (IPOI - 1)
  80. IPEX = (IDIM + 1) * (IEXC - 1)
  81. PS = 0.D0
  82. DO 10 ID = 1,IDIM
  83. XC = XCOOR(IPNV + ID)
  84. PS = PS + XC * XC
  85. 10 CONTINUE
  86. *** write (6,*) ' ps ',ps
  87. * end do
  88. IF (PS.LE.0.D0) THEN
  89. CALL ERREUR(162)
  90. RETURN
  91. ENDIF
  92. IF (MONAMO.EQ.'FLOTTANT') THEN
  93. IPALB(I,1) = 22
  94. XPALB(I,3) = XAMON
  95. ID1 = 3
  96. ELSE
  97. ID1 = 2
  98. ENDIF
  99. ID2 = ID1 + IDIM
  100. DO 12 ID = 1,IDIM
  101. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  102. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  103. 12 CONTINUE
  104. * end do
  105. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  106. IPLIB(I,1) = IPLAC
  107. *
  108. * --- choc elementaire POINT_CERCLE_FROTTEMENT
  109. * avec ou sans amortissement
  110. *
  111. ELSE IF (ITYP.EQ.23) THEN
  112. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  113. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  114. IF (IERR.NE.0) RETURN
  115. CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  116. & 'POINT',I1,X1,CHARRE,L1,IEXC)
  117. IF (IERR.NE.0) RETURN
  118. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  119. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  120. IF (IERR.NE.0) RETURN
  121. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  122. & 'FLOTTANT',I0,XRAIN,CHARRE,L1,IP1)
  123. IF (IERR.NE.0) RETURN
  124. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  125. & 'FLOTTANT',I0,XRAYO,CHARRE,L1,IP1)
  126. IF (IERR.NE.0) RETURN
  127. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  128. & 'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  129. IF (IERR.NE.0) RETURN
  130. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  131. & 'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  132. IF (IERR.NE.0) RETURN
  133. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  134. & 'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  135. IF (IERR.NE.0) RETURN
  136. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  137. & IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  138. IF (IERR.NE.0) RETURN
  139.  
  140. MONINTER = ' '
  141. CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  142. & IP0,MONINTER,I0,X1,CHARRE,LINTER,IP1)
  143. IF (IERR.NE.0) RETURN
  144. *
  145. MONAMO = ' '
  146. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  147. & MONAMO,I0,XAMON,CHARRE,L1,IP1)
  148. IF (IERR.NE.0) RETURN
  149. *
  150. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  151. * pas lu la notice jusqu'au bout :
  152. IF(XRAIT.LT.0.D0) THEN
  153. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  154. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  155. WRITE(IOIMP,*)
  156. & 'utilisation du modele de frottement regularise d ODEN'
  157. ENDIF
  158. IF(XAMOT.LE.0D0) THEN
  159. c ERREUR: %m1:8 = %r1 inferieur a %r2
  160. MOTERR(1:8)='AMOR*_T*'
  161. REAERR(1)=XAMOT
  162. REAERR(2)=0.D0
  163. CALL ERREUR(41)
  164. RETURN
  165. ENDIF
  166. ENDIF
  167.  
  168. IPALB(I,1) = ITYP
  169. IPALB(I,3) = IDIM
  170. cbp IPALB(I,4) = 1
  171. IF (.NOT.LINTER) THEN
  172. cbp IPALB(I,4) = 0
  173. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  174. ITYP=ITYP+100
  175. IPALB(I,1) = ITYP
  176. ENDIF
  177. XPALB(I,1) = XRAIN
  178. XPALB(I,2) = XRAYO
  179. XPALB(I,3) = XGLIS
  180. XPALB(I,4) = XADHE
  181. XPALB(I,5) = XRAIT
  182. XPALB(I,6) = XAMOT
  183. *
  184. * normalisation de la normale
  185. *
  186. IPNV = (IDIM + 1) * (IPOI - 1)
  187. IPEX = (IDIM + 1) * (IEXC - 1)
  188. PS = 0.D0
  189. DO 20 ID = 1,IDIM
  190. XC = XCOOR(IPNV + ID)
  191. PS = PS + XC * XC
  192. 20 CONTINUE
  193. *** write (6,*) ' ps - 2 ',ps
  194. * end do
  195. IF (PS.LE.0.D0) THEN
  196. CALL ERREUR(162)
  197. RETURN
  198. ENDIF
  199. IF (MONAMO.EQ.'FLOTTANT') THEN
  200. cbp IPALB(I,1) = 24
  201. ITYP=ITYP+1
  202. IPALB(I,1) = ITYP
  203. XPALB(I,7) = XAMON
  204. ID1 = 7
  205. ELSE
  206. ID1 = 6
  207. ENDIF
  208. c stockage de la normale et de l'excentration
  209. ID2 = ID1 + IDIM
  210. DO 22 ID = 1,IDIM
  211. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  212. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  213. 22 CONTINUE
  214. * end do
  215. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  216. IPLIB(I,1) = IPLAC
  217.  
  218. *
  219. * --- choc elementaire POINT_CERCLE_MOBILE
  220. * avec ou sans amortissement
  221. *
  222. ELSE IF (ITYP.EQ.33) THEN
  223.  
  224. CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT',L0,IP0,
  225. & 'POINT',I1,X1,CHARRE,L1,INOA)
  226. IF (IERR.NE.0) RETURN
  227. CALL ACCTAB(ITLB,'MOT',I0,X0,'CERCLE',L0,IP0,
  228. & 'POINT',I1,X1,CHARRE,L1,INOB)
  229. IF (IERR.NE.0) RETURN
  230. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  231. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  232. IF (IERR.NE.0) RETURN
  233. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  234. & 'FLOTTANT',I0,XRAIN,CHARRE,L1,IP1)
  235. IF (IERR.NE.0) RETURN
  236. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  237. & 'FLOTTANT',I0,XRAYO,CHARRE,L1,IP1)
  238. IF (IERR.NE.0) RETURN
  239. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  240. & 'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  241. IF (IERR.NE.0) RETURN
  242. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  243. & 'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  244. IF (IERR.NE.0) RETURN
  245. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  246. & 'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  247. IF (IERR.NE.0) RETURN
  248. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  249. & IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  250. IF (IERR.NE.0) RETURN
  251. MONINTER = ' '
  252. CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  253. & IP0,MONINTER,I0,X1,CHARRE,LINTER,IP1)
  254. IF (IERR.NE.0) RETURN
  255. *
  256. MONAMO = ' '
  257. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  258. & MONAMO,I0,XAMON,CHARRE,L1,IP1)
  259. IF (IERR.NE.0) RETURN
  260. *
  261. IPALB(I,1) = ITYP
  262. IPALB(I,3) = IDIM
  263. cbp IPALB(I,4) = 1
  264. IF (.NOT.LINTER) THEN
  265. cbp IPALB(I,4) = 0
  266. ITYP=ITYP+100
  267. IPALB(I,1) = ITYP
  268. ENDIF
  269. XPALB(I,1) = XRAIN
  270. XPALB(I,2) = XRAYO
  271. XPALB(I,3) = XGLIS
  272. XPALB(I,4) = XADHE
  273. XPALB(I,5) = XRAIT
  274. XPALB(I,6) = XAMOT
  275. *
  276. * normalisation de la normale
  277. *
  278. IPNV = (IDIM + 1) * (IPOI - 1)
  279. IPNOA = (IDIM + 1) * (INOA - 1)
  280. IPNOB = (IDIM + 1) * (INOB - 1)
  281. PS = 0.D0
  282. DO 202 ID = 1,IDIM
  283. XC = XCOOR(IPNV + ID)
  284. PS = PS + XC * XC
  285. 202 CONTINUE
  286. *** write (6,*) ' ps - 3 ',ps
  287. IF (PS.LE.0.D0) THEN
  288. CALL ERREUR(162)
  289. RETURN
  290. ENDIF
  291. IF (MONAMO.EQ.'FLOTTANT') THEN
  292. cbp IPALB(I,1) = 34
  293. ITYP=ITYP+1
  294. IPALB(I,1) = ITYP
  295. XPALB(I,7) = XAMON
  296. ID1 = 7
  297. ELSE
  298. ID1 = 6
  299. ENDIF
  300. ID2 = ID1 + IDIM
  301. c stockage de la normale et du vecteur POINT -> Centre_du_Cercle
  302. DO 222 ID = 1,IDIM
  303. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  304. XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  305. 222 CONTINUE
  306. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  307. IPLIB(I,1) = IPLAC
  308. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  309. IPLIB(I,2) = IPLAC
  310. *
  311. * --- choc elementaire CERCLE_CERCLE_FROTTEMENT
  312. * avec ou sans amortissement
  313. *
  314. ELSE IF (ITYP.EQ.25) THEN
  315. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  316. & 'POINT',I1,X1,CHARRE,L1,IMOD)
  317. IF (IERR.NE.0) RETURN
  318. CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  319. & 'POINT',I1,X1,CHARRE,L1,IEXC)
  320. IF (IERR.NE.0) RETURN
  321. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  322. & 'POINT',I1,X1,CHARRE,L1,IPOI)
  323. IF (IERR.NE.0) RETURN
  324. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  325. & 'FLOTTANT',I0,XRAIN,CHARRE,L1,IP1)
  326. IF (IERR.NE.0) RETURN
  327. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_BUTEE',L0,IP0,
  328. & 'FLOTTANT',I0,XRAYB,CHARRE,L1,IP1)
  329. IF (IERR.NE.0) RETURN
  330. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_SUPPORT',L0,IP0,
  331. & 'FLOTTANT',I0,XRAYP,CHARRE,L1,IP1)
  332. IF (IERR.NE.0) RETURN
  333. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  334. & 'FLOTTANT',I0,XGLIS,CHARRE,L1,IP1)
  335. IF (IERR.NE.0) RETURN
  336. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  337. & 'FLOTTANT',I0,XADHE,CHARRE,L1,IP1)
  338. IF (IERR.NE.0) RETURN
  339. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  340. & 'FLOTTANT',I0,XRAIT,CHARRE,L1,IP1)
  341. IF (IERR.NE.0) RETURN
  342. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  343. & IP0,'FLOTTANT',I0,XAMOT,CHARRE,L1,IP1)
  344. IF (IERR.NE.0) RETURN
  345. MONINTER = ' '
  346. CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  347. & IP0,MONINTER,I0,X1,CHARRE,LINTER,IP1)
  348. IF (IERR.NE.0) RETURN
  349. *
  350. MONAMO = ' '
  351. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  352. & MONAMO,I0,XAMON,CHARRE,L1,IP1)
  353. IF (IERR.NE.0) RETURN
  354. *
  355. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  356. * pas lu la notice jusqu'au bout :
  357. IF(XRAIT.LT.0.D0) THEN
  358. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  359. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  360. WRITE(IOIMP,*)
  361. & 'utilisation du modele de frottement regularise d ODEN'
  362. ENDIF
  363. IF(XAMOT.LE.0D0) THEN
  364. c ERREUR: %m1:8 = %r1 inferieur a %r2
  365. MOTERR(1:8)='AMOR*_T*'
  366. REAERR(1)=XAMOT
  367. REAERR(2)=0.D0
  368. CALL ERREUR(41)
  369. RETURN
  370. ENDIF
  371. ENDIF
  372.  
  373. IPALB(I,1) = ITYP
  374. IPALB(I,3) = IDIM
  375. cbp IPALB(I,4) = 1
  376. IF (.NOT.LINTER) THEN
  377. cbp IPALB(I,4) = 0
  378. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  379. ITYP=ITYP+100
  380. IPALB(I,1) = ITYP
  381. ENDIF
  382. XPALB(I,1) = XRAIN
  383. XPALB(I,2) = XRAYB
  384. XPALB(I,3) = XGLIS
  385. XPALB(I,4) = XADHE
  386. XPALB(I,5) = XRAIT
  387. XPALB(I,6) = XAMOT
  388. *
  389. * normalisation de la normale
  390. *
  391. IPNV = (IDIM + 1) * (IPOI - 1)
  392. IPEX = (IDIM + 1) * (IEXC - 1)
  393. PS = 0.D0
  394. DO 30 ID = 1,IDIM
  395. XC = XCOOR(IPNV + ID)
  396. PS = PS + XC * XC
  397. 30 CONTINUE
  398. * end do
  399. *** write (6,*) ' ps - 4 ',ps
  400. IF (PS.LE.0.D0) THEN
  401. CALL ERREUR(162)
  402. RETURN
  403. ENDIF
  404. IF (MONAMO.EQ.'FLOTTANT') THEN
  405. ID1 = 7
  406. cbp IPALB(I,1) = 26
  407. ITYP=ITYP+1
  408. IPALB(I,1) = ITYP
  409. XPALB(I,7) = XAMON
  410. ELSE
  411. ID1 = 6
  412. ENDIF
  413. ID10 = ID1 + 9*IDIM
  414. XPALB(I,ID10+1) = XRAYP
  415. ID2 = ID1 + IDIM
  416. cbp ID3 = ID1 + 2*IDIM
  417. DO 32 ID = 1,IDIM
  418. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  419. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  420. 32 CONTINUE
  421. * end do
  422. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  423. IPLIB(I,1) = IPLAC
  424. *
  425. * --- choc elementaire ..._CERCLE...
  426. *
  427. * ELSE IF (ITYP.EQ. ) THEN
  428. * ...
  429. * ...
  430. ENDIF
  431. *
  432. END
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  
  442.  
  443.  

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