Télécharger dyne72.eso

Retour à la liste

Numérotation des lignes :

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

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