Télécharger dyne22.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE22 SOURCE BP208322 15/07/22 21:15:33 8586
  2. SUBROUTINE DYNE22(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR,
  3. & NIPALB,NIP)
  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. * Détermination des paramètres de liaison pour la base B. *
  12. * *
  13. * Paramètres: *
  14. * *
  15. * e ITLB Table rassemblant la description des liaisons *
  16. * s NLIAB Nombre total de liaisons sur base B. *
  17. * s NXPALB Maxi du nombre de paramètres définissant une liaison. *
  18. * s NPLBB Maxi du nombre de points intervenant dans une liaison. *
  19. * s NPLB Nombre total de points. *
  20. * s IDIMB Dimension de travail des liaisons. *
  21. * s KCPR Segment de points. *
  22. * s NIPALB Maxi du nombre de paramètres définissant une liaison. *
  23. * s NIP Nb de pts dans l'evolution de la loi de comportement *
  24. * *
  25. * Auteur, date de création: Lionel VIVAN, le 21 Septembre 1989 * *
  26. * Modif : Ibrahim PINTO , 05/1997 *
  27. * *
  28. *--------------------------------------------------------------------*
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMEVOLL
  33. -INC SMLREEL
  34. *
  35. SEGMENT,NCPR(XCOOR(/1)/(IDIM+1))
  36. *
  37. LOGICAL L0,L1
  38. CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE
  39. CHARACTER*40 CMOT
  40. *
  41. SEGINI,NCPR
  42. KCPR = NCPR
  43. *
  44. NXPALB = 0
  45. c c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;')
  46. NIPALB = 20
  47. NPLBB = 0
  48. NPLB = 0
  49. IDIMB = 0
  50. NLIAB = 0
  51. C NIP = 1 dans le cas ou la liaison n'est pas ITYP = 16/17 ou ITYP = 50/51
  52. NIP = 1
  53. *
  54. *--------------------------------------------------------------------*
  55. * Boucle sur le nombre de liaisons
  56. *--------------------------------------------------------------------*
  57. IL = 0
  58. 10 CONTINUE
  59. IL = IL+ 1
  60. TYPRET = ' '
  61. CALL ACCTAB(ITLB,'ENTIER',IL,X0,' ',L0,IP0,
  62. & TYPRET,I0,X0,CHARRE,L1,ITLIAI)
  63. IF (IERR.NE.0) RETURN
  64.  
  65. *-----Cas ou la IL ieme liaison existe ------------------------------
  66. IF (ITLIAI.NE.0) THEN
  67. NLIAB = NLIAB + 1
  68. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
  69. & 'MOT',I1,X0,CMOT,L1,IP1)
  70. IF (IERR.NE.0) RETURN
  71. *
  72. * ------ choc élémentaire POINT_PLAN_FLUIDE
  73. *
  74. IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
  75. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  76. & 'POINT',I1,X0,' ',L1,INOE)
  77. IF (IERR.NE.0) RETURN
  78. IF (NCPR(INOE).EQ.0) THEN
  79. NPLB = NPLB + 1
  80. NCPR(INOE) = NPLB
  81. ENDIF
  82. KPLBB = 1
  83. KDIMB = IDIM
  84. KIPALB = 3
  85. KXPALB = 9 + IDIM
  86. NXPALB = MAX(NXPALB,KXPALB)
  87. NIPALB = MAX(NIPALB,KIPALB)
  88. NPLBB = MAX(NPLBB,KPLBB)
  89. IDIMB = MAX(IDIMB,KDIMB)
  90. *
  91. * ------ choc élémentaire POINT_PLAN_FROTTEMENT
  92. *
  93. ELSE IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN
  94. TYPRET = ' '
  95. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  96. & IP0,TYPRET,I1,X1,' ',L1,IPEVO)
  97. IF (IERR.NE.0) RETURN
  98. *
  99. IF (TYPRET.EQ.'EVOLUTIO')THEN
  100. MEVOLL = IPEVO
  101. SEGACT MEVOLL
  102. KEVOLL = IEVOLL(1)
  103. SEGACT KEVOLL
  104. MLREE1 = IPROGX
  105. MLREE2 = IPROGY
  106. SEGACT MLREE1
  107. SEGACT MLREE2
  108. KNIP = MLREE1.PROG(/1)
  109. SEGDES MLREE1
  110. SEGDES MLREE2
  111. SEGDES KEVOLL
  112. SEGDES MEVOLL
  113. ELSE
  114. KNIP = 0
  115. ENDIF
  116. *
  117. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  118. & 'POINT',I1,X0,' ',L1,INOE)
  119. IF (IERR.NE.0) RETURN
  120. IF (NCPR(INOE).EQ.0) THEN
  121. NPLB = NPLB + 1
  122. NCPR(INOE) = NPLB
  123. ENDIF
  124. TYPRET = ' '
  125. KPLBB = 1
  126. KDIMB = IDIM
  127. KIPALB = 3
  128. KXPALB = 7 + 7 * IDIM
  129. NXPALB = MAX(NXPALB,KXPALB)
  130. NIPALB = MAX(NIPALB,KIPALB)
  131. NPLBB = MAX(NPLBB,KPLBB)
  132. IDIMB = MAX(IDIMB,KDIMB)
  133. NIP = MAX(NIP,KNIP)
  134. *
  135. * ------ choc élémentaire POINT_PLAN
  136. *
  137. ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
  138. TYPRET = ' '
  139. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  140. & IP0,TYPRET,I1,X1,' ',L1,IPEVO)
  141. IF (IERR.NE.0) RETURN
  142. *
  143. IF (TYPRET.EQ.'EVOLUTIO')THEN
  144. MEVOLL = IPEVO
  145. SEGACT MEVOLL
  146. KEVOLL = IEVOLL(1)
  147. SEGACT KEVOLL
  148. MLREE1 = IPROGX
  149. MLREE2 = IPROGY
  150. SEGACT MLREE1
  151. SEGACT MLREE2
  152. KNIP = MLREE1.PROG(/1)
  153. SEGDES MLREE1
  154. SEGDES MLREE2
  155. SEGDES KEVOLL
  156. SEGDES MEVOLL
  157. ELSE
  158. KNIP = 0
  159. ENDIF
  160. *
  161. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  162. & 'POINT',I1,X0,' ',L1,INOE)
  163. IF (IERR.NE.0) RETURN
  164. IF (NCPR(INOE).EQ.0) THEN
  165. NPLB = NPLB + 1
  166. NCPR(INOE) = NPLB
  167. ENDIF
  168. TYPRET = ' '
  169. KPLBB = 1
  170. KDIMB = IDIM
  171. KIPALB = 4
  172. KXPALB = 3 + IDIM
  173. ** ianis
  174. TYPRET = ' '
  175. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SEUIL_PLASTIQUE',
  176. & L0,IP0,TYPRET,I1,XSEUIL,CHARRE,L1,IP1)
  177. IF (IERR.NE.0) RETURN
  178. IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ')THEN
  179. KXPALB = 3 + IDIM + 2
  180. ENDIF
  181. *
  182.  
  183. NXPALB = MAX(NXPALB,KXPALB)
  184. NIPALB = MAX(NIPALB,KIPALB)
  185. NPLBB = MAX(NPLBB,KPLBB)
  186. IDIMB = MAX(IDIMB,KDIMB)
  187. NIP = MAX(NIP,KNIP)
  188. *
  189. * ----- choc élémentaire POINT_POINT_FROTTEMENT
  190. *
  191. ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN
  192. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  193. & 'POINT',I1,X0,' ',L1,INOA)
  194. IF (IERR.NE.0) RETURN
  195. IF (NCPR(INOA).EQ.0) THEN
  196. NPLB = NPLB + 1
  197. NCPR(INOA) = NPLB
  198. ENDIF
  199. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  200. & 'POINT',I1,X0,' ',L1,INOB)
  201. IF (IERR.NE.0) RETURN
  202. IF (NCPR(INOB).EQ.0) THEN
  203. NPLB = NPLB + 1
  204. NCPR(INOB) = NPLB
  205. ENDIF
  206. TYPRET = ' '
  207. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  208. & IP0,TYPRET,I1,X1,' ',L1,IPEVO)
  209. IF (IERR.NE.0) RETURN
  210. *
  211. IF (TYPRET.EQ.'EVOLUTIO')THEN
  212. MEVOLL = IPEVO
  213. SEGACT MEVOLL
  214. KEVOLL = IEVOLL(1)
  215. SEGACT KEVOLL
  216. MLREE1 = IPROGX
  217. MLREE2 = IPROGY
  218. SEGACT MLREE1
  219. SEGACT MLREE2
  220. KNIP = MLREE1.PROG(/1)
  221. SEGDES MLREE1
  222. SEGDES MLREE2
  223. SEGDES KEVOLL
  224. SEGDES MEVOLL
  225. ELSE
  226. KNIP = 0
  227. ENDIF
  228.  
  229. KPLBB = 2
  230. KDIMB = IDIM
  231. KIPALB = 3
  232. KXPALB = 7 + 7 * IDIM
  233. NXPALB = MAX(NXPALB,KXPALB)
  234. NIPALB = MAX(NIPALB,KIPALB)
  235. NPLBB = MAX(NPLBB,KPLBB)
  236. IDIMB = MAX(IDIMB,KDIMB)
  237. NIP = MAX(NIP,KNIP)
  238. *
  239. * ----- choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE
  240. *
  241. ELSE IF
  242. & (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN
  243. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  244. & IP0,'EVOLUTIO',I1,X1,' ',L1,IPEVO)
  245. IF (IERR.NE.0) RETURN
  246. *
  247. MEVOLL = IPEVO
  248. SEGACT MEVOLL
  249. KEVOLL = IEVOLL(1)
  250. SEGACT KEVOLL
  251. MLREE1 = IPROGX
  252. MLREE2 = IPROGY
  253. SEGACT MLREE1
  254. SEGACT MLREE2
  255. KNIP = MLREE1.PROG(/1)
  256. SEGDES MLREE1
  257. SEGDES MLREE2
  258. SEGDES KEVOLL
  259. SEGDES MEVOLL
  260. *
  261. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  262. & 'POINT',I1,X0,' ',L1,INOA)
  263. IF (IERR.NE.0) RETURN
  264. IF (NCPR(INOA).EQ.0) THEN
  265. NPLB = NPLB + 1
  266. NCPR(INOA) = NPLB
  267. ENDIF
  268. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  269. & 'POINT',I1,X0,' ',L1,INOB)
  270. IF (IERR.NE.0) RETURN
  271. IF (NCPR(INOB).EQ.0) THEN
  272. NPLB = NPLB + 1
  273. NCPR(INOB) = NPLB
  274. ENDIF
  275. TYPRET = ' '
  276. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',
  277. & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  278. IF (IERR.NE.0) RETURN
  279. KPLBB = 2
  280. KDIMB = IDIM
  281. C
  282. KIPALB = 5
  283. IF (TYPRET.EQ.'FLOTTANT') THEN
  284. KXPALB = 5 + IDIM
  285. ELSE IF (TYPRET.EQ.' ') THEN
  286. KXPALB = 4 + IDIM
  287. ELSE
  288. CALL ERREUR(522)
  289. RETURN
  290. ENDIF
  291. NXPALB = MAX(NXPALB,KXPALB)
  292. NIPALB = MAX(NIPALB,KIPALB)
  293. NPLBB = MAX(NPLBB,KPLBB)
  294. IDIMB = MAX(IDIMB,KDIMB)
  295. NIP = MAX(NIP,KNIP)
  296. *
  297. * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE
  298. *
  299. ELSE IF
  300. & (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN
  301. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  302. & IP0,'EVOLUTIO',I1,X1,' ',L1,IPEVO)
  303. IF (IERR.NE.0) RETURN
  304. *
  305. MEVOLL = IPEVO
  306. SEGACT MEVOLL
  307. KEVOLL = IEVOLL(1)
  308. SEGACT KEVOLL
  309. MLREE1 = IPROGX
  310. MLREE2 = IPROGY
  311. SEGACT MLREE1
  312. SEGACT MLREE2
  313. KNIP = MLREE1.PROG(/1)
  314. SEGDES MLREE1
  315. SEGDES MLREE2
  316. SEGDES KEVOLL
  317. SEGDES MEVOLL
  318. *
  319. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  320. & 'POINT',I1,X0,' ',L1,INOA)
  321. IF (IERR.NE.0) RETURN
  322. IF (NCPR(INOA).EQ.0) THEN
  323. NPLB = NPLB + 1
  324. NCPR(INOA) = NPLB
  325. ENDIF
  326. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  327. & 'POINT',I1,X0,' ',L1,INOB)
  328. IF (IERR.NE.0) RETURN
  329. IF (NCPR(INOB).EQ.0) THEN
  330. NPLB = NPLB + 1
  331. NCPR(INOB) = NPLB
  332. ENDIF
  333. TYPRET = ' '
  334. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',
  335. & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  336. IF (IERR.NE.0) RETURN
  337. KPLBB = 2
  338. *
  339. * NW Dans le cas de la rotule, on passe en dimension 6
  340. * car on aura Ux,Uy,Uz,Rx,Ry,Rz
  341. *
  342. KDIMB = 3+IDIM
  343. *
  344. * KIPALB = 5 : nombre maxi de parametres pour la liaison
  345. *
  346. KIPALB = 5
  347. IF (TYPRET.EQ.'FLOTTANT') THEN
  348. KXPALB = 5 + IDIM
  349. ELSE IF (TYPRET.EQ.' ') THEN
  350. KXPALB = 4 + IDIM
  351. ELSE
  352. CALL ERREUR(522)
  353. RETURN
  354. ENDIF
  355. NXPALB = MAX(NXPALB,KXPALB)
  356. NIPALB = MAX(NIPALB,KIPALB)
  357. NPLBB = MAX(NPLBB,KPLBB)
  358. IDIMB = MAX(IDIMB,KDIMB)
  359. NIP = MAX(NIP,KNIP)
  360. *
  361. * ----- choc élémentaire POINT_POINT
  362. *
  363. ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN
  364. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0,
  365. & 'POINT',I1,X0,' ',L1,INOA)
  366. IF (IERR.NE.0) RETURN
  367. IF (NCPR(INOA).EQ.0) THEN
  368. NPLB = NPLB + 1
  369. NCPR(INOA) = NPLB
  370. ENDIF
  371. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0,
  372. & 'POINT',I1,X0,' ',L1,INOB)
  373. IF (IERR.NE.0) RETURN
  374. IF (NCPR(INOB).EQ.0) THEN
  375. NPLB = NPLB + 1
  376. NCPR(INOB) = NPLB
  377. ENDIF
  378.  
  379. TYPRET = ' '
  380. CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0,
  381. & IP0,TYPRET,I1,X1,' ',L1,IPEVO)
  382. IF (IERR.NE.0) RETURN
  383. *
  384. IF (TYPRET.EQ.'EVOLUTIO')THEN
  385. MEVOLL = IPEVO
  386. SEGACT MEVOLL
  387. KEVOLL = IEVOLL(1)
  388. SEGACT KEVOLL
  389. MLREE1 = IPROGX
  390. MLREE2 = IPROGY
  391. SEGACT MLREE1
  392. SEGACT MLREE2
  393. KNIP = MLREE1.PROG(/1)
  394. SEGDES MLREE1
  395. SEGDES MLREE2
  396. SEGDES KEVOLL
  397. SEGDES MEVOLL
  398. ELSE
  399. KNIP = 0
  400. ENDIF
  401.  
  402. KPLBB = 2
  403. KDIMB = IDIM
  404. KIPALB = 4
  405. KXPALB = 3 + IDIM
  406. NXPALB = MAX(NXPALB,KXPALB)
  407. NIPALB = MAX(NIPALB,KIPALB)
  408. NPLBB = MAX(NPLBB,KPLBB)
  409. IDIMB = MAX(IDIMB,KDIMB)
  410. NIP = MAX(NIP,KNIP)
  411. *
  412. * ianis
  413. *
  414. * ----- choc élémentaire POINT_CERCLE_MOBILE
  415. *
  416. ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN
  417. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT',L0,IP0,
  418. & 'POINT',I1,X0,' ',L1,INOA)
  419. IF (IERR.NE.0) RETURN
  420. IF (NCPR(INOA).EQ.0) THEN
  421. NPLB = NPLB + 1
  422. NCPR(INOA) = NPLB
  423. ENDIF
  424. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'CERCLE',L0,IP0,
  425. & 'POINT',I1,X0,' ',L1,INOB)
  426. IF (IERR.NE.0) RETURN
  427. IF (NCPR(INOB).EQ.0) THEN
  428. NPLB = NPLB + 1
  429. NCPR(INOB) = NPLB
  430. ENDIF
  431. TYPRET = ' '
  432. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  433. & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  434. IF (IERR.NE.0) RETURN
  435. KPLBB = 2
  436. * on neglige les rotations
  437. KDIMB = IDIM
  438. KIPALB = 4
  439. IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ') THEN
  440. KXPALB = 7 + 9 * IDIM
  441. ELSE IF (TYPRET.EQ.' ') THEN
  442. KXPALB = 6 + 9 * IDIM
  443. ELSE
  444. CALL ERREUR(522)
  445. RETURN
  446. ENDIF
  447. NXPALB = MAX(NXPALB,KXPALB)
  448. NIPALB = MAX(NIPALB,KIPALB)
  449. NPLBB = MAX(NPLBB,KPLBB)
  450. IDIMB = MAX(IDIMB,KDIMB)
  451. *
  452. *
  453. * ----- choc élémentaire POINT_CERCLE_FROTTEMENT
  454. *
  455. ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN
  456. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  457. & 'POINT',I1,X0,' ',L1,INOE)
  458. IF (IERR.NE.0) RETURN
  459. IF (NCPR(INOE).EQ.0) THEN
  460. NPLB = NPLB + 1
  461. NCPR(INOE) = NPLB
  462. ENDIF
  463. TYPRET = ' '
  464. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  465. & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  466. IF (IERR.NE.0) RETURN
  467. KPLBB = 1
  468. KDIMB = IDIM
  469. KIPALB = 4
  470. IF (TYPRET.EQ.'FLOTTANT') THEN
  471. KXPALB = 7 + 9 * IDIM
  472. ELSE IF (TYPRET.EQ.' ') THEN
  473. KXPALB = 6 + 9 * IDIM
  474. ELSE
  475. CALL ERREUR(522)
  476. RETURN
  477. ENDIF
  478. NXPALB = MAX(NXPALB,KXPALB)
  479. NIPALB = MAX(NIPALB,KIPALB)
  480. NPLBB = MAX(NPLBB,KPLBB)
  481. IDIMB = MAX(IDIMB,KDIMB)
  482. *
  483. * ----- choc élémentaire POINT_CERCLE
  484. *
  485. ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN
  486. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  487. & 'POINT',I1,X0,' ',L1,INOE)
  488. IF (IERR.NE.0) RETURN
  489. IF (NCPR(INOE).EQ.0) THEN
  490. NPLB = NPLB + 1
  491. NCPR(INOE) = NPLB
  492. ENDIF
  493. TYPRET = ' '
  494. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',
  495. & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  496. IF (IERR.NE.0) RETURN
  497. KPLBB = 1
  498. KDIMB = IDIM
  499. KIPALB = 3
  500. IF (TYPRET.EQ.'FLOTTANT') THEN
  501. KXPALB = 3 + 2 * IDIM
  502. ELSE IF (TYPRET.EQ.' ') THEN
  503. KXPALB = 2 + 2 * IDIM
  504. ELSE
  505. CALL ERREUR(522)
  506. RETURN
  507. ENDIF
  508. NXPALB = MAX(NXPALB,KXPALB)
  509. NIPALB = MAX(NIPALB,KIPALB)
  510. NPLBB = MAX(NPLBB,KPLBB)
  511. IDIMB = MAX(IDIMB,KDIMB)
  512. *
  513. * ----- choc élémentaire CERCLE_PLAN_FROTTEMENT
  514. *
  515. ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN
  516. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  517. & 'POINT',I1,X0,' ',L1,INOE)
  518. IF (IERR.NE.0) RETURN
  519. IF (NCPR(INOE).EQ.0) THEN
  520. NPLB = NPLB + 1
  521. NCPR(INOE) = NPLB
  522. ENDIF
  523. TYPRET = ' '
  524. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  525. & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  526. IF (IERR.NE.0) RETURN
  527. KPLBB = 1
  528. KDIMB = 2 * IDIM
  529. KIPALB = 3
  530. IF (TYPRET.EQ.'FLOTTANT') THEN
  531. KXPALB = 8 + 7 * IDIM
  532. ELSE IF (TYPRET.EQ.' ') THEN
  533. KXPALB = 7 + 7 * IDIM
  534. ELSE
  535. CALL ERREUR(522)
  536. RETURN
  537. ENDIF
  538. NXPALB = MAX(NXPALB,KXPALB)
  539. NIPALB = MAX(NIPALB,KIPALB)
  540. NPLBB = MAX(NPLBB,KPLBB)
  541. IDIMB = MAX(IDIMB,KDIMB)
  542. *
  543. * ----- choc élémentaire CERCLE_CERCLE_FROTTEMENT
  544. *
  545. ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN
  546. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  547. & 'POINT',I1,X0,' ',L1,INOE)
  548. IF (IERR.NE.0) RETURN
  549. IF (NCPR(INOE).EQ.0) THEN
  550. NPLB = NPLB + 1
  551. NCPR(INOE) = NPLB
  552. ENDIF
  553. TYPRET = ' '
  554. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,
  555. & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  556. IF (IERR.NE.0) RETURN
  557. KPLBB = 1
  558. KDIMB = 2 * IDIM
  559. KIPALB = 4
  560. IF (TYPRET.EQ.'FLOTTANT') THEN
  561. KXPALB = 8 + 9*IDIM
  562. ELSE IF (TYPRET.EQ.' ') THEN
  563. KXPALB = 7 + 9*IDIM
  564. ELSE
  565. CALL ERREUR(522)
  566. RETURN
  567. ENDIF
  568. NXPALB = MAX(NXPALB,KXPALB)
  569. NIPALB = MAX(NIPALB,KIPALB)
  570. NPLBB = MAX(NPLBB,KPLBB)
  571. IDIMB = MAX(IDIMB,KDIMB)
  572. *
  573. * ----- choc élémentaire PROFIL_PROFIL_INTERIEUR
  574. * ----- choc élémentaire PROFIL_PROFIL_EXTERIEUR
  575. *
  576. ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR' .OR.
  577. & CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN
  578. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0,
  579. & 'MAILLAGE',I1,X0,' ',L1,IMA1)
  580. IF (IERR.NE.0) RETURN
  581. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0,
  582. & 'MAILLAGE',I1,X0,' ',L1,IMA2)
  583. IF (IERR.NE.0) RETURN
  584. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  585. & 'POINT',I1,X0,' ',L1,INOE)
  586. IF (IERR.NE.0) RETURN
  587. IF (NCPR(INOE).EQ.0) THEN
  588. NPLB = NPLB + 1
  589. NCPR(INOE) = NPLB
  590. ENDIF
  591. KPLBB = 1
  592. KDIMB = 3
  593. CALL CHANGE(IMA1,1)
  594. CALL CHANGE(IMA2,1)
  595. MELEME = IMA1
  596. SEGACT MELEME
  597. NOMBN1 = NUM(/2)
  598. SEGDES MELEME
  599. MELEME = IMA2
  600. SEGACT MELEME
  601. NOMBN2 = NUM(/2)
  602. SEGDES MELEME
  603. KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2
  604. KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2
  605. NXPALB = MAX(NXPALB,KXPALB)
  606. NIPALB = MAX(NIPALB,KIPALB)
  607. NPLBB = MAX(NPLBB,KPLBB)
  608. IDIMB = MAX(IDIMB,KDIMB)
  609. *
  610. * ----- choc élémentaire LIGNE_LIGNE_FROTTEMENT
  611. *
  612. ELSE IF
  613. & (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN
  614. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  615. & 'MAILLAGE',I1,X1,' ',L1,IMAI)
  616. IF (IERR.NE.0) RETURN
  617. MONESC= ' '
  618. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  619. & MONESC,I1,X1,CHARRE,L1,IESC)
  620. TYPRET = ' '
  621. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS',
  622. & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  623. IF (IERR.NE.0) RETURN
  624. *
  625. MELEME = IMAI
  626. SEGACT MELEME
  627. NELEMA = NUM(/2)
  628. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  629. NNOEMA = NELEMA
  630. ELSE
  631. NNOEMA = NELEMA+1
  632. ENDIF
  633. INOE = NUM(1,1)
  634. IF (NCPR(INOE).EQ.0) THEN
  635. NPLB = NPLB + 1
  636. NCPR(INOE) = NPLB
  637. ENDIF
  638. DO 20 IE = 1,(NNOEMA-1)
  639. INOE = NUM(2,IE)
  640. IF (NCPR(INOE).EQ.0) THEN
  641. NPLB = NPLB + 1
  642. NCPR(INOE) = NPLB
  643. ENDIF
  644. 20 CONTINUE
  645. SEGDES MELEME
  646. * Maillage_esclave
  647. IF (MONESC.EQ.'POINT') THEN
  648. * La ligne-esclave est un point
  649. IF (NCPR(IESC).EQ.0) THEN
  650. NPLB = NPLB + 1
  651. NCPR(IESC) = NPLB
  652. ENDIF
  653. NNOEES=1
  654. ELSE
  655. IF (MONESC.EQ.'MAILLAGE') THEN
  656. * La ligne-esclave est un MAILLAGE
  657. MELEME = IESC
  658. SEGACT MELEME
  659. NELEES = NUM(/2)
  660. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  661. NNOEES = NELEES
  662. ELSE
  663. NNOEES = NELEES+1
  664. ENDIF
  665. INOE = NUM(1,1)
  666. IF (NCPR(INOE).EQ.0) THEN
  667. NPLB = NPLB + 1
  668. NCPR(INOE) = NPLB
  669. ENDIF
  670. DO 30 IE = 1,(NNOEES-1)
  671. INOE = NUM(2,IE)
  672. IF (NCPR(INOE).EQ.0) THEN
  673. NPLB = NPLB + 1
  674. NCPR(INOE) = NPLB
  675. ENDIF
  676. 30 CONTINUE
  677. SEGDES MELEME
  678. ENDIF
  679. ENDIF
  680. KPLBB = NNOEMA + NNOEES
  681. IF (IDIM.EQ.3) THEN
  682. KDIMB = 6
  683. ELSE
  684. KDIMB = 3
  685. ENDIF
  686. * Pour le nombre maxi de paramètres entiers on prend
  687. * en compte les 16 espaces dus aux liaisons conditionnelles
  688. * + nos 10 autres propres paramètres
  689. * + la place pour les noeuds voisins
  690. * + la place pour les indicateurs de choc
  691. KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  692. *
  693. IF (TYPRET.EQ.'CHPOINT') THEN
  694. KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  695. &NNOEES)
  696. ELSE IF (TYPRET.EQ.' ') THEN
  697. KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  698. &NNOEES)
  699. ELSE
  700. CALL ERREUR(522)
  701. RETURN
  702. ENDIF
  703. *
  704. NXPALB = MAX(NXPALB,KXPALB)
  705. NIPALB = MAX(NIPALB,KIPALB)
  706. NPLBB = MAX(NPLBB,KPLBB)
  707. IDIMB = MAX(IDIMB,KDIMB)
  708.  
  709.  
  710.  
  711. *
  712. * ----- choc élémentaire LIGNE_CERCLE_FROTTEMENT
  713.  
  714.  
  715. ELSE IF
  716. & (CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN
  717. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0,
  718. & 'MAILLAGE',I1,X1,' ',L1,IMAI)
  719. IF (IERR.NE.0) RETURN
  720. MONESC= ' '
  721. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0,
  722. & MONESC,I1,X1,CHARRE,L1,IESC)
  723. TYPRET = ' '
  724. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS',
  725. & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1)
  726. IF (IERR.NE.0) RETURN
  727. *
  728. MELEME = IMAI
  729. SEGACT MELEME
  730. NELEMA = NUM(/2)
  731. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  732. NNOEMA = NELEMA
  733. ELSE
  734. NNOEMA = NELEMA+1
  735. ENDIF
  736. INOE = NUM(1,1)
  737. IF (NCPR(INOE).EQ.0) THEN
  738. NPLB = NPLB + 1
  739. NCPR(INOE) = NPLB
  740. ENDIF
  741. DO 40 IE = 1,(NNOEMA-1)
  742. INOE = NUM(2,IE)
  743. IF (NCPR(INOE).EQ.0) THEN
  744. NPLB = NPLB + 1
  745. NCPR(INOE) = NPLB
  746. ENDIF
  747. 40 CONTINUE
  748. SEGDES MELEME
  749. * Maillage_esclave
  750. IF (MONESC.EQ.'POINT') THEN
  751. * La ligne-esclave est un point
  752. IF (NCPR(IESC).EQ.0) THEN
  753. NPLB = NPLB + 1
  754. NCPR(IESC) = NPLB
  755. ENDIF
  756. NNOEES=1
  757. ELSE
  758. IF (MONESC.EQ.'MAILLAGE') THEN
  759. * La ligne-esclave est un MAILLAGE
  760. MELEME = IESC
  761. SEGACT MELEME
  762. NELEES = NUM(/2)
  763. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  764. NNOEES = NELEES
  765. ELSE
  766. NNOEES = NELEES+1
  767. ENDIF
  768. INOE = NUM(1,1)
  769. IF (NCPR(INOE).EQ.0) THEN
  770. NPLB = NPLB + 1
  771. NCPR(INOE) = NPLB
  772. ENDIF
  773. DO 50 IE = 1,(NNOEES-1)
  774. INOE = NUM(2,IE)
  775. IF (NCPR(INOE).EQ.0) THEN
  776. NPLB = NPLB + 1
  777. NCPR(INOE) = NPLB
  778. ENDIF
  779. 50 CONTINUE
  780. SEGDES MELEME
  781. ENDIF
  782. ENDIF
  783. KPLBB = NNOEMA + NNOEES
  784. IF (IDIM.EQ.3) THEN
  785. KDIMB = 6
  786. ELSE
  787. KDIMB = 3
  788. ENDIF
  789. * Pour le nombre maxi de paramètres entiers on prend
  790. * en compte les 16 espaces dus aux liaisons conditionnelles
  791. * + nos 10 autres propres paramètres
  792. * + la place pour les noeuds voisins
  793. * + la place pour les indicateurs de choc
  794. KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  795. *
  796. IF (TYPRET.EQ.'CHPOINT') THEN
  797. KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  798. &NNOEES)
  799. ELSE IF (TYPRET.EQ.' ') THEN
  800. KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  801. &NNOEES)
  802. ELSE
  803. CALL ERREUR(522)
  804. RETURN
  805. ENDIF
  806. *
  807. NXPALB = MAX(NXPALB,KXPALB)
  808. NIPALB = MAX(NIPALB,KIPALB)
  809. NPLBB = MAX(NPLBB,KPLBB)
  810. IDIMB = MAX(IDIMB,KDIMB)
  811.  
  812. *
  813. * ------ liaison PALIER_FLUIDE
  814. *
  815. ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN
  816. *
  817. cbp KPLBB = 1
  818. KPLBB = 2
  819. cbp KDIMB = IDIM : on est necessairement en 3D ou 2D Fourier
  820. KDIMB = 3
  821. *
  822. C I) Gestion du(des) point(s) support(s)
  823. *
  824. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0,
  825. & 'POINT',I1,X0,' ',L1,INOE)
  826. IF (IERR.NE.0) RETURN
  827. IF (NCPR(INOE).EQ.0) THEN
  828. NPLB = NPLB + 1
  829. NCPR(INOE) = NPLB
  830. ENDIF
  831. *
  832. TYPRET=' '
  833. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_ORIGINE',L0,IP0,
  834. & TYPRET,I1,X0,' ',L1,INOE)
  835. IF (IERR.NE.0) RETURN
  836. IF(TYPRET.EQ.'POINT') THEN
  837. cbp KPLBB = 2
  838. IF (NCPR(INOE).EQ.0) THEN
  839. NPLB = NPLB + 1
  840. NCPR(INOE) = NPLB
  841. ENDIF
  842. ENDIF
  843. *
  844. C II) Décompte du nombre de paramètres entiers et réels
  845. *
  846. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0,
  847. & 'MOT',I1,X0,CMOT,L1,IP1)
  848. IF (IERR.NE.0) RETURN
  849. *
  850. C II.1) Décompte du nombre de paramètres propres aux différents types
  851. C de paliers (KIPLB2 pour les entiers, LXPLB2 pour les réels) :
  852. *
  853. IF (CMOT.EQ.'RODELI') THEN
  854. *
  855. C -- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li :
  856. *
  857. CALL ACCTAB(ITLIAI,'MOT',I0,X0,'GEOMETRIE_PALIER',
  858. & L0,IP0,'TABLE',I0,X0,' ',L1,ITGEOM)
  859. IF (IERR.NE.0) RETURN
  860. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  861. & 'ENTIER',NLOB,X0,' ',L1,IP1)
  862. IF (IERR.NE.0) RETURN
  863. KIPLB2 = 2 + NLOB
  864. KXPLB2 = 1 + (6*NLOB)
  865. *
  866. C -- Cas du palier cylindrique court (ajout BP, 2015) :
  867. ELSEIF (CMOT.EQ.'PALIER_COURT') THEN
  868. KIPLB2 = 1
  869. KXPLB2 = 1
  870. *
  871. C -- Cas du palier cylindrique long (ajout BP, 2015) :
  872. ELSEIF (CMOT.EQ.'PALIER_LONG') THEN
  873. KIPLB2 = 1
  874. KXPLB2 = 1
  875. *
  876. C -- Cas des autres types de paliers (à définir si nécessaire)
  877. *
  878. C ELSE IF (CMOT.EQ.'...') THEN
  879. C KIPLB2 = ...
  880. C KXPLB2 = ...
  881. ELSE
  882. WRITE(IOIMP,*) 'MODELE_PALIER non reconnu !'
  883. CALL ERREUR(490)
  884. RETURN
  885. ENDIF
  886. *
  887. C II.2) Nombres totaux de paramètres entiers et réels :
  888. *
  889. KIPALB = 6 + KIPLB2
  890. cbp KXPALB = 7 + KXPLB2 + 4
  891. cbp , 2015 pourquoi pas :
  892. KXPALB = 9 + KXPLB2
  893. *
  894. C Dimensionnement des variables de sortie :
  895. *
  896. NXPALB = MAX(NXPALB,KXPALB)
  897. NIPALB = MAX(NIPALB,KIPALB)
  898. NPLBB = MAX(NPLBB,KPLBB)
  899. IDIMB = MAX(IDIMB,KDIMB)
  900. *
  901. * --> fin liaison PALIER
  902. *
  903.  
  904. * ----- ERREUR : Le TYPE d'une liaison est incorrect
  905. ELSE
  906. CALL ERREUR(490)
  907. RETURN
  908. ENDIF
  909.  
  910. GOTO 10
  911. * On Boucle sur les liaisons
  912.  
  913. ENDIF
  914. *-----Fin de Cas ou la IL ieme liaison existe -------------------------
  915. *
  916. END
  917.  
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  

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