Télécharger dyne72.eso

Retour à la liste

Numérotation des lignes :

dyne72
  1. C DYNE72 SOURCE CB215821 20/11/04 21:16:20 10766
  2. SUBROUTINE DYNE72(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR,
  3. & NIPALB,NIP,ITCARA)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : *
  9. * Determination des parametres de liaison pour la base B. *
  10. * *
  11. *--------------------------------------------------------------------*
  12. * *
  13. * Parametres: *
  14. * *
  15. * e ITLB Modele decrivant les liaisons B *
  16. * e ITCARA Caracteristiques *
  17. * s NLIAB Nombre total de liaisons sur base B. *
  18. * s NXPALB Maxi du nombre de parametres definissant une liaison. *
  19. * s NPLBB Maxi du nombre de points intervenant dans une liaison. *
  20. * s NPLB Nombre total de points. *
  21. * s IDIMB Dimension de travail des liaisons. *
  22. * s KCPR Segment de points. *
  23. * s NIPALB Maxi du nombre de parametres definissant une liaison. *
  24. * s NIP Nb de pts dans l'evolution de la loi de comportement *
  25. * *
  26. * Auteur, date de creation: JK, a partir de DYNE22 *
  27. * *
  28. *--------------------------------------------------------------------*
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCOORD
  33. -INC SMELEME
  34. -INC SMEVOLL
  35. -INC SMLREEL
  36. -INC SMMODEL
  37. -INC SMCHAML
  38. *
  39. SEGMENT,NCPR(nbpts)
  40. *
  41. LOGICAL L0,L1
  42. CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE
  43. CHARACTER*8 CMOT
  44. CHARACTER*4 MO4
  45. *
  46. SEGINI,NCPR
  47. KCPR = NCPR
  48.  
  49. MMODEL = ITLB
  50. segact mmodel
  51. MCHELM = ITCARA
  52. segact mchelm
  53. n1cara = imache(/1)
  54. *
  55. NXPALB = 0
  56. c c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;')
  57. NIPALB = 20
  58. NPLBB = 0
  59. NPLB = 0
  60. IDIMB = 0
  61. NLIAB = 0
  62. C NIP = 1 dans le cas ou la liaison n'est pas ITYP =16/17 ou ITYP=50/51
  63. NIP = 1
  64. *
  65. *--------------------------------------------------------------------*
  66. * Boucle sur le nombre de liaisons
  67. *--------------------------------------------------------------------*
  68. IL = 0
  69. 10 CONTINUE
  70. IL = IL+ 1
  71. if (IL.GT.kmodel(/1)) then
  72. segdes mmodel,mchelm
  73. RETURN
  74. endif
  75. imodel = kmodel(il)
  76. segact imodel
  77. cmot(1:8) = cmatee
  78. meleme = imamod
  79. segact meleme
  80.  
  81. NLIAB = NLIAB + 1
  82. ica = 0
  83. 1010 ica = ica + 1
  84. if (ica.gt.n1cara) then
  85. write(6,*) ' pas de caracteristiques pour ', il , cmatee
  86. goto 10
  87. endif
  88. if (conche(ica).ne.conmod) goto 1010
  89. if (imache(ica).ne.imamod) goto 1010
  90.  
  91. mchaml = ichaml(ica)
  92. segact mchaml
  93. n2cham = ielval(/1)
  94.  
  95. 11 continue
  96. *
  97. * ------ choc elementaire POINT_PLAN_FLUIDE
  98. *
  99. IF (CMOT.EQ.'PO_PL_FL') THEN
  100. INOE = num(1,1)
  101. IF (IERR.NE.0) RETURN
  102. IF (NCPR(INOE).EQ.0) THEN
  103. NPLB = NPLB + 1
  104. NCPR(INOE) = NPLB
  105. ENDIF
  106. KPLBB = 1
  107. KDIMB = IDIM
  108. KIPALB = 3
  109. KXPALB = 9 + IDIM
  110. NXPALB = MAX(NXPALB,KXPALB)
  111. NIPALB = MAX(NIPALB,KIPALB)
  112. NPLBB = MAX(NPLBB,KPLBB)
  113. IDIMB = MAX(IDIMB,KDIMB)
  114. *
  115. * ------ choc elementaire POINT_PLAN_FROTTEMENT
  116. *
  117. ELSE IF (CMOT.EQ.'PO_PL_FR') THEN
  118. do in2 = 1,n2cham
  119. MO4=nomche(in2)(1:4)
  120. if (MO4.eq.'LOIC') goto 1021
  121. enddo
  122. KNIP = 0
  123. goto 1022
  124. 1021 melval = ielval(in2)
  125. segact melval
  126. ipevo = ielche(1,1)
  127. segdes melval
  128. *
  129. MEVOLL = ipevo
  130. SEGACT MEVOLL
  131. KEVOLL = IEVOLL(1)
  132. SEGACT KEVOLL
  133. MLREE1 = IPROGX
  134. SEGACT MLREE1
  135. KNIP = MLREE1.PROG(/1)
  136. SEGDES MLREE1
  137. C* MLREE2 = IPROGY
  138. C* SEGACT MLREE2
  139. C* SEGDES MLREE2
  140. SEGDES KEVOLL
  141. SEGDES MEVOLL
  142. *
  143. 1022 continue
  144. INOE = num(1,1)
  145. IF (NCPR(INOE).EQ.0) THEN
  146. NPLB = NPLB + 1
  147. NCPR(INOE) = NPLB
  148. ENDIF
  149. TYPRET = ' '
  150. KPLBB = 1
  151. KDIMB = IDIM
  152. KIPALB = 3
  153. cbp,2020 KXPALB = 7 + 7 * IDIM
  154. KXPALB = 9 + 8 * IDIM
  155. NXPALB = MAX(NXPALB,KXPALB)
  156. NIPALB = MAX(NIPALB,KIPALB)
  157. NPLBB = MAX(NPLBB,KPLBB)
  158. IDIMB = MAX(IDIMB,KDIMB)
  159. NIP = MAX(NIP,KNIP)
  160. *
  161. * ------ choc elementaire POINT_PLAN
  162. *
  163. ELSE IF (CMOT.EQ.'PO_PL') THEN
  164. do in2 = 1,n2cham
  165. MO4=nomche(in2)(1:4)
  166. if (MO4.eq.'LOIC') goto 1031
  167. enddo
  168. KNIP = 0
  169. goto 1032
  170. 1031 melval = ielval(in2)
  171. segact melval
  172. IPEVO = ielche(1,1)
  173. segdes,melval
  174.  
  175. MEVOLL = IPEVO
  176. SEGACT MEVOLL
  177. KEVOLL = IEVOLL(1)
  178. SEGACT KEVOLL
  179. MLREE1 = IPROGX
  180. SEGACT MLREE1
  181. KNIP = MLREE1.PROG(/1)
  182. SEGDES MLREE1
  183. C* MLREE2 = IPROGY
  184. C* SEGACT MLREE2
  185. C* SEGDES MLREE2
  186. SEGDES KEVOLL
  187. SEGDES MEVOLL
  188. *
  189. 1032 continue
  190. INOE = num(1,1)
  191. IF (NCPR(INOE).EQ.0) THEN
  192. NPLB = NPLB + 1
  193. NCPR(INOE) = NPLB
  194. ENDIF
  195. TYPRET = ' '
  196. KPLBB = 1
  197. KDIMB = IDIM
  198. KIPALB = 4
  199. KXPALB = 3 + IDIM
  200. ** ianis
  201. do in2 = 1,n2cham
  202. MO4=nomche(in2)(1:4)
  203. if (MO4.eq.'SPLA') KXPALB = 3 + IDIM + 2
  204. enddo
  205. *
  206. NXPALB = MAX(NXPALB,KXPALB)
  207. NIPALB = MAX(NIPALB,KIPALB)
  208. NPLBB = MAX(NPLBB,KPLBB)
  209. IDIMB = MAX(IDIMB,KDIMB)
  210. NIP = MAX(NIP,KNIP)
  211. *
  212. * ----- choc elementaire POINT_POINT_FROTTEMENT
  213. *
  214. ELSE IF (CMOT.EQ.'PO_PO_FR') THEN
  215. INOA = num(1,1)
  216. IF (NCPR(INOA).EQ.0) THEN
  217. NPLB = NPLB + 1
  218. NCPR(INOA) = NPLB
  219. ENDIF
  220. INOB = num(1,2)
  221. IF (NCPR(INOB).EQ.0) THEN
  222. NPLB = NPLB + 1
  223. NCPR(INOB) = NPLB
  224. ENDIF
  225. do in2 = 1,n2cham
  226. MO4=nomche(in2)(1:4)
  227. if (MO4.eq.'LOIC') goto 1041
  228. enddo
  229. KNIP = 0
  230. goto 1042
  231. 1041 melval = ielval(in2)
  232. segact melval
  233. ipevo = ielche(1,1)
  234. segdes melval
  235. *
  236. MEVOLL = IPEVO
  237. SEGACT MEVOLL
  238. KEVOLL = IEVOLL(1)
  239. SEGACT KEVOLL
  240. MLREE1 = IPROGX
  241. SEGACT MLREE1
  242. KNIP = MLREE1.PROG(/1)
  243. SEGDES MLREE1
  244. C* MLREE2 = IPROGY
  245. C* SEGACT MLREE2
  246. C* SEGDES MLREE2
  247. SEGDES KEVOLL
  248. SEGDES MEVOLL
  249.  
  250. 1042 continue
  251. KPLBB = 2
  252. KDIMB = IDIM
  253. KIPALB = 3
  254. KXPALB = 7 + 7 * IDIM
  255. NXPALB = MAX(NXPALB,KXPALB)
  256. NIPALB = MAX(NIPALB,KIPALB)
  257. NPLBB = MAX(NPLBB,KPLBB)
  258. IDIMB = MAX(IDIMB,KDIMB)
  259. NIP = MAX(NIP,KNIP)
  260. *
  261. * ----- choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE
  262. *
  263. ELSE IF (CMOT.EQ.'PO_PO_DP') THEN
  264. do in2 = 1,n2cham
  265. MO4=nomche(in2)(1:4)
  266. if (MO4.eq.'LOIC') goto 1051
  267. enddo
  268. call erreur(5)
  269. return
  270. 1051 melval = ielval(in2)
  271. segact melval
  272. ipevo = ielche(1,1)
  273. segdes melval
  274. *
  275. MEVOLL = IPEVO
  276. SEGACT MEVOLL
  277. KEVOLL = IEVOLL(1)
  278. SEGACT KEVOLL
  279. MLREE1 = IPROGX
  280. SEGACT MLREE1
  281. KNIP = MLREE1.PROG(/1)
  282. SEGDES MLREE1
  283. c* MLREE2 = IPROGY
  284. c* SEGACT MLREE2
  285. c* SEGDES MLREE2
  286. SEGDES KEVOLL
  287. SEGDES MEVOLL
  288. *
  289. INOA = num(1,1)
  290. IF (NCPR(INOA).EQ.0) THEN
  291. NPLB = NPLB + 1
  292. NCPR(INOA) = NPLB
  293. ENDIF
  294. INOB = num(1,2)
  295. IF (NCPR(INOB).EQ.0) THEN
  296. NPLB = NPLB + 1
  297. NCPR(INOB) = NPLB
  298. ENDIF
  299. TYPRET = ' '
  300. do in2 = 1,n2cham
  301. MO4=nomche(in2)(1:4)
  302. if (MO4.eq.'AMOR') then
  303. typret='FLOTTANT'
  304. goto 1052
  305. endif
  306. enddo
  307. 1052 continue
  308. *
  309. KPLBB = 2
  310. KDIMB = IDIM
  311. C
  312. KIPALB = 5
  313. IF (TYPRET.EQ.'FLOTTANT') THEN
  314. KXPALB = 5 + IDIM
  315. ELSE IF (TYPRET.EQ.' ') THEN
  316. KXPALB = 4 + IDIM
  317. ELSE
  318. CALL ERREUR(522)
  319. RETURN
  320. ENDIF
  321. NXPALB = MAX(NXPALB,KXPALB)
  322. NIPALB = MAX(NIPALB,KIPALB)
  323. NPLBB = MAX(NPLBB,KPLBB)
  324. IDIMB = MAX(IDIMB,KDIMB)
  325. NIP = MAX(NIP,KNIP)
  326. *
  327. * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE
  328. *
  329. ELSE IF (CMOT.EQ.'PO_PO_RP') THEN
  330. do in2 = 1,n2cham
  331. MO4=nomche(in2)(1:4)
  332. if (MO4.eq.'LOIC') goto 1061
  333. enddo
  334. call erreur(5)
  335. return
  336. 1061 melval = ielval(in2)
  337. segact melval
  338. ipevo = ielche(1,1)
  339. segdes melval
  340. *
  341. MEVOLL = IPEVO
  342. SEGACT MEVOLL
  343. KEVOLL = IEVOLL(1)
  344. SEGACT KEVOLL
  345. MLREE1 = IPROGX
  346. SEGACT MLREE1
  347. KNIP = MLREE1.PROG(/1)
  348. SEGDES MLREE1
  349. c* MLREE2 = IPROGY
  350. c* SEGACT MLREE2
  351. c* SEGDES MLREE2
  352. SEGDES KEVOLL
  353. SEGDES MEVOLL
  354. *
  355. INOA = num(1,1)
  356. IF (NCPR(INOA).EQ.0) THEN
  357. NPLB = NPLB + 1
  358. NCPR(INOA) = NPLB
  359. ENDIF
  360. INOB = num(1,2)
  361. IF (NCPR(INOB).EQ.0) THEN
  362. NPLB = NPLB + 1
  363. NCPR(INOB) = NPLB
  364. ENDIF
  365. TYPRET = ' '
  366. do in2 = 1,n2cham
  367. MO4=nomche(in2)(1:4)
  368. if (MO4.eq.'AMOR') then
  369. typret='FLOTTANT'
  370. goto 1062
  371. endif
  372. enddo
  373. 1062 continue
  374. KPLBB = 2
  375. *
  376. * NW Dans le cas de la rotule, on passe en dimension 6
  377. * car on aura Ux,Uy,Uz,Rx,Ry,Rz
  378. *
  379. KDIMB = 3+IDIM
  380. *
  381. * KIPALB = 5 : nombre maxi de parametres pour la liaison
  382. *
  383. KIPALB = 5
  384. IF (TYPRET.EQ.'FLOTTANT') THEN
  385. KXPALB = 5 + IDIM
  386. ELSE IF (TYPRET.EQ.' ') THEN
  387. KXPALB = 4 + IDIM
  388. ELSE
  389. CALL ERREUR(522)
  390. RETURN
  391. ENDIF
  392. NXPALB = MAX(NXPALB,KXPALB)
  393. NIPALB = MAX(NIPALB,KIPALB)
  394. NPLBB = MAX(NPLBB,KPLBB)
  395. IDIMB = MAX(IDIMB,KDIMB)
  396. NIP = MAX(NIP,KNIP)
  397. *
  398. * ----- choc elementaire POINT_POINT
  399. *
  400. ELSE IF (CMOT.EQ.'PO_PO') THEN
  401. INOA = num(1,1)
  402. IF (NCPR(INOA).EQ.0) THEN
  403. NPLB = NPLB + 1
  404. NCPR(INOA) = NPLB
  405. ENDIF
  406. INOB = num(1,2)
  407. IF (NCPR(INOB).EQ.0) THEN
  408. NPLB = NPLB + 1
  409. NCPR(INOB) = NPLB
  410. ENDIF
  411.  
  412. TYPRET = ' '
  413. do in2 = 1,n2cham
  414. MO4=nomche(in2)(1:4)
  415. if (MO4.eq.'LOIC') goto 1071
  416. enddo
  417. KNIP = 0
  418. goto 1072
  419.  
  420. 1071 continue
  421. melval = ielval(in2)
  422. segact melval
  423. ipevo = ielche(1,1)
  424. segdes melval
  425. *
  426. MEVOLL = IPEVO
  427. SEGACT MEVOLL
  428. KEVOLL = IEVOLL(1)
  429. SEGACT KEVOLL
  430. MLREE1 = IPROGX
  431. SEGACT MLREE1
  432. KNIP = MLREE1.PROG(/1)
  433. SEGDES MLREE1
  434. c* MLREE2 = IPROGY
  435. c* SEGACT MLREE2
  436. c* SEGDES MLREE2
  437. SEGDES KEVOLL
  438. SEGDES MEVOLL
  439.  
  440. 1072 continue
  441. KPLBB = 2
  442. KDIMB = IDIM
  443. KIPALB = 4
  444. KXPALB = 3 + IDIM
  445. NXPALB = MAX(NXPALB,KXPALB)
  446. NIPALB = MAX(NIPALB,KIPALB)
  447. NPLBB = MAX(NPLBB,KPLBB)
  448. IDIMB = MAX(IDIMB,KDIMB)
  449. NIP = MAX(NIP,KNIP)
  450. *
  451. * ianis
  452. *
  453. * ----- choc elementaire POINT_CERCLE_MOBILE
  454. *
  455. ELSE IF (CMOT.EQ.'PO_CE_MO') THEN
  456. INOA = num(1,1)
  457. IF (NCPR(INOA).EQ.0) THEN
  458. NPLB = NPLB + 1
  459. NCPR(INOA) = NPLB
  460. ENDIF
  461. *
  462. do in2 = 1,n2cham
  463. MO4=nomche(in2)(1:4)
  464. if (MO4.eq.'PCER') goto 1081
  465. enddo
  466. interr(1) = inoa
  467. moterr(1:4) = 'PCER'
  468. moterr(5:8) = 'CARA'
  469. call erreur(65)
  470. return
  471. 1081 continue
  472. melval = ielval(in2)
  473. segact melval
  474. inob = ielche(1,1)
  475. segdes,melval
  476. IF (NCPR(INOB).EQ.0) THEN
  477. NPLB = NPLB + 1
  478. NCPR(INOB) = NPLB
  479. ENDIF
  480. TYPRET = ' '
  481. do in2 = 1,n2cham
  482. MO4=nomche(in2)(1:4)
  483. if (MO4.eq.'AMOR') then
  484. typret='FLOTTANT'
  485. goto 1082
  486. endif
  487. enddo
  488. 1082 continue
  489. KPLBB = 2
  490. * on neglige les rotations
  491. KDIMB = IDIM
  492. KIPALB = 4
  493. IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ') THEN
  494. KXPALB = 7 + 9 * IDIM
  495. ELSE IF (TYPRET.EQ.' ') THEN
  496. KXPALB = 6 + 9 * IDIM
  497. ELSE
  498. CALL ERREUR(522)
  499. RETURN
  500. ENDIF
  501. NXPALB = MAX(NXPALB,KXPALB)
  502. NIPALB = MAX(NIPALB,KIPALB)
  503. NPLBB = MAX(NPLBB,KPLBB)
  504. IDIMB = MAX(IDIMB,KDIMB)
  505. *
  506. * ----- choc elementaire POINT_CERCLE_FROTTEMENT
  507. *
  508. ELSE IF (CMOT.EQ.'PO_CE_FR') THEN
  509. INOE=num(1,1)
  510. IF (NCPR(INOE).EQ.0) THEN
  511. NPLB = NPLB + 1
  512. NCPR(INOE) = NPLB
  513. ENDIF
  514. c TYPRET = ' '
  515. c do in2 = 1,n2cham
  516. c MO4=nomche(in2)(1:4)
  517. c if (MO4.eq.'AMOR') then
  518. c typret='FLOTTANT'
  519. c goto 1092
  520. c endif
  521. c enddo
  522. c 1092 continue
  523. cbp,2020 : tjrs amortissement
  524. KPLBB = 1
  525. KDIMB = IDIM
  526. KIPALB = 4
  527. c IF (TYPRET.EQ.'FLOTTANT') THEN
  528. c KXPALB = 7 + 9 * IDIM
  529. c ELSE IF (TYPRET.EQ.' ') THEN
  530. c KXPALB = 6 + 9 * IDIM
  531. c ELSE
  532. c CALL ERREUR(522)
  533. c RETURN
  534. c ENDIF
  535. cbp,2020 : tjrs amortissement + ajout Ve et regul(n et t)
  536. KXPALB = 10 + 9 * IDIM
  537. NXPALB = MAX(NXPALB,KXPALB)
  538. NIPALB = MAX(NIPALB,KIPALB)
  539. NPLBB = MAX(NPLBB,KPLBB)
  540. IDIMB = MAX(IDIMB,KDIMB)
  541. *
  542. * ----- choc elementaire POINT_CERCLE
  543. *
  544. ELSE IF (CMOT.EQ.'PO_CE') THEN
  545. INOE = num(1,1)
  546. IF (NCPR(INOE).EQ.0) THEN
  547. NPLB = NPLB + 1
  548. NCPR(INOE) = NPLB
  549. ENDIF
  550. TYPRET = ' '
  551. do in2 = 1,n2cham
  552. MO4=nomche(in2)(1:4)
  553. if (MO4.eq.'AMOR') then
  554. typret='FLOTTANT'
  555. goto 1102
  556. endif
  557. enddo
  558. 1102 continue
  559. KPLBB = 1
  560. KDIMB = IDIM
  561. KIPALB = 3
  562. IF (TYPRET.EQ.'FLOTTANT') THEN
  563. KXPALB = 3 + 2 * IDIM
  564. ELSE IF (TYPRET.EQ.' ') THEN
  565. KXPALB = 2 + 2 * IDIM
  566. ELSE
  567. CALL ERREUR(522)
  568. RETURN
  569. ENDIF
  570. NXPALB = MAX(NXPALB,KXPALB)
  571. NIPALB = MAX(NIPALB,KIPALB)
  572. NPLBB = MAX(NPLBB,KPLBB)
  573. IDIMB = MAX(IDIMB,KDIMB)
  574. *
  575. * ----- choc elementaire CERCLE_PLAN_FROTTEMENT
  576. *
  577. ELSE IF (CMOT.EQ.'CE_PL_FR') THEN
  578. INOE = num(1,1)
  579. IF (NCPR(INOE).EQ.0) THEN
  580. NPLB = NPLB + 1
  581. NCPR(INOE) = NPLB
  582. ENDIF
  583. TYPRET = ' '
  584. do in2 = 1,n2cham
  585. MO4=nomche(in2)(1:4)
  586. if (MO4.eq.'AMOR') then
  587. typret='FLOTTANT'
  588. goto 1112
  589. endif
  590. enddo
  591. 1112 continue
  592. KPLBB = 1
  593. KDIMB = 2 * IDIM
  594. KIPALB = 3
  595. IF (TYPRET.EQ.'FLOTTANT') THEN
  596. KXPALB = 8 + 7 * IDIM
  597. ELSE IF (TYPRET.EQ.' ') THEN
  598. KXPALB = 7 + 7 * IDIM
  599. ELSE
  600. CALL ERREUR(522)
  601. RETURN
  602. ENDIF
  603. NXPALB = MAX(NXPALB,KXPALB)
  604. NIPALB = MAX(NIPALB,KIPALB)
  605. NPLBB = MAX(NPLBB,KPLBB)
  606. IDIMB = MAX(IDIMB,KDIMB)
  607. *
  608. * ----- choc elementaire CERCLE_CERCLE_FROTTEMENT
  609. *
  610. ELSE IF (CMOT.EQ.'CE_CE_FR') THEN
  611. INOE = num(1,1)
  612. IF (NCPR(INOE).EQ.0) THEN
  613. NPLB = NPLB + 1
  614. NCPR(INOE) = NPLB
  615. ENDIF
  616. TYPRET = ' '
  617. do in2 = 1,n2cham
  618. MO4=nomche(in2)(1:4)
  619. if (MO4.eq.'AMOR') then
  620. typret='FLOTTANT'
  621. goto 1122
  622. endif
  623. enddo
  624. 1122 continue
  625. KPLBB = 1
  626. KDIMB = 2 * IDIM
  627. KIPALB = 4
  628. IF (TYPRET.EQ.'FLOTTANT') THEN
  629. KXPALB = 8 + 9*IDIM
  630. ELSE IF (TYPRET.EQ.' ') THEN
  631. KXPALB = 7 + 9*IDIM
  632. ELSE
  633. CALL ERREUR(522)
  634. RETURN
  635. ENDIF
  636. NXPALB = MAX(NXPALB,KXPALB)
  637. NIPALB = MAX(NIPALB,KIPALB)
  638. NPLBB = MAX(NPLBB,KPLBB)
  639. IDIMB = MAX(IDIMB,KDIMB)
  640. *
  641. * ----- choc elementaire PROFIL_PROFIL_INTERIEUR
  642. * ----- choc elementaire PROFIL_PROFIL_EXTERIEUR
  643. *
  644. ELSE IF (CMOT.EQ.'PR_PR_IN'.OR.
  645. & CMOT.EQ.'PR_PR_EX') THEN
  646. do in2 = 1,n2cham
  647. MO4=nomche(in2)(1:4)
  648. if (MO4.eq.'PFIX') then
  649. melval = ielval(in2)
  650. segact melval
  651. ima1 = ielche(1,1)
  652. segdes melval
  653. elseif (MO4.eq.'PMOB') then
  654. melval = ielval(in2)
  655. segact melval
  656. ima2 = ielche(1,1)
  657. segdes melval
  658. endif
  659. enddo
  660.  
  661. INOE = num(1,1)
  662. IF (NCPR(INOE).EQ.0) THEN
  663. NPLB = NPLB + 1
  664. NCPR(INOE) = NPLB
  665. ENDIF
  666. KPLBB = 1
  667. KDIMB = 3
  668. CALL CHANGE(IMA1,1)
  669. CALL CHANGE(IMA2,1)
  670. MELEME = IMA1
  671. SEGACT MELEME
  672. NOMBN1 = NUM(/2)
  673. SEGDES MELEME
  674. MELEME = IMA2
  675. SEGACT MELEME
  676. NOMBN2 = NUM(/2)
  677. SEGDES MELEME
  678. KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2
  679. KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2
  680. NXPALB = MAX(NXPALB,KXPALB)
  681. NIPALB = MAX(NIPALB,KIPALB)
  682. NPLBB = MAX(NPLBB,KPLBB)
  683. IDIMB = MAX(IDIMB,KDIMB)
  684. *
  685. * ----- choc elementaire LIGNE_LIGNE_FROTTEMENT
  686. *
  687. ELSE IF (CMOT.EQ.'LI_LI_FR') THEN
  688. MONESC= ' '
  689. TYPRET = ' '
  690. do in2 = 1,n2cham
  691. MO4=nomche(in2)(1:4)
  692. if (MO4.eq.'LIMA') then
  693. melval = ielval(in2)
  694. segact melval
  695. imai = ielche(1,1)
  696. segdes melval
  697. elseif (MO4.eq.'LIES') then
  698. melval = ielval(in2)
  699. MONESC = typche(in2)(9:16)
  700. segact melval
  701. iesc = ielche(1,1)
  702. segdes melval
  703. elseif (nomche(in2)(1:4).eq.'AMOR') then
  704. melval = ielval(in2)
  705. typret=typche(in2)(1:8)
  706. if (typret.eq.'POINTEUR') typret=typche(in2)(9:16)
  707. endif
  708. enddo
  709. *
  710. MELEME = IMAI
  711. SEGACT MELEME
  712. NELEMA = NUM(/2)
  713. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  714. NNOEMA = NELEMA
  715. ELSE
  716. NNOEMA = NELEMA+1
  717. ENDIF
  718. INOE = NUM(1,1)
  719. IF (NCPR(INOE).EQ.0) THEN
  720. NPLB = NPLB + 1
  721. NCPR(INOE) = NPLB
  722. ENDIF
  723. DO 20 IE = 1,(NNOEMA-1)
  724. INOE = NUM(2,IE)
  725. IF (NCPR(INOE).EQ.0) THEN
  726. NPLB = NPLB + 1
  727. NCPR(INOE) = NPLB
  728. ENDIF
  729. 20 CONTINUE
  730. SEGDES MELEME
  731. * Maillage_esclave
  732. IF (MONESC.EQ.'POINT') THEN
  733. * La ligne-esclave est un point
  734. IF (NCPR(IESC).EQ.0) THEN
  735. NPLB = NPLB + 1
  736. NCPR(IESC) = NPLB
  737. ENDIF
  738. NNOEES=1
  739. ELSE
  740. IF (MONESC.EQ.'MAILLAGE') THEN
  741. * La ligne-esclave est un MAILLAGE
  742. MELEME = IESC
  743. SEGACT MELEME
  744. NELEES = NUM(/2)
  745. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  746. NNOEES = NELEES
  747. ELSE
  748. NNOEES = NELEES+1
  749. ENDIF
  750. INOE = NUM(1,1)
  751. IF (NCPR(INOE).EQ.0) THEN
  752. NPLB = NPLB + 1
  753. NCPR(INOE) = NPLB
  754. ENDIF
  755. DO 30 IE = 1,(NNOEES-1)
  756. INOE = NUM(2,IE)
  757. IF (NCPR(INOE).EQ.0) THEN
  758. NPLB = NPLB + 1
  759. NCPR(INOE) = NPLB
  760. ENDIF
  761. 30 CONTINUE
  762. SEGDES MELEME
  763. ENDIF
  764. ENDIF
  765. KPLBB = NNOEMA + NNOEES
  766. IF (IDIM.EQ.3) THEN
  767. KDIMB = 6
  768. ELSE
  769. KDIMB = 3
  770. ENDIF
  771. * Pour le nombre maxi de parametres entiers on prend
  772. * en compte les 16 espaces dus aux liaisons conditionnelles
  773. * + nos 10 autres propres parametres
  774. * + la place pour les noeuds voisins
  775. * + la place pour les indicateurs de choc
  776. KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  777. *
  778. IF (TYPRET.EQ.'CHPOINT') THEN
  779. KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  780. &NNOEES)
  781. ELSE IF (TYPRET.EQ.'REAL*8') THEN
  782. KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  783. &NNOEES)
  784. ELSE IF (TYPRET.EQ.' ') THEN
  785. KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  786. &NNOEES)
  787. ELSE
  788. CALL ERREUR(522)
  789. RETURN
  790. ENDIF
  791. *
  792. NXPALB = MAX(NXPALB,KXPALB)
  793. NIPALB = MAX(NIPALB,KIPALB)
  794. NPLBB = MAX(NPLBB,KPLBB)
  795. IDIMB = MAX(IDIMB,KDIMB)
  796. *
  797. * ----- choc elementaire LIGNE_CERCLE_FROTTEMENT
  798.  
  799. ELSE IF (CMOT.EQ.'LI_CE_FR') THEN
  800. MONESC= ' '
  801. TYPRET = ' '
  802. do in2 = 1,n2cham
  803. MO4=nomche(in2)(1:4)
  804. if (MO4.eq.'LIMA') then
  805. melval = ielval(in2)
  806. segact melval
  807. imai = ielche(1,1)
  808. segdes melval
  809. elseif (MO4.eq.'LIES') then
  810. melval = ielval(in2)
  811. MONESC = typche(in2)(9:16)
  812. segact melval
  813. iesc = ielche(1,1)
  814. segdes melval
  815. elseif (MO4.eq.'AMOR') then
  816. melval = ielval(in2)
  817. typret=typche(in2)(1:8)
  818. if (typret.eq.'POINTEUR') typret=typche(in2)(9:16)
  819. endif
  820. enddo
  821. *
  822. MELEME = IMAI
  823. SEGACT MELEME
  824. NELEMA = NUM(/2)
  825. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  826. NNOEMA = NELEMA
  827. ELSE
  828. NNOEMA = NELEMA+1
  829. ENDIF
  830. INOE = NUM(1,1)
  831. IF (NCPR(INOE).EQ.0) THEN
  832. NPLB = NPLB + 1
  833. NCPR(INOE) = NPLB
  834. ENDIF
  835. DO 40 IE = 1,(NNOEMA-1)
  836. INOE = NUM(2,IE)
  837. IF (NCPR(INOE).EQ.0) THEN
  838. NPLB = NPLB + 1
  839. NCPR(INOE) = NPLB
  840. ENDIF
  841. 40 CONTINUE
  842. SEGDES MELEME
  843. * Maillage_esclave
  844. IF (MONESC.EQ.'POINT') THEN
  845. * La ligne-esclave est un point
  846. IF (NCPR(IESC).EQ.0) THEN
  847. NPLB = NPLB + 1
  848. NCPR(IESC) = NPLB
  849. ENDIF
  850. NNOEES=1
  851. ELSE
  852. IF (MONESC.EQ.'MAILLAGE') THEN
  853. * La ligne-esclave est un MAILLAGE
  854. MELEME = IESC
  855. SEGACT MELEME
  856. NELEES = NUM(/2)
  857. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  858. NNOEES = NELEES
  859. ELSE
  860. NNOEES = NELEES+1
  861. ENDIF
  862. INOE = NUM(1,1)
  863. IF (NCPR(INOE).EQ.0) THEN
  864. NPLB = NPLB + 1
  865. NCPR(INOE) = NPLB
  866. ENDIF
  867. DO 50 IE = 1,(NNOEES-1)
  868. INOE = NUM(2,IE)
  869. IF (NCPR(INOE).EQ.0) THEN
  870. NPLB = NPLB + 1
  871. NCPR(INOE) = NPLB
  872. ENDIF
  873. 50 CONTINUE
  874. SEGDES MELEME
  875. ENDIF
  876. ENDIF
  877. KPLBB = NNOEMA + NNOEES
  878. IF (IDIM.EQ.3) THEN
  879. KDIMB = 6
  880. ELSE
  881. KDIMB = 3
  882. ENDIF
  883. * Pour le nombre maxi de parametres entiers on prend
  884. * en compte les 16 espaces dus aux liaisons conditionnelles
  885. * + nos 10 autres propres parametres
  886. * + la place pour les noeuds voisins
  887. * + la place pour les indicateurs de choc
  888. KIPALB = 16 + 10 +3*(NNOEMA+NNOEES)
  889. *
  890. IF (TYPRET.EQ.'CHPOINT') THEN
  891. KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+
  892. &NNOEES)
  893. ELSE IF (TYPRET.EQ.'REAL*8') THEN
  894. KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+
  895. &NNOEES)
  896. ELSE
  897. CALL ERREUR(522)
  898. RETURN
  899. ENDIF
  900. *
  901. NXPALB = MAX(NXPALB,KXPALB)
  902. NIPALB = MAX(NIPALB,KIPALB)
  903. NPLBB = MAX(NPLBB,KPLBB)
  904. IDIMB = MAX(IDIMB,KDIMB)
  905. *
  906. * ------ liaison PALIER_FLUIDE (uniquement RHODE_LI)
  907. *
  908. ELSE IF (CMOT.EQ.'PA_FL_RO') THEN
  909. *
  910. cbp KPLBB = 1
  911. KPLBB = 2
  912. KDIMB = IDIM
  913. *
  914. C I) Gestion du point support
  915. *
  916. INOE = num(1,1)
  917. IF (NCPR(INOE).EQ.0) THEN
  918. NPLB = NPLB + 1
  919. NCPR(INOE) = NPLB
  920. ENDIF
  921. cbp : si + tard on souhaite avoir une compatibilite entre la table DYNE
  922. c et la table PASAPAS, il faudra ecrire des choses ici... cf DYNE22
  923. *
  924. C II) Decompte du nombre de parametres entiers et reels
  925. *
  926. c CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0,
  927. c & 'MOT',I1,X0,CMOT,L1,IP1)
  928. IF (IERR.NE.0) RETURN
  929. *
  930. C II.1) Decompte du nombre de parametres propres aux differents types
  931. C de paliers (KIPLB2 pour les entiers, LXPLB2 pour les reels) :
  932. *
  933. C -- Cas du palier cylindrique ou a lobes, avec modele de Rhode et Li :
  934. *
  935. itgeom = 0
  936. NLOB = 0
  937. do in2 = 1,n2cham
  938. MO4=nomche(in2)(1:4)
  939. if (MO4.eq.'TLOB') then
  940. melval = ielval(in2)
  941. segact melval
  942. itgeom = ielche(1,1)
  943. segdes melval
  944. endif
  945. enddo
  946. if (itgeom.gt.0) then
  947. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  948. & 'ENTIER',NLOB,X0,' ',L1,IP1)
  949. IF (IERR.NE.0) RETURN
  950. KIPLB2 = 2 + NLOB
  951. KXPLB2 = 1 + (6*NLOB)
  952. endif
  953. *
  954. C II.2) Nombres totaux de parametres entiers et reels :
  955. *
  956. KIPALB = 5 + KIPLB2
  957. cbp KXPALB = 7 + KXPLB2 + 4
  958. KXPALB = 9 + KXPLB2
  959. *
  960. C Dimensionnement des variables de sortie :
  961. *
  962. NXPALB = MAX(NXPALB,KXPALB)
  963. NIPALB = MAX(NIPALB,KIPALB)
  964. NPLBB = MAX(NPLBB,KPLBB)
  965. IDIMB = MAX(IDIMB,KDIMB)
  966. *
  967. * --> fin liaison PALIER
  968. *
  969. ELSE
  970. CALL ERREUR(490)
  971. RETURN
  972. ENDIF
  973. segdes mchaml,imodel,meleme
  974. GOTO 10
  975. *
  976. RETURN
  977. END
  978.  
  979.  
  980.  
  981.  
  982.  
  983.  
  984.  

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