Télécharger dyn203.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN203 SOURCE BP208322 16/06/06 21:15:04 8944
  2. SUBROUTINE DYN203(I,ITLB,ITYP,KTLIAB,NPLB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Op{rateur 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 Num{ro 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 cr{ation: *
  28. * *
  29. * Lionel VIVAN, le 5 D{cembre 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
  43. *
  44. LINTER=.TRUE.
  45. PS=0.D0
  46. MTLIAB = KTLIAB
  47. *
  48. * --- choc {l{mentaire 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,' ',L1,IMOD)
  53. IF (IERR.NE.0) RETURN
  54. CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  55. & 'POINT',I1,X1,' ',L1,IEXC)
  56. IF (IERR.NE.0) RETURN
  57. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  58. & 'POINT',I1,X1,' ',L1,IPOI)
  59. IF (IERR.NE.0) RETURN
  60. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  61. & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
  62. IF (IERR.NE.0) RETURN
  63. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  64. & 'FLOTTANT',I0,XRAYO,' ',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,' ',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 {l{mentaire 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,' ',L1,IMOD)
  114. IF (IERR.NE.0) RETURN
  115. CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  116. & 'POINT',I1,X1,' ',L1,IEXC)
  117. IF (IERR.NE.0) RETURN
  118. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  119. & 'POINT',I1,X1,' ',L1,IPOI)
  120. IF (IERR.NE.0) RETURN
  121. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  122. & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
  123. IF (IERR.NE.0) RETURN
  124. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  125. & 'FLOTTANT',I0,XRAYO,' ',L1,IP1)
  126. IF (IERR.NE.0) RETURN
  127. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  128. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  129. IF (IERR.NE.0) RETURN
  130. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  131. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  132. IF (IERR.NE.0) RETURN
  133. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  134. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  135. IF (IERR.NE.0) RETURN
  136. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  137. & IP0,'FLOTTANT',I0,XAMOT,' ',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,' ',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,' ',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. IPALB(I,4) = 1
  171. IF (.NOT.LINTER) THEN
  172. IPALB(I,4) = 0
  173. ENDIF
  174. XPALB(I,1) = XRAIN
  175. XPALB(I,2) = XRAYO
  176. XPALB(I,3) = XGLIS
  177. XPALB(I,4) = XADHE
  178. XPALB(I,5) = XRAIT
  179. XPALB(I,6) = XAMOT
  180. *
  181. * normalisation de la normale
  182. *
  183. IPNV = (IDIM + 1) * (IPOI - 1)
  184. IPEX = (IDIM + 1) * (IEXC - 1)
  185. PS = 0.D0
  186. DO 20 ID = 1,IDIM
  187. XC = XCOOR(IPNV + ID)
  188. PS = PS + XC * XC
  189. 20 CONTINUE
  190. *** write (6,*) ' ps - 2 ',ps
  191. * end do
  192. IF (PS.LE.0.D0) THEN
  193. CALL ERREUR(162)
  194. RETURN
  195. ENDIF
  196. IF (MONAMO.EQ.'FLOTTANT') THEN
  197. IPALB(I,1) = 24
  198. XPALB(I,7) = XAMON
  199. ID1 = 7
  200. ELSE
  201. ID1 = 6
  202. ENDIF
  203. ID2 = ID1 + IDIM
  204. DO 22 ID = 1,IDIM
  205. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  206. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  207. 22 CONTINUE
  208. * end do
  209. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  210. IPLIB(I,1) = IPLAC
  211.  
  212. *
  213. * --- choc {l{mentaire POINT_CERCLE_MOBILE
  214. * avec ou sans amortissement
  215. *
  216. ELSE IF (ITYP.EQ.33) THEN
  217.  
  218. CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT',L0,IP0,
  219. & 'POINT',I1,X1,' ',L1,INOA)
  220. IF (IERR.NE.0) RETURN
  221. CALL ACCTAB(ITLB,'MOT',I0,X0,'CERCLE',L0,IP0,
  222. & 'POINT',I1,X1,' ',L1,INOB)
  223. IF (IERR.NE.0) RETURN
  224. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  225. & 'POINT',I1,X1,' ',L1,IPOI)
  226. IF (IERR.NE.0) RETURN
  227. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  228. & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
  229. IF (IERR.NE.0) RETURN
  230. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
  231. & 'FLOTTANT',I0,XRAYO,' ',L1,IP1)
  232. IF (IERR.NE.0) RETURN
  233. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  234. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  235. IF (IERR.NE.0) RETURN
  236. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  237. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  238. IF (IERR.NE.0) RETURN
  239. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  240. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  241. IF (IERR.NE.0) RETURN
  242. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  243. & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
  244. IF (IERR.NE.0) RETURN
  245. MONINTER = ' '
  246. CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  247. & IP0,MONINTER,I0,X1,' ',LINTER,IP1)
  248. IF (IERR.NE.0) RETURN
  249. *
  250. MONAMO = ' '
  251. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  252. & MONAMO,I0,XAMON,' ',L1,IP1)
  253. IF (IERR.NE.0) RETURN
  254. *
  255. IPALB(I,1) = ITYP
  256. IPALB(I,3) = IDIM
  257. IPALB(I,4) = 1
  258. IF (.NOT.LINTER) THEN
  259. IPALB(I,4) = 0
  260. ENDIF
  261. XPALB(I,1) = XRAIN
  262. XPALB(I,2) = XRAYO
  263. XPALB(I,3) = XGLIS
  264. XPALB(I,4) = XADHE
  265. XPALB(I,5) = XRAIT
  266. XPALB(I,6) = XAMOT
  267. *
  268. * normalisation de la normale
  269. *
  270. IPNV = (IDIM + 1) * (IPOI - 1)
  271. IPNOA = (IDIM + 1) * (INOA - 1)
  272. IPNOB = (IDIM + 1) * (INOB - 1)
  273. PS = 0.D0
  274. DO 202 ID = 1,IDIM
  275. XC = XCOOR(IPNV + ID)
  276. PS = PS + XC * XC
  277. 202 CONTINUE
  278. *** write (6,*) ' ps - 3 ',ps
  279. IF (PS.LE.0.D0) THEN
  280. CALL ERREUR(162)
  281. RETURN
  282. ENDIF
  283. IF (MONAMO.EQ.'FLOTTANT') THEN
  284. IPALB(I,1) = 34
  285. XPALB(I,7) = XAMON
  286. ID1 = 7
  287. ELSE
  288. ID1 = 6
  289. ENDIF
  290. ID2 = ID1 + IDIM
  291. DO 222 ID = 1,IDIM
  292. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  293. XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  294. 222 CONTINUE
  295. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  296. IPLIB(I,1) = IPLAC
  297. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  298. IPLIB(I,2) = IPLAC
  299. *
  300. * --- choc {l{mentaire CERCLE_CERCLE_FROTTEMENT
  301. * avec ou sans amortissement
  302. *
  303. ELSE IF (ITYP.EQ.25) THEN
  304. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  305. & 'POINT',I1,X1,' ',L1,IMOD)
  306. IF (IERR.NE.0) RETURN
  307. CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
  308. & 'POINT',I1,X1,' ',L1,IEXC)
  309. IF (IERR.NE.0) RETURN
  310. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  311. & 'POINT',I1,X1,' ',L1,IPOI)
  312. IF (IERR.NE.0) RETURN
  313. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  314. & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
  315. IF (IERR.NE.0) RETURN
  316. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_BUTEE',L0,IP0,
  317. & 'FLOTTANT',I0,XRAYB,' ',L1,IP1)
  318. IF (IERR.NE.0) RETURN
  319. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_SUPPORT',L0,IP0,
  320. & 'FLOTTANT',I0,XRAYP,' ',L1,IP1)
  321. IF (IERR.NE.0) RETURN
  322. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  323. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  324. IF (IERR.NE.0) RETURN
  325. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  326. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  327. IF (IERR.NE.0) RETURN
  328. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  329. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  330. IF (IERR.NE.0) RETURN
  331. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  332. & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
  333. IF (IERR.NE.0) RETURN
  334. MONINTER = ' '
  335. CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
  336. & IP0,MONINTER,I0,X1,' ',LINTER,IP1)
  337. IF (IERR.NE.0) RETURN
  338. *
  339. MONAMO = ' '
  340. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
  341. & MONAMO,I0,XAMON,' ',L1,IP1)
  342. IF (IERR.NE.0) RETURN
  343. *
  344. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  345. * pas lu la notice jusqu'au bout :
  346. IF(XRAIT.LT.0.D0) THEN
  347. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  348. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  349. WRITE(IOIMP,*)
  350. & 'utilisation du modele de frottement regularise d ODEN'
  351. ENDIF
  352. IF(XAMOT.LE.0D0) THEN
  353. c ERREUR: %m1:8 = %r1 inferieur a %r2
  354. MOTERR(1:8)='AMOR*_T*'
  355. REAERR(1)=XAMOT
  356. REAERR(2)=0.D0
  357. CALL ERREUR(41)
  358. RETURN
  359. ENDIF
  360. ENDIF
  361.  
  362. IPALB(I,1) = ITYP
  363. IPALB(I,3) = IDIM
  364. IPALB(I,4) = 1
  365. IF (.NOT.LINTER) THEN
  366. IPALB(I,4) = 0
  367. ENDIF
  368. XPALB(I,1) = XRAIN
  369. XPALB(I,2) = XRAYB
  370. XPALB(I,3) = XGLIS
  371. XPALB(I,4) = XADHE
  372. XPALB(I,5) = XRAIT
  373. XPALB(I,6) = XAMOT
  374. *
  375. * normalisation de la normale
  376. *
  377. IPNV = (IDIM + 1) * (IPOI - 1)
  378. IPEX = (IDIM + 1) * (IEXC - 1)
  379. PS = 0.D0
  380. DO 30 ID = 1,IDIM
  381. XC = XCOOR(IPNV + ID)
  382. PS = PS + XC * XC
  383. 30 CONTINUE
  384. * end do
  385. *** write (6,*) ' ps - 4 ',ps
  386. IF (PS.LE.0.D0) THEN
  387. CALL ERREUR(162)
  388. RETURN
  389. ENDIF
  390. IF (MONAMO.EQ.'FLOTTANT') THEN
  391. ID1 = 7
  392. IPALB(I,1) = 26
  393. XPALB(I,7) = XAMON
  394. ELSE
  395. ID1 = 6
  396. ENDIF
  397. ID10 = ID1 + 9*IDIM
  398. XPALB(I,ID10+1) = XRAYP
  399. ID2 = ID1 + IDIM
  400. ID3 = ID1 + 2*IDIM
  401. DO 32 ID = 1,IDIM
  402. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  403. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  404. 32 CONTINUE
  405. * end do
  406. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  407. IPLIB(I,1) = IPLAC
  408. *
  409. * --- choc {l{mentaire ..._CERCLE...
  410. *
  411. * ELSE IF (ITYP.EQ. ) THEN
  412. * ...
  413. * ...
  414. ENDIF
  415. *
  416. END
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  

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