Télécharger dyn201.eso

Retour à la liste

Numérotation des lignes :

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

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