Télécharger cyne72.eso

Retour à la liste

Numérotation des lignes :

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

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