Télécharger cyne72.eso

Retour à la liste

Numérotation des lignes :

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

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