Télécharger dyne70.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE70 SOURCE BP208322 18/07/11 21:15:12 9879
  2. C
  3. C DYNE20 SOURCE AM 15/12/16 21:15:08 8752
  4. SUBROUTINE DYNE70(ILIB,KTLIAB,ITCARA)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. * *
  9. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  10. * ________________________________________________ *
  11. * *
  12. * Remplissage des tableaux de description des liaisons sur *
  13. * la base a partir des informations contenues dans la *
  14. * table ILIB. *
  15. * *
  16. * Parametres: *
  17. * *
  18. * e ILIB Table rassemblant la description des liaisons *
  19. * es KTLIAB Segment descriptif des liaisons sur la base B. *
  20. * *
  21. * *
  22. * Parametres de dimensionnement pour une liaison sur base: *
  23. * *
  24. * NIPALB : nombre de parametres pour definir le type des *
  25. * liaisons (NIPALB est fixe a 3). *
  26. * NXPALB : nombre maxi de parametres internes definissant les *
  27. * liaisons. *
  28. * NPLBB : nombre maxi de points intervenant dans une liaison. *
  29. * *
  30. * NPLB : nombre total de points. *
  31. * NLIAB : nombre total de liaisons. *
  32. * *
  33. * *
  34. * Tableaux fortran pour les liaisons sur base B : *
  35. * *
  36. * XPALB(NLIAB,NXPALB) : parametres de la liaison. *
  37. * IPALB(NLIAB,NIPALB) : renseigne sur le type de liaison. *
  38. * et les eventuelles conditions *
  39. * XABSCI Tableau contenant les abscisses de la loi plastique *
  40. * pour les liaisons point-point- ... -plastique *
  41. * XORDON Tableau contenant les ordonnees de la loi plastique *
  42. * pour les liaisons point-point- ... -plastique *
  43. * *
  44. * JPLIB(NPLB) : numero global des points. *
  45. * IPLIB(NLIAB,NPLBB) : numeros locaux des points concernes par *
  46. * la liaison. *
  47. * *
  48. * Icorres Pour garder le numero du pointeur des tables de *
  49. * liaison *
  50. * *
  51. * *
  52. * Auteur, date de creation: *
  53. * *
  54. * kich, 2007, #5994, d'abord dans dyne20.eso *
  55. * BP, 2018, creation de dyne70.eso pour une meilleure lisibilite *
  56. * *
  57. *--------------------------------------------------------------------*
  58. -INC CCOPTIO
  59. -INC SMCOORD
  60. -INC SMEVOLL
  61. -INC SMLREEL
  62. -INC SMMODEL
  63. -INC SMCHAML
  64. -INC SMELEME
  65. -INC SMCHPOI
  66. *
  67. SEGMENT MTLIAB
  68. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  69. REAL*8 XPALB(NLIAB,NXPALB)
  70. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  71. ENDSEGMENT
  72. *
  73. SEGMENT MLIGNE
  74. INTEGER KPLIB(NPLB)
  75. ENDSEGMENT
  76. *
  77. SEGMENT icorres( nliab)
  78. *
  79. LOGICAL L1,L0, log1, lmodyn,LPERM,LINTER,LECRO,LELAS
  80. CHARACTER*40 CMOT,MONMOT,CHARRE ,CMOT1 ,MONECR
  81. CHARACTER*8 MONAMO,MONSEUIL,CHARRE2,TYPRET,MARAID,MONPER
  82. CHARACTER*8 TYPREG,MONREC,MONJEU,MONSYM,MONELA,MONINTER
  83. CHARACTER*8 MONESC
  84. mchelm = itcara
  85. MTLIAB = KTLIAB
  86. NPLB = JPLIB(/1)
  87. NLIAB = IPALB(/1)
  88. segini icorres
  89. *
  90. * Boucle sur le nombre de liaisons
  91. *
  92. II = 0
  93. *
  94. mmodel = ilib
  95. segact mchelm
  96. n1 = imache(/1)
  97. do I = 1, kmodel(/1)
  98. imodel = kmodel(I)
  99. segact imodel
  100. ipt8 = imamod
  101. segact ipt8
  102. imod = ipt8.num(1,1)
  103. inoa = ipt8.num(1,1)
  104. isup = ipt8.num(1,1)
  105.  
  106. do 46 in = 1,n1
  107. meleme = imache(in)
  108. if (meleme.ne.imamod) goto 46
  109. if (conche(in).ne.conmod) goto 46
  110. segact meleme
  111. mchaml = ichaml(in)
  112. segact mchaml
  113. n2 = ielval(/1)
  114. goto 51
  115. 46 continue
  116. write(6,*) 'pas de caracteristique liaison' , i, conmod
  117. return
  118.  
  119. 51 continue
  120. TYPRET = ' '
  121. MONSEUIL = ' '
  122. if (cmatee.eq.'PO_PL_FL') then
  123. ITYP = 7
  124. do io = 1,n2
  125. if (nomche(io)(1:4).eq.'NORM') then
  126. melval = ielval(io)
  127. segact melval
  128. IPOI = ielche(1,1)
  129. else if (nomche(io)(1:4).eq.'INER') then
  130. melval = ielval(io)
  131. segact melval
  132. XINER = velche(1,1)
  133. else if (nomche(io)(1:4).eq.'CONV') then
  134. melval = ielval(io)
  135. segact melval
  136. XCONV = velche(1,1)
  137. else if (nomche(io)(1:4).eq.'VISC') then
  138. melval = ielval(io)
  139. segact melval
  140. XVISC = velche(1,1)
  141. else if (nomche(io)(1:4).eq.'PELO') then
  142. melval = ielval(io)
  143. segact melval
  144. XPCEL = velche(1,1)
  145. else if (nomche(io)(1:4).eq.'PRAP') then
  146. melval = ielval(io)
  147. segact melval
  148. XPCRA = velche(1,1)
  149. else if (nomche(io)(1:4).eq.'JFLU') then
  150. melval = ielval(io)
  151. segact melval
  152. XJEU = velche(1,1)
  153. else
  154. endif
  155. enddo
  156.  
  157. IPALB(I,1) = ITYP
  158. IPALB(I,3) = IDIM
  159. XPALB(I,1) = XINER
  160. XPALB(I,2) = XCONV
  161. XPALB(I,3) = XVISC
  162. XPALB(I,4) = XPCEL
  163. XPALB(I,5) = XPCRA
  164. XPALB(I,6) = XJEU
  165. *
  166. IPNV = (IDIM + 1) * (IPOI - 1)
  167. PS = 0.D0
  168. DO 70 ID = 1,IDIM
  169. XC = XCOOR(IPNV + ID)
  170. PS = PS + XC * XC
  171. 70 CONTINUE
  172. * end do
  173. IF (PS.LE.0.D0) THEN
  174. CALL ERREUR(162)
  175. RETURN
  176. ENDIF
  177. ID1 = 6
  178. DO 72 ID = 1,IDIM
  179. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  180. 72 CONTINUE
  181. * end do
  182. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  183. IPLIB(I,1) = IPLAC
  184. *
  185. else if(cmatee.eq.'PO_PL_FR') then
  186. ITYP = 3
  187. MARAID = ' '
  188. TYPRET = ' '
  189. MONAMO = ' '
  190. do io = 1,n2
  191. if (nomche(io)(1:4).eq.'NORM') then
  192. melval = ielval(io)
  193. segact melval
  194. IPOI = ielche(1,1)
  195. else if (nomche(io)(1:4).eq.'RAID') then
  196. melval = ielval(io)
  197. segact melval
  198. xrain = velche(1,1)
  199. MARAID = 'FLOTTANT'
  200. else if (nomche(io)(1:4).eq.'JEU') then
  201. melval = ielval(io)
  202. segact melval
  203. XJEU = velche(1,1)
  204. else if (nomche(io)(1:4).eq.'GLIS') then
  205. melval = ielval(io)
  206. segact melval
  207. XGLIS = velche(1,1)
  208. else if (nomche(io)(1:4).eq.'ADHE') then
  209. melval = ielval(io)
  210. segact melval
  211. XADHE = velche(1,1)
  212. else if (nomche(io)(1:4).eq.'RTAN') then
  213. melval = ielval(io)
  214. segact melval
  215. XRAIT = velche(1,1)
  216. else if (nomche(io)(1:4).eq.'ATAN') then
  217. melval = ielval(io)
  218. segact melval
  219. XAMOT = velche(1,1)
  220. else if (nomche(io)(1:4).eq.'AMOR') then
  221. melval = ielval(io)
  222. segact melval
  223. xamon = velche(1,1)
  224. MONAMO = 'FLOTTANT'
  225. else if (nomche(io)(1:4).eq.'LOIC') then
  226. melval = ielval(io)
  227. segact melval
  228. ipevo = ielche(1,1)
  229. TYPRET = 'EVOLUTIO'
  230. else
  231. endif
  232. enddo
  233.  
  234. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  235. CALL ERREUR(891)
  236. RETURN
  237. ENDIF
  238. IF (TYPRET.EQ.'EVOLUTIO') THEN
  239. ITYP = 103
  240. XRAIN = 0.d0
  241. ENDIF
  242. IPALB(I,1) = ITYP
  243. IPALB(I,3) = IDIM
  244. XPALB(I,1) = XRAIN
  245. XPALB(I,2) = XJEU
  246. XPALB(I,3) = XGLIS
  247. XPALB(I,4) = XADHE
  248. XPALB(I,5) = XRAIT
  249. XPALB(I,6) = XAMOT
  250. IF (MONAMO.EQ.'FLOTTANT') THEN
  251. XPALB(I,7) = XAMON
  252. ELSE
  253. XPALB(I,7) = 0.D0
  254. ENDIF
  255. *
  256. IPNV = (IDIM + 1) * (IPOI - 1)
  257. PS = 0.D0
  258. DO 20 ID = 1,IDIM
  259. XC = XCOOR(IPNV + ID)
  260. PS = PS + XC * XC
  261. 20 CONTINUE
  262. * end do
  263. IF (PS.LE.0.D0) THEN
  264. CALL ERREUR(162)
  265. RETURN
  266. ENDIF
  267. ID1 = 7
  268. DO 22 ID = 1,IDIM
  269. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  270. 22 CONTINUE
  271. * end do
  272.  
  273. IF (IPALB(I,1) .EQ. 103) THEN
  274. MEVOLL = IPEVO
  275. *
  276. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  277. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  278. * des tableaux xabsci et xordon
  279. *
  280. SEGACT MEVOLL
  281. KEVOLL = IEVOLL(1)
  282. SEGACT KEVOLL
  283. MLREE1 = IPROGX
  284. MLREE2 = IPROGY
  285. SEGACT MLREE1
  286. SEGACT MLREE2
  287. NIP = XABSCI(/2)
  288. *
  289. DO 26 MM=1,NIP
  290. XABSCI (I,MM) = MLREE1.PROG(MM)
  291. XORDON (I,MM) = MLREE2.PROG(MM)
  292. 26 CONTINUE
  293. SEGDES MLREE1
  294. SEGDES MLREE2
  295. SEGDES KEVOLL
  296. SEGDES MEVOLL
  297. ENDIF
  298. *
  299. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  300. IPLIB(I,1) = IPLAC
  301. *
  302. else if(cmatee.eq.'PO_PL') then
  303. ITYP = 1
  304. IPERM = 0
  305. XPALB(I,3) = 0.D0
  306. do io = 1,n2
  307. if (nomche(io)(1:4).eq.'NORM') then
  308. melval = ielval(io)
  309. segact melval
  310. IPOI = ielche(1,1)
  311. else if (nomche(io)(1:4).eq.'RAID') then
  312. melval = ielval(io)
  313. segact melval
  314. xraid = velche(1,1)
  315. else if (nomche(io)(1:4).eq.'JEU') then
  316. melval = ielval(io)
  317. segact melval
  318. xjeu = velche(1,1)
  319. else if (nomche(io)(1:4).eq.'SPLA') then
  320. melval = ielval(io)
  321. segact melval
  322. xseuil = velche(1,1)
  323. MONSEUIL ='FLOTTANT'
  324. else if (nomche(io)(1:4).eq.'AMOR') then
  325. melval = ielval(io)
  326. segact melval
  327. xamon = velche(1,1)
  328. XPALB(I,3) = XAMON
  329. else if (nomche(io)(1:4).eq.'LOIC') then
  330. melval = ielval(io)
  331. segact melval
  332. ipevo = ielche(1,1)
  333. TYPRET = 'EVOLUTIO'
  334. else if (nomche(io)(1:4).eq.'PERM') then
  335. melval = ielval(io)
  336. segact melval
  337. IPERM = 1
  338. else
  339. endif
  340. enddo
  341.  
  342. IPALB(I,1) = ITYP
  343. IPALB(I,3) = IDIM
  344. IPALB(I,4) = IPERM
  345. XPALB(I,1) = XRAID
  346. XPALB(I,2) = XJEU
  347. *
  348. IPNV = (IDIM + 1) * (IPOI - 1)
  349. PS = 0.D0
  350. DO 17 ID = 1,IDIM
  351. XC = XCOOR(IPNV + ID)
  352. PS = PS + XC * XC
  353. 17 CONTINUE
  354. *
  355. IF (PS.LE.0.D0) THEN
  356. CALL ERREUR(162)
  357. RETURN
  358. ENDIF
  359. ID1 = 3
  360.  
  361. IF (MONSEUIL .EQ.'FLOTTANT') THEN
  362. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  363. IPALB(I,1) = 101
  364. ELSE
  365. IPALB(I,1) = 100
  366. ENDIF
  367. ID1 = 4
  368. XPALB(I,ID1) = XSEUIL
  369. ELSE
  370. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  371. IPALB(I,1) = 102
  372. ENDIF
  373. ENDIF
  374.  
  375. *
  376. DO 12 ID = 1,IDIM
  377. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  378. 12 CONTINUE
  379. *
  380. IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN
  381. MEVOLL = IPEVO
  382. *
  383. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  384. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  385. * des tableaux xabsci et xordon
  386. *
  387. SEGACT MEVOLL
  388. KEVOLL = IEVOLL(1)
  389. SEGACT KEVOLL
  390. MLREE1 = IPROGX
  391. MLREE2 = IPROGY
  392. SEGACT MLREE1
  393. SEGACT MLREE2
  394. NIP = XABSCI(/2)
  395. *
  396. DO 16 MM=1,NIP
  397. XABSCI (I,MM) = MLREE1.PROG(MM)
  398. XORDON (I,MM) = MLREE2.PROG(MM)
  399. 16 CONTINUE
  400. *
  401. SEGDES MLREE1
  402. SEGDES MLREE2
  403. SEGDES KEVOLL
  404. SEGDES MEVOLL
  405. ENDIF
  406. *
  407. IMOD = num(1,1)
  408. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  409. IPLIB(I,1) = IPLAC
  410. *
  411. else if (cmatee.eq.'PO_PO_FR') then
  412. ITYP = 13
  413. MARAID = ' '
  414. MONPER = ' '
  415. MONAMO = ' '
  416. TYPRET = ' '
  417. TYPREG = ' '
  418. CHARRE = ' '
  419. do io = 1,n2
  420. if (nomche(io)(1:4).eq.'NORM') then
  421. melval = ielval(io)
  422. segact melval
  423. IPOI = ielche(1,1)
  424. else if (nomche(io)(1:4).eq.'RAID') then
  425. melval = ielval(io)
  426. segact melval
  427. xraid = velche(1,1)
  428. else if (nomche(io)(1:4).eq.'JEU') then
  429. melval = ielval(io)
  430. segact melval
  431. xjeu = velche(1,1)
  432. else if (nomche(io)(1:4).eq.'POIB') then
  433. melval = ielval(io)
  434. segact melval
  435. INOB = ielche(1,1)
  436. else if (nomche(io)(1:4).eq.'AMOR') then
  437. melval = ielval(io)
  438. segact melval
  439. xamon = velche(1,1)
  440. MONAMO='FLOTTANT'
  441. else if (nomche(io)(1:4).eq.'LOIC') then
  442. melval = ielval(io)
  443. segact melval
  444. ipevo = ielche(1,1)
  445. TYPRET = 'EVOLUTIO'
  446. else if (nomche(io)(1:4).eq.'MODE') then
  447. melval = ielval(io)
  448. segact melval
  449. igibe = ielche(1,1)
  450. TYPREG = 'MOT'
  451. CHARRE = 'NEDJAI-GIBERT'
  452. else if (nomche(io)(1:4).eq.'GLIS') then
  453. melval = ielval(io)
  454. segact melval
  455. XGLIS = velche(1,1)
  456. else if (nomche(io)(1:4).eq.'ADHE') then
  457. melval = ielval(io)
  458. segact melval
  459. XADHE = velche(1,1)
  460. else if (nomche(io)(1:4).eq.'RTAN') then
  461. melval = ielval(io)
  462. segact melval
  463. XRAIT = velche(1,1)
  464. else if (nomche(io)(1:4).eq.'ATAN') then
  465. melval = ielval(io)
  466. segact melval
  467. XAMOT = velche(1,1)
  468. else
  469. endif
  470. enddo
  471.  
  472. IF (IERR.NE.0) RETURN
  473. ** dans quel cas monamo est il entier? PV
  474. ** IF (MONAMO .EQ. 'ENTIER ') THEN
  475. ** XAMON = 1.D0*I0
  476. ** MONAMO = 'FLOTTANT'
  477. ** ENDIF
  478. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  479. CALL ERREUR(891)
  480. RETURN
  481. ENDIF
  482. IF (TYPRET.EQ.'EVOLUTIO') THEN
  483. ITYP = 113
  484. XRAID = 0.d0
  485. ENDIF
  486. *
  487. IPALB(I,1) = ITYP
  488. IPALB(I,3) = IDIM
  489. XPALB(I,1) = XRAID
  490. XPALB(I,2) = XJEU
  491. XPALB(I,3) = XGLIS
  492. XPALB(I,4) = XADHE
  493. XPALB(I,5) = XRAIT
  494. XPALB(I,6) = XAMOT
  495. IF (MONAMO.EQ.'FLOTTANT') THEN
  496. XPALB(I,7) = XAMON
  497. ELSE
  498. XPALB(I,7) = 0.D0
  499. ENDIF
  500.  
  501. * cas particulier pas tres orthodoxe pour Gibert
  502. * on passe a ityp = -13 et on modifie et ajoute
  503. * devlb2, devlb1-->devfb2--->dgcha4--->dgchfr--->dgchgl, devso4
  504. IF (TYPREG.EQ.'MOT') THEN
  505. IF (CHARRE.EQ.'NEDJAI-GIBERT') THEN
  506. IPALB(I,1) = -13
  507. ELSE
  508. CALL ERREUR(891)
  509. RETURN
  510. ENDIF
  511. ELSEIF (IGIBE.NE.0) THEN
  512. CALL ERREUR(891)
  513. RETURN
  514. ENDIF
  515.  
  516. *
  517. * normalisation de la normale
  518. *
  519. IPNV = (IDIM + 1) * (IPOI - 1)
  520. PS = 0.D0
  521. DO 420 ID = 1,IDIM
  522. XC = XCOOR(IPNV + ID)
  523. PS = PS + XC * XC
  524. 420 CONTINUE
  525. * end do
  526. IF (PS.LE.0.D0) THEN
  527. CALL ERREUR(162)
  528. RETURN
  529. ENDIF
  530. DO 422 ID = 1,IDIM
  531. ID2 = 7 + ID
  532. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  533. 422 CONTINUE
  534. * end do
  535. *
  536. IF (IPALB(I,1) .EQ. 113) THEN
  537. MEVOLL = IPEVO
  538. *
  539. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  540. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  541. * des tableaux xabsci et xordon
  542. *
  543. SEGACT MEVOLL
  544. KEVOLL = IEVOLL(1)
  545. SEGACT KEVOLL
  546. MLREE1 = IPROGX
  547. MLREE2 = IPROGY
  548. SEGACT MLREE1
  549. SEGACT MLREE2
  550. NIP = XABSCI(/2)
  551. *
  552. DO 424 MM=1,NIP
  553. XABSCI (I,MM) = MLREE1.PROG(MM)
  554. XORDON (I,MM) = MLREE2.PROG(MM)
  555. 424 CONTINUE
  556. *
  557. SEGDES MLREE1
  558. SEGDES MLREE2
  559. SEGDES KEVOLL
  560. SEGDES MEVOLL
  561. ENDIF
  562. *
  563. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  564. IPLIB(I,1) = IPLAC
  565. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  566. IPLIB(I,2) = IPLAC
  567.  
  568. *
  569. else if(cmatee.eq.'PO_PO_DP') then
  570. ITYP = 16
  571. MARAID = ' '
  572. MONPER = ' '
  573. LPERM = .false.
  574. IPERM = 0
  575. MONAMO = ' '
  576. TYPRET = ' '
  577. do io = 1,n2
  578. if (nomche(io)(1:4).eq.'NORM') then
  579. melval = ielval(io)
  580. segact melval
  581. IPOI = ielche(1,1)
  582. else if (nomche(io)(1:4).eq.'ECRO') then
  583. melval = ielval(io)
  584. segact melval
  585. * IPERM = 2 <= isotrope , IPERM = 3 <= cinematique
  586. IPERM = ielche(1,1)
  587. else if (nomche(io)(1:4).eq.'JEU') then
  588. melval = ielval(io)
  589. segact melval
  590. xjeu = velche(1,1)
  591. else if (nomche(io)(1:4).eq.'POIB') then
  592. melval = ielval(io)
  593. segact melval
  594. INOB = ielche(1,1)
  595. else if (nomche(io)(1:4).eq.'AMOR') then
  596. melval = ielval(io)
  597. segact melval
  598. xamon = velche(1,1)
  599. MONAMO='FLOTTANT'
  600. else if (nomche(io)(1:4).eq.'LOIC') then
  601. melval = ielval(io)
  602. segact melval
  603. ipevo = ielche(1,1)
  604. TYPRET = 'EVOLUTIO'
  605. else if (nomche(io)(1:4).eq.'PERM') then
  606. melval = ielval(io)
  607. segact melval
  608. LPERM = .true.
  609. else
  610. endif
  611. enddo
  612.  
  613. IF (IERR.NE.0) RETURN
  614.  
  615. IF (LPERM) THEN
  616. IF (.NOT.(XJEU.EQ.0.D0)) THEN
  617. * WRITE (*,*) 'Liaison permanente, mise a zero du jeu.'
  618. XJEU = 0.D0
  619. ENDIF
  620.  
  621. IF (IPERM.ne.3.and.IPERM.ne.2) THEN
  622. call erreur(21)
  623. RETURN
  624. ENDIF
  625. ENDIF
  626. *
  627. MEVOLL = IPEVO
  628. *
  629. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  630. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  631. * des tableaux xabsci et xordon
  632. *
  633. SEGACT MEVOLL
  634. KEVOLL = IEVOLL(1)
  635. SEGACT KEVOLL
  636. MLREE1 = IPROGX
  637. MLREE2 = IPROGY
  638. SEGACT MLREE1
  639. SEGACT MLREE2
  640. NIP = XABSCI(/2)
  641. *
  642. DO 426 MM=1,NIP
  643. XABSCI (I,MM) = MLREE1.PROG(MM)
  644. XORDON (I,MM) = MLREE2.PROG(MM)
  645. 426 CONTINUE
  646. *
  647. SEGDES MLREE1
  648. SEGDES MLREE2
  649. SEGDES KEVOLL
  650. SEGDES MEVOLL
  651. *
  652. IPALB(I,1) = ITYP
  653. IPALB(I,3) = IDIM
  654. XPALB(I,1) = XJEU
  655. IPALB(I,5) = IPERM
  656. *
  657. * normalisation de la normale
  658. *
  659. IPNV = (IDIM + 1) * (IPOI - 1)
  660. PS = 0.D0
  661. DO 30 ID = 1,IDIM
  662. XC = XCOOR(IPNV + ID)
  663. PS = PS + XC * XC
  664. 30 CONTINUE
  665. * end do
  666. IF (PS.LE.0.D0) THEN
  667. CALL ERREUR(162)
  668. RETURN
  669. ENDIF
  670. IF (MONAMO.EQ.'FLOTTANT') THEN
  671. IPALB(I,1) = 17
  672. XPALB(I,2) = XAMON
  673. DO 32 ID = 1,IDIM
  674. ID2 = 2 + ID
  675. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  676. 32 CONTINUE
  677. * end do
  678. ELSE
  679. DO 34 ID = 1,IDIM
  680. ID2 = 1 + ID
  681. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  682. 34 CONTINUE
  683. * end do
  684. ENDIF
  685. *
  686. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  687. IPLIB(I,1) = IPLAC
  688. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  689. IPLIB(I,2) = IPLAC
  690. *
  691. else if(cmatee.eq.'PO_PO_RP') then
  692. ITYP = 50
  693. MARAID = ' '
  694. MONPER = ' '
  695. MONELA = ' '
  696. LPERM = .FALSE.
  697. LELAS = .FALSE.
  698. LECRO = .FALSE.
  699. IPERM = 0
  700. MONAMO = ' '
  701. TYPRET = ' '
  702. do io = 1,n2
  703. if (nomche(io)(1:4).eq.'AXRO') then
  704. melval = ielval(io)
  705. segact melval
  706. IPOI = ielche(1,1)
  707. else if (nomche(io)(1:4).eq.'JEU') then
  708. melval = ielval(io)
  709. segact melval
  710. xjeu = velche(1,1)
  711. else if (nomche(io)(1:4).eq.'POIB') then
  712. melval = ielval(io)
  713. segact melval
  714. INOB = ielche(1,1)
  715. else if (nomche(io)(1:4).eq.'AMOR') then
  716. melval = ielval(io)
  717. segact melval
  718. xamon = velche(1,1)
  719. MONAMO='FLOTTANT'
  720. else if (nomche(io)(1:4).eq.'LOIC') then
  721. melval = ielval(io)
  722. segact melval
  723. ipevo = ielche(1,1)
  724. TYPRET = 'EVOLUTIO'
  725. else if (nomche(io)(1:4).eq.'PERM') then
  726. melval = ielval(io)
  727. segact melval
  728. LPERM = .true.
  729. else if (nomche(io)(1:4).eq.'ELAS') then
  730. melval = ielval(io)
  731. segact melval
  732. LELAS = .true.
  733. else if (nomche(io)(1:4).eq.'ECRO') then
  734. melval = ielval(io)
  735. segact melval
  736. * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique
  737. LECRO = .true.
  738. iecro = ielche(1,1)
  739. if (iecro.eq.1) monecr = 'ISOTROPE'
  740. if (iecro.eq.2) monecr = 'CINEMATIQUE'
  741. else
  742. endif
  743. enddo
  744.  
  745. IF (IERR.NE.0) RETURN
  746. *
  747. * iperm = -2 : liaison elastique permanente
  748. * iperm = -1 : choc elastique
  749. * iperm = 0 : donnees incoherentes ou insuffisantes
  750. * iperm = 1 : choc plastique
  751. * iperm = 2 : liaison plastique isotrope
  752. * iperm = 3 : liaison plastique cinematique
  753. *
  754.  
  755. IF (LPERM) THEN
  756. IF (LELAS.AND.(.NOT.LECRO)) IPERM = -2
  757. IF (MONECR.EQ.'ISOTROPE'.AND.(.NOT.LELAS)) IPERM = 2
  758. IF (MONECR.EQ.'CINEMATIQUE'.AND.(.NOT.LELAS)) IPERM = 3
  759. IF (.NOT.(XJEU.EQ.0.)) THEN
  760. * WRITE(*,*) 'Liaison permanente, mise a zero du jeu.'
  761. XJEU = 0.D0
  762. ENDIF
  763. ELSE
  764. IF (.NOT.LECRO) THEN
  765. IF (LELAS) THEN
  766. IPERM = -1
  767. ELSE
  768. IPERM = 1
  769. ENDIF
  770. ENDIF
  771. ENDIF
  772. IF (IPERM.EQ.0) THEN
  773. CALL ERREUR(905)
  774. RETURN
  775. ENDIF
  776. *
  777. MEVOLL = IPEVO
  778. *
  779. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  780. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  781. * des tableaux xabsci et xordon
  782. *
  783. SEGACT MEVOLL
  784. KEVOLL = IEVOLL(1)
  785. SEGACT KEVOLL
  786. MLREE1 = IPROGX
  787. MLREE2 = IPROGY
  788. SEGACT MLREE1
  789. SEGACT MLREE2
  790. * NIP = MLREE1.PROG(/1)
  791. NIP = XABSCI(/2)
  792. *
  793. DO 110 MM=1,NIP
  794. XABSCI (I,MM) = MLREE1.PROG(MM)
  795. XORDON (I,MM) = MLREE2.PROG(MM)
  796. 110 CONTINUE
  797. *
  798. SEGDES MLREE1
  799. SEGDES MLREE2
  800. SEGDES KEVOLL
  801. SEGDES MEVOLL
  802. *
  803. IPALB(I,1) = ITYP
  804. IPALB(I,3) = IDIM
  805. IPALB(I,5) = IPERM
  806. XPALB(I,1) = XJEU
  807. *
  808. * normalisation de l'axe de rotation
  809. *
  810. IPNV = (IDIM + 1) * (IPOI - 1)
  811. PS = 0.D0
  812. DO 120 ID = 1,IDIM
  813. XC = XCOOR(IPNV + ID)
  814. PS = PS + XC * XC
  815. 120 CONTINUE
  816. * end do
  817. IF (PS.LE.0.D0) THEN
  818. CALL ERREUR(162)
  819. RETURN
  820. ENDIF
  821. IF (MONAMO.EQ.'FLOTTANT') THEN
  822. IPALB(I,1) = 51
  823. XPALB(I,2) = XAMON
  824. DO 122 ID = 1,IDIM
  825. ID2 = 2 + ID
  826. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  827. 122 CONTINUE
  828. * end do
  829. ELSE
  830. DO 124 ID = 1,IDIM
  831. ID2 = 1 + ID
  832. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  833. 124 CONTINUE
  834. * end do
  835. ENDIF
  836. *
  837. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  838. IPLIB(I,1) = IPLAC
  839. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  840. IPLIB(I,2) = IPLAC
  841. *
  842. *
  843. else if(cmatee.eq.'PO_PO') then
  844. ITYP = 11
  845. MARAID = ' '
  846. MONPER = ' '
  847. LPERM = .FALSE.
  848. IPERM = 0
  849. MONAMO = ' '
  850. TYPRET = ' '
  851. do io = 1,n2
  852. if (nomche(io)(1:4).eq.'NORM') then
  853. melval = ielval(io)
  854. segact melval
  855. IPOI = ielche(1,1)
  856. else if (nomche(io)(1:4).eq.'RAID') then
  857. melval = ielval(io)
  858. segact melval
  859. xraid = velche(1,1)
  860. else if (nomche(io)(1:4).eq.'JEU') then
  861. melval = ielval(io)
  862. segact melval
  863. xjeu = velche(1,1)
  864. else if (nomche(io)(1:4).eq.'POIB') then
  865. melval = ielval(io)
  866. segact melval
  867. INOB = ielche(1,1)
  868. else if (nomche(io)(1:4).eq.'AMOR') then
  869. melval = ielval(io)
  870. segact melval
  871. xamon = velche(1,1)
  872. MONAMO='FLOTTANT'
  873. else if (nomche(io)(1:4).eq.'LOIC') then
  874. melval = ielval(io)
  875. segact melval
  876. ipevo = ielche(1,1)
  877. TYPRET = 'EVOLUTIO'
  878. else if (nomche(io)(1:4).eq.'PERM') then
  879. melval = ielval(io)
  880. segact melval
  881. IPERM = ielche(1,1)
  882. LPERM = .true.
  883. else
  884. endif
  885. enddo
  886.  
  887. IF (IERR.NE.0) RETURN
  888.  
  889. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  890. CALL ERREUR(891)
  891. RETURN
  892. ENDIF
  893. *
  894. IF (TYPRET.EQ.'EVOLUTIO') THEN
  895. ITYP = 111
  896. XRAID = 0.d0
  897. ENDIF
  898.  
  899. IPALB(I,1) = ITYP
  900. IPALB(I,3) = IDIM
  901. IPALB(I,4) = IPERM
  902. XPALB(I,1) = XRAID
  903. XPALB(I,2) = XJEU
  904. *
  905. * normalisation de la normale
  906. *
  907. IPNV = (IDIM + 1) * (IPOI - 1)
  908. PS = 0.D0
  909. DO 111 ID = 1,IDIM
  910. XC = XCOOR(IPNV + ID)
  911. PS = PS + XC * XC
  912. 111 CONTINUE
  913. * end do
  914. IF (PS.LE.0.D0) THEN
  915. CALL ERREUR(162)
  916. RETURN
  917. ENDIF
  918. IF (MONAMO.EQ.'FLOTTANT') THEN
  919. XPALB(I,3) = XAMON
  920. ELSE
  921. XPALB(I,3) = 0.d0
  922. ENDIF
  923. DO 112 ID = 1,IDIM
  924. ID2 = 3 + ID
  925. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  926. 112 CONTINUE
  927. * end do
  928. *
  929. IF (IPALB(I,1) .EQ. 111) THEN
  930. MEVOLL = IPEVO
  931. *
  932. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  933. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  934. * des tableaux xabsci et xordon
  935. *
  936. SEGACT MEVOLL
  937. KEVOLL = IEVOLL(1)
  938. SEGACT KEVOLL
  939. MLREE1 = IPROGX
  940. MLREE2 = IPROGY
  941. SEGACT MLREE1
  942. SEGACT MLREE2
  943. NIP = XABSCI(/2)
  944. *
  945. DO 116 MM=1,NIP
  946. XABSCI (I,MM) = MLREE1.PROG(MM)
  947. XORDON (I,MM) = MLREE2.PROG(MM)
  948. 116 CONTINUE
  949. *
  950. SEGDES MLREE1
  951. SEGDES MLREE2
  952. SEGDES KEVOLL
  953. SEGDES MEVOLL
  954. ENDIF
  955. *
  956. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  957. IPLIB(I,1) = IPLAC
  958. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  959. IPLIB(I,2) = IPLAC
  960. *
  961. else if(cmatee.eq.'PO_CE_MO') then
  962. ITYP = 33
  963. MONAMO = ' '
  964. MARAID = ' '
  965. MONINTER = ' '
  966. LINTER = .true.
  967. do io = 1,n2
  968. if (nomche(io)(1:4).eq.'NORM') then
  969. melval = ielval(io)
  970. segact melval
  971. IPOI = ielche(1,1)
  972. elseif (nomche(io)(1:4).eq.'PCER') then
  973. melval = ielval(io)
  974. segact melval
  975. INOB = ielche(1,1)
  976. else if (nomche(io)(1:4).eq.'RAID') then
  977. melval = ielval(io)
  978. segact melval
  979. xrain = velche(1,1)
  980. MARAID = 'FLOTTANT'
  981. else if (nomche(io)(1:4).eq.'RAYO') then
  982. melval = ielval(io)
  983. segact melval
  984. XRAYO = velche(1,1)
  985. else if (nomche(io)(1:4).eq.'GLIS') then
  986. melval = ielval(io)
  987. segact melval
  988. XGLIS = velche(1,1)
  989. else if (nomche(io)(1:4).eq.'ADHE') then
  990. melval = ielval(io)
  991. segact melval
  992. XADHE = velche(1,1)
  993. else if (nomche(io)(1:4).eq.'RTAN') then
  994. melval = ielval(io)
  995. segact melval
  996. XRAIT = velche(1,1)
  997. else if (nomche(io)(1:4).eq.'ATAN') then
  998. melval = ielval(io)
  999. segact melval
  1000. XAMOT = velche(1,1)
  1001. else if (nomche(io)(1:4).eq.'CINT') then
  1002. melval = ielval(io)
  1003. segact melval
  1004. LINTER = .FALSE.
  1005. else if (nomche(io)(1:4).eq.'AMOR') then
  1006. melval = ielval(io)
  1007. segact melval
  1008. xamon = velche(1,1)
  1009. MONAMO = 'FLOTTANT'
  1010. else
  1011. endif
  1012. enddo
  1013.  
  1014. IF (IERR.NE.0) RETURN
  1015. IPALB(I,1) = ITYP
  1016. IPALB(I,3) = IDIM
  1017. IPALB(I,4) = 1
  1018. IF (.NOT.LINTER) THEN
  1019. IPALB(I,4) = 0
  1020. ENDIF
  1021. XPALB(I,1) = XRAIN
  1022. XPALB(I,2) = XRAYO
  1023. XPALB(I,3) = XGLIS
  1024. XPALB(I,4) = XADHE
  1025. XPALB(I,5) = XRAIT
  1026. XPALB(I,6) = XAMOT
  1027. *
  1028. * normalisation de la normale
  1029. *
  1030. IPNV = (IDIM + 1) * (IPOI - 1)
  1031. IPNOA = (IDIM + 1) * (INOA - 1)
  1032. IPNOB = (IDIM + 1) * (INOB - 1)
  1033. PS = 0.D0
  1034. DO 202 ID = 1,IDIM
  1035. XC = XCOOR(IPNV + ID)
  1036. PS = PS + XC * XC
  1037. 202 CONTINUE
  1038. *** write (6,*) ' ps - 3 ',ps
  1039. IF (PS.LE.0.D0) THEN
  1040. CALL ERREUR(162)
  1041. RETURN
  1042. ENDIF
  1043. IF (MONAMO.EQ.'FLOTTANT') THEN
  1044. IPALB(I,1) = 34
  1045. XPALB(I,7) = XAMON
  1046. ID1 = 7
  1047. ELSE
  1048. ID1 = 6
  1049. ENDIF
  1050. ID2 = ID1 + IDIM
  1051. DO 222 ID = 1,IDIM
  1052. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1053. XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  1054. 222 CONTINUE
  1055. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  1056. IPLIB(I,1) = IPLAC
  1057. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  1058. IPLIB(I,2) = IPLAC
  1059. *
  1060. else if(cmatee.eq.'PO_CE_FR') then
  1061. ITYP = 23
  1062. MONAMO = ' '
  1063. MARAID = ' '
  1064. MONINTER = ' '
  1065. LINTER = .true.
  1066. do io = 1,n2
  1067. if (nomche(io)(1:4).eq.'NORM') then
  1068. melval = ielval(io)
  1069. segact melval
  1070. IPOI = ielche(1,1)
  1071. elseif (nomche(io)(1:4).eq.'EXCE') then
  1072. melval = ielval(io)
  1073. segact melval
  1074. IEXC = ielche(1,1)
  1075. else if (nomche(io)(1:4).eq.'RAID') then
  1076. melval = ielval(io)
  1077. segact melval
  1078. xrain = velche(1,1)
  1079. MARAID = 'FLOTTANT'
  1080. else if (nomche(io)(1:4).eq.'RAYO') then
  1081. melval = ielval(io)
  1082. segact melval
  1083. XRAYO = velche(1,1)
  1084. else if (nomche(io)(1:4).eq.'GLIS') then
  1085. melval = ielval(io)
  1086. segact melval
  1087. XGLIS = velche(1,1)
  1088. else if (nomche(io)(1:4).eq.'ADHE') then
  1089. melval = ielval(io)
  1090. segact melval
  1091. XADHE = velche(1,1)
  1092. else if (nomche(io)(1:4).eq.'RTAN') then
  1093. melval = ielval(io)
  1094. segact melval
  1095. XRAIT = velche(1,1)
  1096. else if (nomche(io)(1:4).eq.'ATAN') then
  1097. melval = ielval(io)
  1098. segact melval
  1099. XAMOT = velche(1,1)
  1100. else if (nomche(io)(1:4).eq.'CINT') then
  1101. melval = ielval(io)
  1102. segact melval
  1103. LINTER = .false.
  1104. else if (nomche(io)(1:4).eq.'AMOR') then
  1105. melval = ielval(io)
  1106. segact melval
  1107. xamon = velche(1,1)
  1108. MONAMO = 'FLOTTANT'
  1109. else
  1110. endif
  1111. enddo
  1112. IF (IERR.NE.0) RETURN
  1113. *
  1114. IPALB(I,1) = ITYP
  1115. IPALB(I,3) = IDIM
  1116. IPALB(I,4) = 1
  1117. IF (.NOT.LINTER) THEN
  1118. IPALB(I,4) = 0
  1119. ENDIF
  1120. XPALB(I,1) = XRAIN
  1121. XPALB(I,2) = XRAYO
  1122. XPALB(I,3) = XGLIS
  1123. XPALB(I,4) = XADHE
  1124. XPALB(I,5) = XRAIT
  1125. XPALB(I,6) = XAMOT
  1126. *
  1127. * normalisation de la normale
  1128. *
  1129. IPNV = (IDIM + 1) * (IPOI - 1)
  1130. IPEX = (IDIM + 1) * (IEXC - 1)
  1131. PS = 0.D0
  1132. DO 320 ID = 1,IDIM
  1133. XC = XCOOR(IPNV + ID)
  1134. PS = PS + XC * XC
  1135. 320 CONTINUE
  1136. *** write (6,*) ' ps - 2 ',ps
  1137. * end do
  1138. IF (PS.LE.0.D0) THEN
  1139. CALL ERREUR(162)
  1140. RETURN
  1141. ENDIF
  1142. IF (MONAMO.EQ.'FLOTTANT') THEN
  1143. IPALB(I,1) = 24
  1144. XPALB(I,7) = XAMON
  1145. ID1 = 7
  1146. ELSE
  1147. ID1 = 6
  1148. ENDIF
  1149. ID2 = ID1 + IDIM
  1150. DO 322 ID = 1,IDIM
  1151. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1152. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1153. 322 CONTINUE
  1154. * end do
  1155. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1156. IPLIB(I,1) = IPLAC
  1157. *
  1158. else if(cmatee.eq.'PO_CE') then
  1159. ITYP = 21
  1160. MARAID = ' '
  1161. MONPER = ' '
  1162. MONAMO = ' '
  1163. TYPRET = ' '
  1164. do io = 1,n2
  1165. if (nomche(io)(1:4).eq.'NORM') then
  1166. melval = ielval(io)
  1167. segact melval
  1168. IPOI = ielche(1,1)
  1169. else if (nomche(io)(1:4).eq.'RAID') then
  1170. melval = ielval(io)
  1171. segact melval
  1172. xraid = velche(1,1)
  1173. else if (nomche(io)(1:4).eq.'EXCE') then
  1174. melval = ielval(io)
  1175. segact melval
  1176. IEXC = ielche(1,1)
  1177. else if (nomche(io)(1:4).eq.'RAYO') then
  1178. melval = ielval(io)
  1179. segact melval
  1180. xrayo = velche(1,1)
  1181. else if (nomche(io)(1:4).eq.'AMOR') then
  1182. melval = ielval(io)
  1183. segact melval
  1184. xamon = velche(1,1)
  1185. MONAMO='FLOTTANT'
  1186. else
  1187. endif
  1188. enddo
  1189.  
  1190. IF (IERR.NE.0) RETURN
  1191. IPALB(I,1) = ITYP
  1192. IPALB(I,3) = IDIM
  1193. XPALB(I,1) = XRAID
  1194. XPALB(I,2) = XRAYO
  1195. *
  1196. * normalisation de la normale
  1197. *
  1198. IPNV = (IDIM + 1) * (IPOI - 1)
  1199. IPEX = (IDIM + 1) * (IEXC - 1)
  1200. PS = 0.D0
  1201. DO 210 ID = 1,IDIM
  1202. XC = XCOOR(IPNV + ID)
  1203. PS = PS + XC * XC
  1204. 210 CONTINUE
  1205. *** write (6,*) ' ps ',ps
  1206. * end do
  1207. IF (PS.LE.0.D0) THEN
  1208. CALL ERREUR(162)
  1209. RETURN
  1210. ENDIF
  1211. IF (MONAMO.EQ.'FLOTTANT') THEN
  1212. IPALB(I,1) = 22
  1213. XPALB(I,3) = XAMON
  1214. ID1 = 3
  1215. ELSE
  1216. ID1 = 2
  1217. ENDIF
  1218. ID2 = ID1 + IDIM
  1219. DO 212 ID = 1,IDIM
  1220. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1221. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1222. 212 CONTINUE
  1223. * end do
  1224. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1225. IPLIB(I,1) = IPLAC
  1226. *
  1227. else if(cmatee.eq.'CE_PL_FR') then
  1228. ITYP = 5
  1229. MONAMO = ' '
  1230. do io = 1,n2
  1231. if (nomche(io)(1:4).eq.'NORM') then
  1232. melval = ielval(io)
  1233. segact melval
  1234. IPOI = ielche(1,1)
  1235. else if (nomche(io)(1:4).eq.'RAID') then
  1236. melval = ielval(io)
  1237. segact melval
  1238. xrain = velche(1,1)
  1239. MARAID = 'FLOTTANT'
  1240. else if (nomche(io)(1:4).eq.'JEU') then
  1241. melval = ielval(io)
  1242. segact melval
  1243. XJEU = velche(1,1)
  1244. else if (nomche(io)(1:4).eq.'RAYS') then
  1245. melval = ielval(io)
  1246. segact melval
  1247. XRAYP = velche(1,1)
  1248. else if (nomche(io)(1:4).eq.'GLIS') then
  1249. melval = ielval(io)
  1250. segact melval
  1251. XGLIS = velche(1,1)
  1252. else if (nomche(io)(1:4).eq.'ADHE') then
  1253. melval = ielval(io)
  1254. segact melval
  1255. XADHE = velche(1,1)
  1256. else if (nomche(io)(1:4).eq.'RTAN') then
  1257. melval = ielval(io)
  1258. segact melval
  1259. XRAIT = velche(1,1)
  1260. else if (nomche(io)(1:4).eq.'ATAN') then
  1261. melval = ielval(io)
  1262. segact melval
  1263. XAMOT = velche(1,1)
  1264. else if (nomche(io)(1:4).eq.'AMOR') then
  1265. melval = ielval(io)
  1266. segact melval
  1267. xamon = velche(1,1)
  1268. MONAMO = 'FLOTTANT'
  1269. else
  1270. endif
  1271. enddo
  1272.  
  1273. IPALB(I,1) = ITYP
  1274. IPALB(I,3) = IDIM
  1275. XPALB(I,1) = XRAIN
  1276. XPALB(I,2) = XJEU
  1277. XPALB(I,3) = XGLIS
  1278. XPALB(I,4) = XADHE
  1279. XPALB(I,5) = XRAIT
  1280. XPALB(I,6) = XAMOT
  1281. *
  1282. IPNV = (IDIM + 1) * (IPOI - 1)
  1283. PS = 0.D0
  1284. DO 230 ID = 1,IDIM
  1285. XC = XCOOR(IPNV + ID)
  1286. PS = PS + XC * XC
  1287. 230 CONTINUE
  1288. * end do
  1289. IF (PS.LE.0.D0) THEN
  1290. CALL ERREUR(162)
  1291. RETURN
  1292. ENDIF
  1293. IF (MONAMO.EQ.'FLOTTANT') THEN
  1294. IPALB(I,1) = 6
  1295. XPALB(I,7) = XAMON
  1296. ID1 = 7
  1297. ELSE
  1298. ID1 = 6
  1299. ENDIF
  1300. ID8 = ID1 + 7*IDIM
  1301. XPALB(I,ID8+1) = XRAYP
  1302. DO 232 ID = 1,IDIM
  1303. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1304. 232 CONTINUE
  1305. * end do
  1306. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1307. IPLIB(I,1) = IPLAC
  1308. *
  1309. else if(cmatee.eq.'CE_CE_FR') then
  1310. ITYP = 25
  1311. MONAMO = ' '
  1312. MARAID = ' '
  1313. MONINTER = ' '
  1314. LINTER = .true.
  1315. do io = 1,n2
  1316. if (nomche(io)(1:4).eq.'NORM') then
  1317. melval = ielval(io)
  1318. segact melval
  1319. IPOI = ielche(1,1)
  1320. else if (nomche(io)(1:4).eq.'RAID') then
  1321. melval = ielval(io)
  1322. segact melval
  1323. xrain = velche(1,1)
  1324. MARAID = 'FLOTTANT'
  1325. else if (nomche(io)(1:4).eq.'EXCE') then
  1326. melval = ielval(io)
  1327. segact melval
  1328. IEXC = ielche(1,1)
  1329. else if (nomche(io)(1:4).eq.'RAYS') then
  1330. melval = ielval(io)
  1331. segact melval
  1332. XRAYP = velche(1,1)
  1333. else if (nomche(io)(1:4).eq.'RAYB') then
  1334. melval = ielval(io)
  1335. segact melval
  1336. XRAYB = velche(1,1)
  1337. else if (nomche(io)(1:4).eq.'GLIS') then
  1338. melval = ielval(io)
  1339. segact melval
  1340. XGLIS = velche(1,1)
  1341. else if (nomche(io)(1:4).eq.'ADHE') then
  1342. melval = ielval(io)
  1343. segact melval
  1344. XADHE = velche(1,1)
  1345. else if (nomche(io)(1:4).eq.'RTAN') then
  1346. melval = ielval(io)
  1347. segact melval
  1348. XRAIT = velche(1,1)
  1349. else if (nomche(io)(1:4).eq.'ATAN') then
  1350. melval = ielval(io)
  1351. segact melval
  1352. XAMOT = velche(1,1)
  1353. else if (nomche(io)(1:4).eq.'CINT') then
  1354. melval = ielval(io)
  1355. segact melval
  1356. LINTER = .false.
  1357. else if (nomche(io)(1:4).eq.'AMOR') then
  1358. melval = ielval(io)
  1359. segact melval
  1360. xamon = velche(1,1)
  1361. MONAMO = 'FLOTTANT'
  1362. else
  1363. endif
  1364. enddo
  1365.  
  1366. IF (IERR.NE.0) RETURN
  1367. *
  1368. IPALB(I,1) = ITYP
  1369. IPALB(I,3) = IDIM
  1370. IPALB(I,4) = 1
  1371. IF (.NOT.LINTER) THEN
  1372. IPALB(I,4) = 0
  1373. ENDIF
  1374. XPALB(I,1) = XRAIN
  1375. XPALB(I,2) = XRAYB
  1376. XPALB(I,3) = XGLIS
  1377. XPALB(I,4) = XADHE
  1378. XPALB(I,5) = XRAIT
  1379. XPALB(I,6) = XAMOT
  1380. *
  1381. * normalisation de la normale
  1382. *
  1383. IPNV = (IDIM + 1) * (IPOI - 1)
  1384. IPEX = (IDIM + 1) * (IEXC - 1)
  1385. PS = 0.D0
  1386. DO 330 ID = 1,IDIM
  1387. XC = XCOOR(IPNV + ID)
  1388. PS = PS + XC * XC
  1389. 330 CONTINUE
  1390. * end do
  1391. *** write (6,*) ' ps - 4 ',ps
  1392. IF (PS.LE.0.D0) THEN
  1393. CALL ERREUR(162)
  1394. RETURN
  1395. ENDIF
  1396. IF (MONAMO.EQ.'FLOTTANT') THEN
  1397. ID1 = 7
  1398. IPALB(I,1) = 26
  1399. XPALB(I,7) = XAMON
  1400. ELSE
  1401. ID1 = 6
  1402. ENDIF
  1403. ID10 = ID1 + 9*IDIM
  1404. XPALB(I,ID10+1) = XRAYP
  1405. ID2 = ID1 + IDIM
  1406. ID3 = ID1 + 2*IDIM
  1407. DO 332 ID = 1,IDIM
  1408. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1409. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1410. 332 CONTINUE
  1411. * end do
  1412. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1413. IPLIB(I,1) = IPLAC
  1414. *
  1415. else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then
  1416. if(cmatee.eq.'PR_PR_IN') ityp = 31
  1417. IF(cmatee.eq.'PR_PR_EX') ITYP = 32
  1418.  
  1419. do io = 1,n2
  1420. if (nomche(io)(1:4).eq.'NORM') then
  1421. melval = ielval(io)
  1422. segact melval
  1423. INOR = ielche(1,1)
  1424. else if (nomche(io)(1:4).eq.'RAID') then
  1425. melval = ielval(io)
  1426. segact melval
  1427. xraid = velche(1,1)
  1428. MARAID = 'FLOTTANT'
  1429. else if (nomche(io)(1:4).eq.'PFIX') then
  1430. melval = ielval(io)
  1431. segact melval
  1432. IMA1 = ielche(1,1)
  1433. else if (nomche(io)(1:4).eq.'PMOB') then
  1434. melval = ielval(io)
  1435. segact melval
  1436. IMA2 = ielche(1,1)
  1437. else if (nomche(io)(1:4).eq.'ERAI') then
  1438. melval = ielval(io)
  1439. segact melval
  1440. xpuis = velche(1,1)
  1441. else
  1442. endif
  1443. enddo
  1444. IF (IERR.NE.0) RETURN
  1445. *
  1446. IPALB(I,1) = ITYP
  1447. IPALB(I,3) = IDIM
  1448. XPALB(I,1) = XRAID
  1449. XPALB(I,3) = XPUIS
  1450. ID1 = 3
  1451. IP1 = 5
  1452. *
  1453. * le maillage IMA1 est en element de type POI1
  1454. MELEME = IMA1
  1455. SEGACT MELEME
  1456. NOMBN1 = NUM(/2)
  1457. IPALB(I,4) = NOMBN1
  1458. IDP = ID1 + 5*IDIM
  1459. DO 512 IE = 1,NOMBN1
  1460. IPT = NUM(1,IE)
  1461. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1462. DO 514 ID = 1,IDIM
  1463. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1464. 514 CONTINUE
  1465. * end do
  1466. IDP = IDP + IDIM
  1467. 512 CONTINUE
  1468. * end do
  1469. SEGDES MELEME
  1470. *
  1471. * le maillage IMA2 est en element de type POI1
  1472. MELEME = IMA2
  1473. SEGACT MELEME
  1474. NOMBN2 = NUM(/2)
  1475. IPALB(I,5) = NOMBN2
  1476. DO 516 IE = 1,NOMBN2
  1477. IPT = NUM(1,IE)
  1478. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1479. DO 518 ID = 1,IDIM
  1480. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1481. 518 CONTINUE
  1482. * end do
  1483. IDP = IDP + IDIM
  1484. 516 CONTINUE
  1485. * end do
  1486. SEGDES MELEME
  1487. CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
  1488. IPLIB(I,1) = IPLAC
  1489. *
  1490. * creation d'un rep}re orthonorme dans le plan des maillages
  1491. * le point origine est le premier point de IMA1
  1492. CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
  1493. IF (IERR.NE.0) RETURN
  1494. *
  1495. * coefficient des droites formees par les elements de IMA1
  1496. CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  1497. *
  1498. * position initiale de IMA2 par rapport a IMA1
  1499. CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  1500. *
  1501. * calcul de la section du profil mobile
  1502. CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
  1503. XPALB(I,2) = XSECT
  1504. *
  1505. *
  1506. else if(cmatee.eq.'LI_LI_FR') then
  1507. ITYP = 35
  1508. MONJEU = ' '
  1509. MONAMO = ' '
  1510. MARAID = ' '
  1511. CMOT = ' '
  1512. MONESC = ' '
  1513. MONSYM = ' '
  1514. MONREC = ' '
  1515. INOR = 0
  1516. SEGINI MLIGNE
  1517. do io = 1,n2
  1518. if (nomche(io)(1:4).eq.'NORM') then
  1519. melval = ielval(io)
  1520. segact melval
  1521. INOR = ielche(1,1)
  1522. else if (nomche(io)(1:4).eq.'RAID') then
  1523. melval = ielval(io)
  1524. segact melval
  1525. typret=typche(io)(1:8)
  1526. if (typret.eq.'POINTEUR') then
  1527. IRAIES = ielche(1,1)
  1528. MARAID = 'CHPOINT'
  1529. else
  1530. xraide = velche(1,1)
  1531. MARAID = 'FLOTTANT'
  1532. endif
  1533. else if (nomche(io)(1:4).eq.'LIMA') then
  1534. melval = ielval(io)
  1535. segact melval
  1536. IMAI = ielche(1,1)
  1537. else if (nomche(io)(1:4).eq.'LIES') then
  1538. melval = ielval(io)
  1539. segact melval
  1540. MONESC = typche(io)(9:16)
  1541. IESC = ielche(1,1)
  1542. else if (nomche(io)(1:4).eq.'JEU') then
  1543. melval = ielval(io)
  1544. segact melval
  1545. MONJEU = 'FLOTTANT'
  1546. xjeu = velche(1,1)
  1547. else if (nomche(io)(1:4).eq.'RAYB') then
  1548. melval = ielval(io)
  1549. segact melval
  1550. XRAYB = velche(1,1)
  1551. else if (nomche(io)(1:4).eq.'GLIS') then
  1552. melval = ielval(io)
  1553. segact melval
  1554. XGLIS = velche(1,1)
  1555. else if (nomche(io)(1:4).eq.'ADHE') then
  1556. melval = ielval(io)
  1557. segact melval
  1558. XADHE = velche(1,1)
  1559. else if (nomche(io)(1:4).eq.'RTAN') then
  1560. melval = ielval(io)
  1561. segact melval
  1562. XRAIT = velche(1,1)
  1563. else if (nomche(io)(1:4).eq.'ATAN') then
  1564. melval = ielval(io)
  1565. segact melval
  1566. XAMOT = velche(1,1)
  1567. else if (nomche(io)(1:4).eq.'AMOR') then
  1568. melval = ielval(io)
  1569. segact melval
  1570. typret=typche(io)(1:8)
  1571. if (typret.eq.'POINTEUR') then
  1572. typret=typche(io)(9:16)
  1573. iamoes = ielche(1,1)
  1574. MONAMO = 'CHPOINT'
  1575. else
  1576. XAMO = velche(1,1)
  1577. MONAMO = 'FLOTTANT'
  1578. endif
  1579. else if (nomche(io)(1:4).eq.'SYME') then
  1580. melval = ielval(io)
  1581. segact melval
  1582. isyme = ielche(1,1)
  1583. MONSYM = 'MOT'
  1584. if (isyme.eq.1) CMOT1(1:7)='LOCALE'
  1585. if (isyme.eq.2) CMOT1(1:4)='VRAI'
  1586. if (isyme.eq.3) CMOT1(1:7)='GLOBALE'
  1587. else if (nomche(io)(1:4).eq.'RECH') then
  1588. melval = ielval(io)
  1589. segact melval
  1590. irchec = ielche(1,1)
  1591. MONREC = 'MOT'
  1592. if (irchec.eq.1) CMOT(1:7)= 'GLOBALE'
  1593. else
  1594. endif
  1595. enddo
  1596. * IF (IERR.NE.0) RETURN
  1597. *
  1598. IPALB(I,1) = ITYP
  1599. IPALB(I,3) = IDIM
  1600. XPALB(I,3) = XGLIS
  1601. XPALB(I,4) = XADHE
  1602. XPALB(I,5) = XRAIT
  1603. XPALB(I,6) = XAMOT
  1604. *
  1605. IF (MONAMO.EQ.'CHPOINT') THEN
  1606. IPALB(I,1) = 36
  1607. ID1 = 7
  1608. ELSE
  1609. ID1 = 6
  1610. ENDIF
  1611. * Normale au plan
  1612. IF (IDIM.EQ.3) THEN
  1613. if (inor.eq.0) call erreur(5)
  1614. IPNO = (IDIM + 1) * (INOR - 1)
  1615. PS = 0.D0
  1616. DO 80 ID = 1,IDIM
  1617. XC = XCOOR(IPNO + ID)
  1618. PS = PS + XC * XC
  1619. 80 CONTINUE
  1620. * end do
  1621. IF (PS.LE.0.D0) THEN
  1622. CALL ERREUR(162)
  1623. RETURN
  1624. ENDIF
  1625. DO 81 ID=1,IDIM
  1626. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1627. 81 CONTINUE
  1628. ELSE
  1629. DO 82 ID=1,IDIM
  1630. XPALB(I,ID1+ID) = 0.D0
  1631. 82 CONTINUE
  1632. ENDIF
  1633. IF (MONJEU.EQ.'FLOTTANT') THEN
  1634. XPALB(I,2) = XJEU
  1635. ELSE
  1636. XPALB(I,2) = 0.D0
  1637. ENDIF
  1638. * La recherche s'effectue par defaut localement
  1639. IF (MONREC.EQ.'MOT') THEN
  1640. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1641. IPALB(I,23) = 1
  1642. ELSE
  1643. IPALB(I,23) = 0
  1644. ENDIF
  1645. ELSE
  1646. IPALB(I,23) = 0
  1647. ENDIF
  1648. * Coordonnees du maillage_maitre
  1649. MELEME = IMAI
  1650. SEGACT MELEME
  1651. * Pour savoir si le contour est ferme
  1652. NELEMA = NUM(/2)
  1653. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1654. NNOEMA = NELEMA
  1655. IFERMA = 1
  1656. ELSE
  1657. NNOEMA = NELEMA +1
  1658. IFERMA = 0
  1659. ENDIF
  1660. IPALB(I,21) = NNOEMA
  1661. IPALB(I,24) = IFERMA
  1662. ID2 = ID1 + 4*IDIM
  1663. IPT = NUM(1,1)
  1664. INPT = (IDIM+1)*(IPT-1)
  1665. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1666. IPLIB(I,1) = IPLAC
  1667. KPLIB(1) = IPT
  1668. DO 84 ID=1,IDIM
  1669. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1670. 84 CONTINUE
  1671. DO 85 IE=1,(NNOEMA-1)
  1672. IPT = NUM(2,IE)
  1673. INPT = (IDIM+1)*(IPT-1)
  1674. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1675. IPLIB(I,IE+1) = IPLAC
  1676. KPLIB(IE+1) = IPT
  1677. IDIE = ID2 + IE*IDIM
  1678. DO 86 ID=1,IDIM
  1679. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1680. 86 CONTINUE
  1681. 85 CONTINUE
  1682. SEGDES MELEME
  1683. * Maillage_esclave
  1684. ID3 = ID2 + NNOEMA*IDIM
  1685. IF (MONESC.EQ.'POINT') THEN
  1686. * La ligne esclave est un point
  1687. NNOEES=1
  1688. IFERES=0
  1689. ISYMET=-1
  1690. * Lecture des coordonnees
  1691. IPESC = (IDIM+1)*(IESC-1)
  1692. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1693. IPLIB(I,NNOEMA+1) = IPLAC
  1694. KPLIB(NNOEMA+1) = IESC
  1695. DO 90 ID = 1,IDIM
  1696. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1697. 90 CONTINUE
  1698. *
  1699. IPALB(I,22) = NNOEES
  1700. IPALB(I,25) = IFERES
  1701. IPALB(I,26) = ISYMET
  1702. ELSE
  1703. IF (MONESC.EQ.'MAILLAGE') THEN
  1704. * La ligne esclave est un maillage
  1705. MELEME = IESC
  1706. SEGACT MELEME
  1707. * Pour savoir si le contour est ferme
  1708. NELEES = NUM(/2)
  1709. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1710. NNOEES = NELEES
  1711. IFERES = 1
  1712. ELSE
  1713. NNOEES = NELEES +1
  1714. IFERES = 0
  1715. ENDIF
  1716. IPALB(I,22) = NNOEES
  1717. IPALB(I,25) = IFERES
  1718. * Coordonnees du maillage_esclave
  1719. IPT = NUM(1,1)
  1720. INPT = (IDIM+1)*(IPT-1)
  1721. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1722. IPLIB(I,NNOEMA+1) = IPLAC
  1723. KPLIB(NNOEMA+1) = IPT
  1724. DO 94 ID=1,IDIM
  1725. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1726. 94 CONTINUE
  1727. DO 95 IE=1,(NNOEES-1)
  1728. IPT = NUM(2,IE)
  1729. INPT = (IDIM+1)*(IPT-1)
  1730. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1731. IPLIB(I,NNOEMA+IE+1) = IPLAC
  1732. KPLIB(NNOEMA+IE+1) = IPT
  1733. IDIE = ID3 + IE*IDIM
  1734. DO 96 ID=1,IDIM
  1735. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1736. 96 CONTINUE
  1737. 95 CONTINUE
  1738. SEGDES MELEME
  1739. * Le traitement symetrique par defaut ne s'effectue pas
  1740. IF (MONSYM.EQ.'MOT') THEN
  1741. IF (CMOT1(1:7).EQ.'LOCALE') THEN
  1742. IPALB(I,26) = 1
  1743. ELSE
  1744. IF (CMOT1(1:4).EQ.'VRAI'.OR.
  1745. & CMOT1(1:7).EQ.'GLOBALE') THEN
  1746. IPALB(I,26) = 0
  1747. ELSE
  1748. IPALB(I,26) = -1
  1749. ENDIF
  1750. ENDIF
  1751. ELSE
  1752. IPALB(I,26) = -1
  1753. ENDIF
  1754. ELSE
  1755. * La ligne esclave n'est ni un point ni un maillage
  1756. * CALL ERREUR(...)
  1757. RETURN
  1758. ENDIF
  1759. ENDIF
  1760. * Lecture des chpoints de raideur et d amortissement
  1761. * Raideurs des noeuds esclaves et maitres
  1762. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1763. MCHPOI=IRAIES
  1764. SEGACT,MCHPOI
  1765. NSOUP=IPCHP(/1)
  1766. DO 700 IPC=1,NSOUP
  1767. MSOUPO=IPCHP(IPC)
  1768. SEGACT,MSOUPO
  1769. MELEME = IGEOC
  1770. SEGACT,MELEME
  1771. MPOVAL = IPOVAL
  1772. SEGACT,MPOVAL
  1773. NNN = NUM(/2)
  1774. DO 711 INN=1,NNN
  1775. IPT = NUM(1,INN)
  1776. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1777. IF (IPLAC.NE.0) THEN
  1778. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1779. ENDIF
  1780. 711 CONTINUE
  1781. SEGDES,MPOVAL,MELEME
  1782. SEGDES MSOUPO
  1783. 700 CONTINUE
  1784. SEGDES,MCHPOI
  1785. * Amortissement des noeuds esclaves et maitres
  1786. ID5=ID4+NNOEMA+NNOEES
  1787. IF (IPALB(I,1).EQ.36) THEN
  1788. MCHPOI=IAMOES
  1789. SEGACT,MCHPOI
  1790. NSOUP = IPCHP(/1)
  1791. DO 121 IPC=1,NSOUP
  1792. MSOUPO=IPCHP(IPC)
  1793. SEGACT,MSOUPO
  1794. MELEME = IGEOC
  1795. SEGACT,MELEME
  1796. MPOVAL = IPOVAL
  1797. SEGACT,MPOVAL
  1798. NNN=NUM(/2)
  1799. DO 130 INN=1,NNN
  1800. IPT = NUM(1,INN)
  1801. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1802. IF (IPLAC.NE.0) THEN
  1803. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1804. ENDIF
  1805. 130 CONTINUE
  1806. SEGDES MPOVAL,MELEME
  1807. SEGDES MSOUPO
  1808. 121 CONTINUE
  1809. SEGDES MCHPOI
  1810. ENDIF
  1811. SEGSUP MLIGNE
  1812.  
  1813. else if(cmatee.eq.'LI_CE_FR') then
  1814.  
  1815.  
  1816. else if(cmatee.eq.'PA_FL_RO') then
  1817. ITYP = 60
  1818. MONMOT='RODELI'
  1819. MTLIAB = KTLIAB
  1820. *
  1821. NUML = I
  1822. IP1 = imod
  1823. IF (IERR.NE.0) RETURN
  1824. CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  1825. IPLIB(NUML,1) = IPLAC
  1826. *
  1827. * Valeurs de IPALB et XPALB communes a tous les types de
  1828. * paliers fluides :
  1829. *
  1830. IPALB(NUML,1) = ITYP
  1831. IPALB(NUML,2) = 0
  1832. IPALB(NUML,3) = 3
  1833. IPALB(NUML,4) = 0
  1834. *
  1835. do io = 1,n2
  1836. if (nomche(io)(1:4).eq.'VISC') then
  1837. melval = ielval(io)
  1838. segact melval
  1839. X1 = velche(1,1)
  1840. XPALB(NUML,1) = X1
  1841. else if (nomche(io)(1:4).eq.'RHOF') then
  1842. melval = ielval(io)
  1843. segact melval
  1844. X1 = velche(1,1)
  1845. XPALB(NUML,2) = X1
  1846. else if (nomche(io)(1:4).eq.'PADM') then
  1847. melval = ielval(io)
  1848. segact melval
  1849. X1 = velche(1,1)
  1850. XPALB(NUML,3) = X1
  1851. else if (nomche(io)(1:4).eq.'LONG') then
  1852. melval = ielval(io)
  1853. segact melval
  1854. X1 = velche(1,1)
  1855. XPALB(NUML,4) = X1
  1856. else if (nomche(io)(1:4).eq.'AFFI') then
  1857. melval = ielval(io)
  1858. segact melval
  1859. X1 = velche(1,1)
  1860. XPALB(NUML,5) = X1
  1861. else if (nomche(io)(1:4).eq.'RAYO') then
  1862. melval = ielval(io)
  1863. segact melval
  1864. X1 = velche(1,1)
  1865. XPALB(NUML,6) = X1
  1866. else if (nomche(io)(1:4).eq.'VROT') then
  1867. melval = ielval(io)
  1868. segact melval
  1869. X1 = velche(1,1)
  1870. XPALB(NUML,7) = X1
  1871. else if (nomche(io)(1:4).eq.'EPSI') then
  1872. melval = ielval(io)
  1873. segact melval
  1874. X1 = velche(1,1)
  1875. XPALB(NUML,8) = X1
  1876. else if (nomche(io)(1:4).eq.'PHII') then
  1877. melval = ielval(io)
  1878. segact melval
  1879. X1 = velche(1,1)
  1880. XPALB(NUML,9) = X1
  1881. else if (nomche(io)(1:4).eq.'TLOB') then
  1882. melval = ielval(io)
  1883. segact melval
  1884. itgeom = ielche(1,1)
  1885. else
  1886. endif
  1887. enddo
  1888. *
  1889. IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN
  1890. * ----- Cas du palier cylindrique ou a lobes, avec modele de Rhode et Li
  1891. *
  1892. IPALB(NUML,5) = 1
  1893. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  1894. & 'ENTIER',NLOB,X1,' ',L1,IP1)
  1895.  
  1896. IF (IERR.NE.0) RETURN
  1897. IPALB(NUML,6) = NLOB
  1898.  
  1899. C Nombre de parametres reels :
  1900. NBPR = 6
  1901. IPALB(NUML,7) = NBPR
  1902.  
  1903. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  1904. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1905. XPALB(NUML,10) = X1
  1906.  
  1907. IF (IERR.NE.0) RETURN
  1908. DO 610 ILOB = 1, NLOB
  1909. *
  1910. CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0,
  1911. & 'TABLE',I1,X1,' ',L1,ITLOB)
  1912.  
  1913. IF (IERR.NE.0) RETURN
  1914. CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  1915. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1916. XPALB(NUML,11+NBPR*(ILOB-1)) = X1
  1917.  
  1918. IF (IERR.NE.0) RETURN
  1919. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  1920. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1921. XPALB(NUML,12+NBPR*(ILOB-1)) = X1
  1922.  
  1923. IF (IERR.NE.0) RETURN
  1924. CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  1925. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1926. XPALB(NUML,13+NBPR*(ILOB-1)) = X1
  1927.  
  1928. IF (IERR.NE.0) RETURN
  1929. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  1930. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1931. XPALB(NUML,14+NBPR*(ILOB-1)) = X1
  1932. ANGDEB = X1
  1933.  
  1934. IF (IERR.NE.0) RETURN
  1935. CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  1936. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1937. XPALB(NUML,15+NBPR*(ILOB-1)) = X1
  1938. AMPLIT=X1
  1939.  
  1940. IF (IERR.NE.0) RETURN
  1941. CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  1942. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1943. XPALB(NUML,16+NBPR*(ILOB-1)) = X1
  1944.  
  1945. IF (IERR.NE.0) RETURN
  1946. CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  1947. & 'ENTIER',I1,X1,' ',L1,IP1)
  1948. cbp2018 IPALB(NUML,7+ILOB) = I1
  1949. NMAIL=I1
  1950. CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL)
  1951. IPALB(NUML,7+ILOB) = KLREEL
  1952.  
  1953. IF (IERR.NE.0) RETURN
  1954. 610 CONTINUE
  1955. ENDIF
  1956. *
  1957. else
  1958. write(6,*) 'verifier nom liaison', cmatee
  1959. call erreur(5)
  1960. return
  1961. endif
  1962. enddo
  1963. *
  1964. * traiter liaisons conditionnelles
  1965. *
  1966. DO I = 1,kmodel(/1)
  1967. ksi = 0
  1968. imodel = kmodel(I)
  1969. segact imodel
  1970. if (tymode(/2).gt.0) then
  1971. do 722 ilc = 1,tymode(/2)
  1972. do j =1,kmodel(/1)
  1973. if (kmodel(j).eq.ivamod(ilc)) then
  1974. ksi = ksi + 1
  1975. ipalb(i,4) = 1
  1976. IF (tymode(ilc).EQ.'CONDINFE' ) THEN
  1977. ipalb (i,4+ksi) = j
  1978. ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN
  1979. ipalb (i,4+ksi) = -1 * j
  1980. ENDIF
  1981. endif
  1982. goto 722
  1983. enddo
  1984. 722 continue
  1985. endif
  1986. 723 continue
  1987. ENDDO
  1988.  
  1989. * ranger
  1990. do I = 1, kmodel(/1)
  1991. imodel = kmodel(I)
  1992. ipt8 = imamod
  1993. segdes imodel,ipt8
  1994. enddo
  1995. do in = 1,n1
  1996. meleme = imache(in)
  1997. mchaml = ichaml(in)
  1998. segact mchaml
  1999. n2 = ielval(/1)
  2000. do io = 1,n2
  2001. melval = ielval(io)
  2002. segdes melval
  2003. enddo
  2004. segdes meleme,mchaml
  2005. enddo
  2006. segdes mchelm
  2007.  
  2008.  
  2009. ***** eventuel message ****
  2010.  
  2011. IF (IIMPI.EQ.333) THEN
  2012. NLIAB = IPALB(/1)
  2013. NIPALB = IPALB(/2)
  2014. NXPALB = XPALB(/2)
  2015. NPLBB = IPLIB(/2)
  2016. NPLB = JPLIB(/1)
  2017. DO 1000 IN = 1,NLIAB
  2018. DO 1002 II = 1,NIPALB
  2019. WRITE(IOIMP,*)'DYNE70 : IPALB(',IN,',',II,') =',IPALB(IN,II)
  2020. 1002 CONTINUE
  2021. DO 1004 IX = 1,NXPALB
  2022. WRITE(IOIMP,*)'DYNE70 : XPALB(',IN,',',IX,') =',XPALB(IN,IX)
  2023. 1004 CONTINUE
  2024. DO 1006 IP = 1,NPLBB
  2025. WRITE(IOIMP,*)'DYNE70 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP)
  2026. 1006 CONTINUE
  2027. 1000 CONTINUE
  2028. DO 1008 IP = 1,NPLB
  2029. WRITE(IOIMP,*)'DYNE70 : JPLIB(',IP,') =',JPLIB(IP)
  2030. 1008 CONTINUE
  2031. ENDIF
  2032.  
  2033. *
  2034. RETURN
  2035. END
  2036.  
  2037.  
  2038.  
  2039.  
  2040.  
  2041.  
  2042.  
  2043.  
  2044.  
  2045.  
  2046.  
  2047.  
  2048.  
  2049.  
  2050.  
  2051.  
  2052.  
  2053.  
  2054.  

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