Télécharger dyne22.eso

Retour à la liste

Numérotation des lignes :

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

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