Télécharger dyn201.eso

Retour à la liste

Numérotation des lignes :

  1. C DYN201 SOURCE BP208322 16/06/06 21:15:02 8944
  2. SUBROUTINE DYN201(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 ILIB (liaison de type ..._PLAN). *
  13. * Liaison POINT_PLAN avec ou sans amortissement *
  14. * Liaison POINT_PLAN_FROTTEMENT avec ou sans amortissement *
  15. * Liaison CERCLE_PLAN_FROTTEMENT avec ou sans amortissement *
  16. * Liaison POINT_PLAN_FLUIDE *
  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. -INC SMEVOLL
  35. -INC SMLREEL
  36. *
  37. SEGMENT MTLIAB
  38. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  39. REAL*8 XPALB(NLIAB,NXPALB)
  40. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  41. ENDSEGMENT
  42. *
  43. LOGICAL L1,L0,LPERM
  44. CHARACTER*8 MONAMO,MONSEUIL,CHARRE,TYPRET,MARAID,MONPER
  45. *
  46. MTLIAB = KTLIAB
  47. *
  48. * --- choc {l{mentaire POINT_PLAN avec ou sans amortissement
  49. *
  50. IF (ITYP.EQ.1) 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,'NORMALE',L0,IP0,
  55. & 'POINT',I1,X1,' ',L1,IPOI)
  56. IF (IERR.NE.0) RETURN
  57.  
  58. MARAID = ' '
  59. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  60. & MARAID,I0,XRAID,' ',L1,IP1)
  61. IF (MARAID .EQ. 'ENTIER ') THEN
  62. XRAID = 1.D0*I1
  63. MARAID = 'FLOTTANT'
  64. ENDIF
  65. IF (IERR.NE.0) RETURN
  66.  
  67. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  68. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  69. IF (IERR.NE.0) RETURN
  70.  
  71. MONPER = ' '
  72. LPERM = .FALSE.
  73. IPERM = 0
  74. CALL ACCTAB(ITLB,'MOT',I1,X0,'LIAISON_PERMANENTE',L0,
  75. & IP0,MONPER,I0,X1,' ',LPERM,IP1)
  76. IF (IERR.NE.0) RETURN
  77. IF (LPERM) THEN
  78. IPERM = 1
  79. ENDIF
  80.  
  81. TYPRET = ' '
  82. CALL ACCTAB(ITLB,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,IP0,
  83. & TYPRET,I1,X1,' ',L1,IPEVO)
  84. IF (IERR.NE.0) RETURN
  85. *
  86. MONAMO = ' '
  87. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  88. & MONAMO,I1,XAMON,'CHARRE',L1,IP1)
  89. IF (IERR.NE.0) RETURN
  90. IF (MONAMO .EQ. 'ENTIER ') THEN
  91. XAMON = 1.D0*I1
  92. MONAMO = 'FLOTTANT'
  93. ENDIF
  94.  
  95. MONSEUIL = ' '
  96. CALL ACCTAB(ITLB,'MOT',I0,X0,'SEUIL_PLASTIQUE',L0,IP0,
  97. & MONSEUIL,I1,XSEUIL,'CHARRE',L1,IP1)
  98. IF (MONSEUIL .EQ. 'ENTIER ') THEN
  99. XSEUIL = 1.D0*I1
  100. MONSEUIL = 'FLOTTANT'
  101. ENDIF
  102. IF (IERR.NE.0) RETURN
  103.  
  104.  
  105. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  106. CALL ERREUR(891)
  107. RETURN
  108. ENDIF
  109. *
  110. *
  111. IPALB(I,1) = ITYP
  112. IPALB(I,3) = IDIM
  113. IPALB(I,4) = IPERM
  114. XPALB(I,1) = XRAID
  115. XPALB(I,2) = XJEU
  116. *
  117. IPNV = (IDIM + 1) * (IPOI - 1)
  118. PS = 0.D0
  119. DO 10 ID = 1,IDIM
  120. XC = XCOOR(IPNV + ID)
  121. PS = PS + XC * XC
  122. 10 CONTINUE
  123. * end do
  124. IF (PS.LE.0.D0) THEN
  125. CALL ERREUR(162)
  126. RETURN
  127. ENDIF
  128. ID1 = 3
  129. IF (MONAMO.EQ.'FLOTTANT') THEN
  130. XPALB(I,3) = XAMON
  131. ELSE
  132. XPALB(I,3) = 0.D0
  133. ENDIF
  134. IF (MONSEUIL .EQ.'FLOTTANT') THEN
  135. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  136. IPALB(I,1) = 101
  137. ELSE
  138. IPALB(I,1) = 100
  139. ENDIF
  140. ID1 = 4
  141. XPALB(I,ID1) = XSEUIL
  142. ELSE
  143. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  144. IPALB(I,1) = 102
  145. ENDIF
  146. ENDIF
  147.  
  148. *
  149. DO 12 ID = 1,IDIM
  150. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  151. 12 CONTINUE
  152. * end do
  153. IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN
  154. MEVOLL = IPEVO
  155. *
  156. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  157. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans des
  158. * tableaux xabsci et xordon
  159. *
  160. SEGACT MEVOLL
  161. KEVOLL = IEVOLL(1)
  162. SEGACT KEVOLL
  163. MLREE1 = IPROGX
  164. MLREE2 = IPROGY
  165. SEGACT MLREE1
  166. SEGACT MLREE2
  167. NIP = XABSCI(/2)
  168. *
  169. DO 16 MM=1,NIP
  170. XABSCI (I,MM) = MLREE1.PROG(MM)
  171. XORDON (I,MM) = MLREE2.PROG(MM)
  172. 16 CONTINUE
  173. *
  174. SEGDES MLREE1
  175. SEGDES MLREE2
  176. SEGDES KEVOLL
  177. SEGDES MEVOLL
  178. ENDIF
  179. *
  180. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  181. IPLIB(I,1) = IPLAC
  182. *
  183. * --- choc {l{mentaire POINT_PLAN_FROTTEMENT avec ou sans amortissement
  184. *
  185. ELSE IF (ITYP.EQ.3) THEN
  186. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  187. & 'POINT',I1,X1,' ',L1,IMOD)
  188. IF (IERR.NE.0) RETURN
  189. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  190. & 'POINT',I1,X1,' ',L1,IPOI)
  191. IF (IERR.NE.0) RETURN
  192. MARAID = ' '
  193. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  194. & MARAID,I0,XRAIN,' ',L1,IP1)
  195. IF (MARAID .EQ. 'ENTIER ') THEN
  196. XRAIN = 1.D0*I0
  197. MARAID = 'FLOTTANT'
  198. ENDIF
  199.  
  200. IF (IERR.NE.0) RETURN
  201. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  202. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  203. IF (IERR.NE.0) RETURN
  204. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  205. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  206. IF (IERR.NE.0) RETURN
  207. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  208. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  209. IF (IERR.NE.0) RETURN
  210. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  211. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  212. IF (IERR.NE.0) RETURN
  213. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  214. & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
  215. IF (IERR.NE.0) RETURN
  216. TYPRET = ' '
  217. CALL ACCTAB(ITLB,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,IP0,
  218. & TYPRET,I1,X1,' ',L1,IPEVO)
  219. IF (IERR.NE.0) RETURN
  220. *
  221. MONAMO = ' '
  222. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  223. & MONAMO,I1,XAMON,' ',L1,IP1)
  224. IF (IERR.NE.0) RETURN
  225. IF (MONAMO .EQ. 'ENTIER ') THEN
  226. XAMON = 1.D0*I1
  227. MONAMO = 'FLOTTANT'
  228. ENDIF
  229. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  230. CALL ERREUR(891)
  231. RETURN
  232. ENDIF
  233. IF (TYPRET.EQ.'EVOLUTIO') THEN
  234. ITYP = 103
  235. XRAIN = 0.d0
  236. ENDIF
  237. *
  238. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  239. * pas lu la notice jusqu'au bout :
  240. IF(XRAIT.LT.0.D0) THEN
  241. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  242. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  243. WRITE(IOIMP,*)
  244. & 'utilisation du modele de frottement regularise d ODEN'
  245. ENDIF
  246. IF(XAMOT.LE.0D0) THEN
  247. c ERREUR: %m1:8 = %r1 inferieur a %r2
  248. MOTERR(1:8)='AMOR*_T*'
  249. REAERR(1)=XAMOT
  250. REAERR(2)=0.D0
  251. CALL ERREUR(41)
  252. RETURN
  253. ENDIF
  254. ENDIF
  255.  
  256. IPALB(I,1) = ITYP
  257. IPALB(I,3) = IDIM
  258. XPALB(I,1) = XRAIN
  259. XPALB(I,2) = XJEU
  260. XPALB(I,3) = XGLIS
  261. XPALB(I,4) = XADHE
  262. XPALB(I,5) = XRAIT
  263. XPALB(I,6) = XAMOT
  264. IF (MONAMO.EQ.'FLOTTANT') THEN
  265. XPALB(I,7) = XAMON
  266. ELSE
  267. XPALB(I,7) = 0.D0
  268. ENDIF
  269. *
  270. IPNV = (IDIM + 1) * (IPOI - 1)
  271. PS = 0.D0
  272. DO 20 ID = 1,IDIM
  273. XC = XCOOR(IPNV + ID)
  274. PS = PS + XC * XC
  275. 20 CONTINUE
  276. * end do
  277. IF (PS.LE.0.D0) THEN
  278. CALL ERREUR(162)
  279. RETURN
  280. ENDIF
  281. ID1 = 7
  282. DO 22 ID = 1,IDIM
  283. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  284. 22 CONTINUE
  285. * end do
  286.  
  287. IF (IPALB(I,1) .EQ. 103) THEN
  288. MEVOLL = IPEVO
  289. *
  290. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  291. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans des
  292. * tableaux xabsci et xordon
  293. *
  294. SEGACT MEVOLL
  295. KEVOLL = IEVOLL(1)
  296. SEGACT KEVOLL
  297. MLREE1 = IPROGX
  298. MLREE2 = IPROGY
  299. SEGACT MLREE1
  300. SEGACT MLREE2
  301. NIP = XABSCI(/2)
  302. *
  303. DO 26 MM=1,NIP
  304. XABSCI (I,MM) = MLREE1.PROG(MM)
  305. XORDON (I,MM) = MLREE2.PROG(MM)
  306. 26 CONTINUE
  307. *
  308. SEGDES MLREE1
  309. SEGDES MLREE2
  310. SEGDES KEVOLL
  311. SEGDES MEVOLL
  312. ENDIF
  313. *
  314. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  315. IPLIB(I,1) = IPLAC
  316. *
  317. * --- choc {l{mentaire CERCLE_PLAN_FROTTEMENT avec ou sans amortissement
  318. *
  319. ELSE IF (ITYP.EQ.5) THEN
  320. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  321. & 'POINT',I1,X1,' ',L1,IMOD)
  322. IF (IERR.NE.0) RETURN
  323. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  324. & 'POINT',I1,X1,' ',L1,IPOI)
  325. IF (IERR.NE.0) RETURN
  326. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  327. & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
  328. IF (IERR.NE.0) RETURN
  329. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU',L0,IP0,
  330. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  331. IF (IERR.NE.0) RETURN
  332. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_SUPPORT',L0,IP0,
  333. & 'FLOTTANT',I0,XRAYP,' ',L1,IP1)
  334. IF (IERR.NE.0) RETURN
  335. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
  336. & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
  337. IF (IERR.NE.0) RETURN
  338. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
  339. & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
  340. IF (IERR.NE.0) RETURN
  341. CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
  342. & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
  343. IF (IERR.NE.0) RETURN
  344. CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
  345. & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
  346. IF (IERR.NE.0) RETURN
  347. *
  348. MONAMO = ' '
  349. CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  350. & MONAMO,I1,XAMON,' ',L1,IP1)
  351. IF (IERR.NE.0) RETURN
  352. *
  353. *bp,2016 petit message informatif pour ceux qui, comme moi, n'auraient
  354. * pas lu la notice jusqu'au bout :
  355. IF(XRAIT.LT.0.D0) THEN
  356. IF(XAMOT.LE.0D0.OR.IIMPI.GT.0) THEN
  357. WRITE(IOIMP,*) 'Liaison elementaire ..._FROTTEMENT numero',I
  358. WRITE(IOIMP,*)
  359. & 'utilisation du modele de frottement regularise d ODEN'
  360. ENDIF
  361. IF(XAMOT.LE.0D0) THEN
  362. c ERREUR: %m1:8 = %r1 inferieur a %r2
  363. MOTERR(1:8)='AMOR*_T*'
  364. REAERR(1)=XAMOT
  365. REAERR(2)=0.D0
  366. CALL ERREUR(41)
  367. RETURN
  368. ENDIF
  369. ENDIF
  370.  
  371. IPALB(I,1) = ITYP
  372. IPALB(I,3) = IDIM
  373. XPALB(I,1) = XRAIN
  374. XPALB(I,2) = XJEU
  375. XPALB(I,3) = XGLIS
  376. XPALB(I,4) = XADHE
  377. XPALB(I,5) = XRAIT
  378. XPALB(I,6) = XAMOT
  379. *
  380. IPNV = (IDIM + 1) * (IPOI - 1)
  381. PS = 0.D0
  382. DO 30 ID = 1,IDIM
  383. XC = XCOOR(IPNV + ID)
  384. PS = PS + XC * XC
  385. 30 CONTINUE
  386. * end do
  387. IF (PS.LE.0.D0) THEN
  388. CALL ERREUR(162)
  389. RETURN
  390. ENDIF
  391. IF (MONAMO.EQ.'FLOTTANT') THEN
  392. IPALB(I,1) = 6
  393. XPALB(I,7) = XAMON
  394. ID1 = 7
  395. ELSE
  396. ID1 = 6
  397. ENDIF
  398. ID8 = ID1 + 7*IDIM
  399. XPALB(I,ID8+1) = XRAYP
  400. DO 32 ID = 1,IDIM
  401. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  402. 32 CONTINUE
  403. * end do
  404. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  405. IPLIB(I,1) = IPLAC
  406. *
  407. * --- choc {l{mentaire POINT_PLAN_FLUIDE
  408. *
  409. ELSE IF (ITYP.EQ.7) THEN
  410. CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
  411. & 'POINT',I1,X1,' ',L1,IMOD)
  412. IF (IERR.NE.0) RETURN
  413. CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
  414. & 'POINT',I1,X1,' ',L1,IPOI)
  415. IF (IERR.NE.0) RETURN
  416. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_INERTIE',L0,IP0,
  417. & 'FLOTTANT',I0,XINER,' ',L1,IP1)
  418. IF (IERR.NE.0) RETURN
  419. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_CONVECTION',L0,IP0,
  420. & 'FLOTTANT',I0,XCONV,' ',L1,IP1)
  421. IF (IERR.NE.0) RETURN
  422. CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_VISCOSITE',L0,IP0,
  423. & 'FLOTTANT',I0,XVISC,' ',L1,IP1)
  424. IF (IERR.NE.0) RETURN
  425. CALL ACCTAB(ITLB,'MOT',I1,X0,
  426. & 'COEFFICIENT_P_D_C_ELOIGNEMENT',L0,IP0,
  427. & 'FLOTTANT',I0,XPCEL,' ',L1,IP1)
  428. IF (IERR.NE.0) RETURN
  429. CALL ACCTAB(ITLB,'MOT',I1,X0,
  430. & 'COEFFICIENT_P_D_C_RAPPROCHEMENT',L0,IP0,
  431. & 'FLOTTANT',I0,XPCRA,' ',L1,IP1)
  432. IF (IERR.NE.0) RETURN
  433. CALL ACCTAB(ITLB,'MOT',I1,X0,'JEU_FLUIDE',L0,IP0,
  434. & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
  435. IF (IERR.NE.0) RETURN
  436. *
  437. IPALB(I,1) = ITYP
  438. IPALB(I,3) = IDIM
  439. XPALB(I,1) = XINER
  440. XPALB(I,2) = XCONV
  441. XPALB(I,3) = XVISC
  442. XPALB(I,4) = XPCEL
  443. XPALB(I,5) = XPCRA
  444. XPALB(I,6) = XJEU
  445. *
  446. IPNV = (IDIM + 1) * (IPOI - 1)
  447. PS = 0.D0
  448. DO 70 ID = 1,IDIM
  449. XC = XCOOR(IPNV + ID)
  450. PS = PS + XC * XC
  451. 70 CONTINUE
  452. * end do
  453. IF (PS.LE.0.D0) THEN
  454. CALL ERREUR(162)
  455. RETURN
  456. ENDIF
  457. ID1 = 6
  458. DO 72 ID = 1,IDIM
  459. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  460. 72 CONTINUE
  461. * end do
  462. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  463. IPLIB(I,1) = IPLAC
  464. *
  465. * --- choc {l{mentaire ..._PLAN...
  466. *
  467. * ELSE IF (ITYP.EQ. ) THEN
  468. * ...
  469. * ...
  470. ENDIF
  471. *
  472. END
  473.  
  474.  
  475.  
  476.  
  477.  
  478.  
  479.  
  480.  

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