Télécharger dyne70.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE70 SOURCE BP208322 19/02/25 21:16:00 10120
  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. cbp IPALB(I,4) = 1
  1018. IF (.NOT.LINTER) THEN
  1019. cbp IPALB(I,4) = 0
  1020. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1021. ITYP=ITYP+100
  1022. IPALB(I,1) = ITYP
  1023. ENDIF
  1024. XPALB(I,1) = XRAIN
  1025. XPALB(I,2) = XRAYO
  1026. XPALB(I,3) = XGLIS
  1027. XPALB(I,4) = XADHE
  1028. XPALB(I,5) = XRAIT
  1029. XPALB(I,6) = XAMOT
  1030. *
  1031. * normalisation de la normale
  1032. *
  1033. IPNV = (IDIM + 1) * (IPOI - 1)
  1034. IPNOA = (IDIM + 1) * (INOA - 1)
  1035. IPNOB = (IDIM + 1) * (INOB - 1)
  1036. PS = 0.D0
  1037. DO 202 ID = 1,IDIM
  1038. XC = XCOOR(IPNV + ID)
  1039. PS = PS + XC * XC
  1040. 202 CONTINUE
  1041. *** write (6,*) ' ps - 3 ',ps
  1042. IF (PS.LE.0.D0) THEN
  1043. CALL ERREUR(162)
  1044. RETURN
  1045. ENDIF
  1046. IF (MONAMO.EQ.'FLOTTANT') THEN
  1047. cbp IPALB(I,1) = 34
  1048. ITYP=ITYP+1
  1049. IPALB(I,1) = ITYP
  1050. XPALB(I,7) = XAMON
  1051. ID1 = 7
  1052. ELSE
  1053. ID1 = 6
  1054. ENDIF
  1055. ID2 = ID1 + IDIM
  1056. DO 222 ID = 1,IDIM
  1057. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1058. XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  1059. 222 CONTINUE
  1060. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  1061. IPLIB(I,1) = IPLAC
  1062. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  1063. IPLIB(I,2) = IPLAC
  1064. *
  1065. else if(cmatee.eq.'PO_CE_FR') then
  1066. ITYP = 23
  1067. MONAMO = ' '
  1068. MARAID = ' '
  1069. MONINTER = ' '
  1070. LINTER = .true.
  1071. do io = 1,n2
  1072. if (nomche(io)(1:4).eq.'NORM') then
  1073. melval = ielval(io)
  1074. segact melval
  1075. IPOI = ielche(1,1)
  1076. elseif (nomche(io)(1:4).eq.'EXCE') then
  1077. melval = ielval(io)
  1078. segact melval
  1079. IEXC = ielche(1,1)
  1080. else if (nomche(io)(1:4).eq.'RAID') then
  1081. melval = ielval(io)
  1082. segact melval
  1083. xrain = velche(1,1)
  1084. MARAID = 'FLOTTANT'
  1085. else if (nomche(io)(1:4).eq.'RAYO') then
  1086. melval = ielval(io)
  1087. segact melval
  1088. XRAYO = velche(1,1)
  1089. else if (nomche(io)(1:4).eq.'GLIS') then
  1090. melval = ielval(io)
  1091. segact melval
  1092. XGLIS = velche(1,1)
  1093. else if (nomche(io)(1:4).eq.'ADHE') then
  1094. melval = ielval(io)
  1095. segact melval
  1096. XADHE = velche(1,1)
  1097. else if (nomche(io)(1:4).eq.'RTAN') then
  1098. melval = ielval(io)
  1099. segact melval
  1100. XRAIT = velche(1,1)
  1101. else if (nomche(io)(1:4).eq.'ATAN') then
  1102. melval = ielval(io)
  1103. segact melval
  1104. XAMOT = velche(1,1)
  1105. else if (nomche(io)(1:4).eq.'CINT') then
  1106. melval = ielval(io)
  1107. segact melval
  1108. LINTER = .false.
  1109. else if (nomche(io)(1:4).eq.'AMOR') then
  1110. melval = ielval(io)
  1111. segact melval
  1112. xamon = velche(1,1)
  1113. MONAMO = 'FLOTTANT'
  1114. else
  1115. endif
  1116. enddo
  1117. IF (IERR.NE.0) RETURN
  1118. *
  1119. IPALB(I,1) = ITYP
  1120. IPALB(I,3) = IDIM
  1121. cbp IPALB(I,4) = 1
  1122. IF (.NOT.LINTER) THEN
  1123. cbp IPALB(I,4) = 0
  1124. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1125. ITYP=ITYP+100
  1126. IPALB(I,1) = ITYP
  1127. ENDIF
  1128. XPALB(I,1) = XRAIN
  1129. XPALB(I,2) = XRAYO
  1130. XPALB(I,3) = XGLIS
  1131. XPALB(I,4) = XADHE
  1132. XPALB(I,5) = XRAIT
  1133. XPALB(I,6) = XAMOT
  1134. *
  1135. * normalisation de la normale
  1136. *
  1137. IPNV = (IDIM + 1) * (IPOI - 1)
  1138. IPEX = (IDIM + 1) * (IEXC - 1)
  1139. PS = 0.D0
  1140. DO 320 ID = 1,IDIM
  1141. XC = XCOOR(IPNV + ID)
  1142. PS = PS + XC * XC
  1143. 320 CONTINUE
  1144. *** write (6,*) ' ps - 2 ',ps
  1145. * end do
  1146. IF (PS.LE.0.D0) THEN
  1147. CALL ERREUR(162)
  1148. RETURN
  1149. ENDIF
  1150. IF (MONAMO.EQ.'FLOTTANT') THEN
  1151. cbp IPALB(I,1) = 24
  1152. ITYP=ITYP+1
  1153. IPALB(I,1) = ITYP
  1154. XPALB(I,7) = XAMON
  1155. ID1 = 7
  1156. ELSE
  1157. ID1 = 6
  1158. ENDIF
  1159. ID2 = ID1 + IDIM
  1160. DO 322 ID = 1,IDIM
  1161. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1162. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1163. 322 CONTINUE
  1164. * end do
  1165. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1166. IPLIB(I,1) = IPLAC
  1167. *
  1168. else if(cmatee.eq.'PO_CE') then
  1169. ITYP = 21
  1170. MARAID = ' '
  1171. MONPER = ' '
  1172. MONAMO = ' '
  1173. TYPRET = ' '
  1174. do io = 1,n2
  1175. if (nomche(io)(1:4).eq.'NORM') then
  1176. melval = ielval(io)
  1177. segact melval
  1178. IPOI = ielche(1,1)
  1179. else if (nomche(io)(1:4).eq.'RAID') then
  1180. melval = ielval(io)
  1181. segact melval
  1182. xraid = velche(1,1)
  1183. else if (nomche(io)(1:4).eq.'EXCE') then
  1184. melval = ielval(io)
  1185. segact melval
  1186. IEXC = ielche(1,1)
  1187. else if (nomche(io)(1:4).eq.'RAYO') then
  1188. melval = ielval(io)
  1189. segact melval
  1190. xrayo = velche(1,1)
  1191. else if (nomche(io)(1:4).eq.'AMOR') then
  1192. melval = ielval(io)
  1193. segact melval
  1194. xamon = velche(1,1)
  1195. MONAMO='FLOTTANT'
  1196. else
  1197. endif
  1198. enddo
  1199.  
  1200. IF (IERR.NE.0) RETURN
  1201. IPALB(I,1) = ITYP
  1202. IPALB(I,3) = IDIM
  1203. XPALB(I,1) = XRAID
  1204. XPALB(I,2) = XRAYO
  1205. *
  1206. * normalisation de la normale
  1207. *
  1208. IPNV = (IDIM + 1) * (IPOI - 1)
  1209. IPEX = (IDIM + 1) * (IEXC - 1)
  1210. PS = 0.D0
  1211. DO 210 ID = 1,IDIM
  1212. XC = XCOOR(IPNV + ID)
  1213. PS = PS + XC * XC
  1214. 210 CONTINUE
  1215. *** write (6,*) ' ps ',ps
  1216. * end do
  1217. IF (PS.LE.0.D0) THEN
  1218. CALL ERREUR(162)
  1219. RETURN
  1220. ENDIF
  1221. IF (MONAMO.EQ.'FLOTTANT') THEN
  1222. IPALB(I,1) = 22
  1223. XPALB(I,3) = XAMON
  1224. ID1 = 3
  1225. ELSE
  1226. ID1 = 2
  1227. ENDIF
  1228. ID2 = ID1 + IDIM
  1229. DO 212 ID = 1,IDIM
  1230. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1231. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1232. 212 CONTINUE
  1233. * end do
  1234. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1235. IPLIB(I,1) = IPLAC
  1236. *
  1237. else if(cmatee.eq.'CE_PL_FR') then
  1238. ITYP = 5
  1239. MONAMO = ' '
  1240. do io = 1,n2
  1241. if (nomche(io)(1:4).eq.'NORM') then
  1242. melval = ielval(io)
  1243. segact melval
  1244. IPOI = ielche(1,1)
  1245. else if (nomche(io)(1:4).eq.'RAID') then
  1246. melval = ielval(io)
  1247. segact melval
  1248. xrain = velche(1,1)
  1249. MARAID = 'FLOTTANT'
  1250. else if (nomche(io)(1:4).eq.'JEU') then
  1251. melval = ielval(io)
  1252. segact melval
  1253. XJEU = velche(1,1)
  1254. else if (nomche(io)(1:4).eq.'RAYS') then
  1255. melval = ielval(io)
  1256. segact melval
  1257. XRAYP = velche(1,1)
  1258. else if (nomche(io)(1:4).eq.'GLIS') then
  1259. melval = ielval(io)
  1260. segact melval
  1261. XGLIS = velche(1,1)
  1262. else if (nomche(io)(1:4).eq.'ADHE') then
  1263. melval = ielval(io)
  1264. segact melval
  1265. XADHE = velche(1,1)
  1266. else if (nomche(io)(1:4).eq.'RTAN') then
  1267. melval = ielval(io)
  1268. segact melval
  1269. XRAIT = velche(1,1)
  1270. else if (nomche(io)(1:4).eq.'ATAN') then
  1271. melval = ielval(io)
  1272. segact melval
  1273. XAMOT = velche(1,1)
  1274. else if (nomche(io)(1:4).eq.'AMOR') then
  1275. melval = ielval(io)
  1276. segact melval
  1277. xamon = velche(1,1)
  1278. MONAMO = 'FLOTTANT'
  1279. else
  1280. endif
  1281. enddo
  1282.  
  1283. IPALB(I,1) = ITYP
  1284. IPALB(I,3) = IDIM
  1285. XPALB(I,1) = XRAIN
  1286. XPALB(I,2) = XJEU
  1287. XPALB(I,3) = XGLIS
  1288. XPALB(I,4) = XADHE
  1289. XPALB(I,5) = XRAIT
  1290. XPALB(I,6) = XAMOT
  1291. *
  1292. IPNV = (IDIM + 1) * (IPOI - 1)
  1293. PS = 0.D0
  1294. DO 230 ID = 1,IDIM
  1295. XC = XCOOR(IPNV + ID)
  1296. PS = PS + XC * XC
  1297. 230 CONTINUE
  1298. * end do
  1299. IF (PS.LE.0.D0) THEN
  1300. CALL ERREUR(162)
  1301. RETURN
  1302. ENDIF
  1303. IF (MONAMO.EQ.'FLOTTANT') THEN
  1304. IPALB(I,1) = 6
  1305. XPALB(I,7) = XAMON
  1306. ID1 = 7
  1307. ELSE
  1308. ID1 = 6
  1309. ENDIF
  1310. ID8 = ID1 + 7*IDIM
  1311. XPALB(I,ID8+1) = XRAYP
  1312. DO 232 ID = 1,IDIM
  1313. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1314. 232 CONTINUE
  1315. * end do
  1316. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1317. IPLIB(I,1) = IPLAC
  1318. *
  1319. else if(cmatee.eq.'CE_CE_FR') then
  1320. ITYP = 25
  1321. MONAMO = ' '
  1322. MARAID = ' '
  1323. MONINTER = ' '
  1324. LINTER = .true.
  1325. do io = 1,n2
  1326. if (nomche(io)(1:4).eq.'NORM') then
  1327. melval = ielval(io)
  1328. segact melval
  1329. IPOI = ielche(1,1)
  1330. else if (nomche(io)(1:4).eq.'RAID') then
  1331. melval = ielval(io)
  1332. segact melval
  1333. xrain = velche(1,1)
  1334. MARAID = 'FLOTTANT'
  1335. else if (nomche(io)(1:4).eq.'EXCE') then
  1336. melval = ielval(io)
  1337. segact melval
  1338. IEXC = ielche(1,1)
  1339. else if (nomche(io)(1:4).eq.'RAYS') then
  1340. melval = ielval(io)
  1341. segact melval
  1342. XRAYP = velche(1,1)
  1343. else if (nomche(io)(1:4).eq.'RAYB') then
  1344. melval = ielval(io)
  1345. segact melval
  1346. XRAYB = velche(1,1)
  1347. else if (nomche(io)(1:4).eq.'GLIS') then
  1348. melval = ielval(io)
  1349. segact melval
  1350. XGLIS = velche(1,1)
  1351. else if (nomche(io)(1:4).eq.'ADHE') then
  1352. melval = ielval(io)
  1353. segact melval
  1354. XADHE = velche(1,1)
  1355. else if (nomche(io)(1:4).eq.'RTAN') then
  1356. melval = ielval(io)
  1357. segact melval
  1358. XRAIT = velche(1,1)
  1359. else if (nomche(io)(1:4).eq.'ATAN') then
  1360. melval = ielval(io)
  1361. segact melval
  1362. XAMOT = velche(1,1)
  1363. else if (nomche(io)(1:4).eq.'CINT') then
  1364. melval = ielval(io)
  1365. segact melval
  1366. LINTER = .false.
  1367. else if (nomche(io)(1:4).eq.'AMOR') then
  1368. melval = ielval(io)
  1369. segact melval
  1370. xamon = velche(1,1)
  1371. MONAMO = 'FLOTTANT'
  1372. else
  1373. endif
  1374. enddo
  1375.  
  1376. IF (IERR.NE.0) RETURN
  1377. *
  1378. IPALB(I,1) = ITYP
  1379. IPALB(I,3) = IDIM
  1380. cbp IPALB(I,4) = 1
  1381. IF (.NOT.LINTER) THEN
  1382. cbp IPALB(I,4) = 0
  1383. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1384. ITYP=ITYP+100
  1385. IPALB(I,1) = ITYP
  1386. ENDIF
  1387. XPALB(I,1) = XRAIN
  1388. XPALB(I,2) = XRAYB
  1389. XPALB(I,3) = XGLIS
  1390. XPALB(I,4) = XADHE
  1391. XPALB(I,5) = XRAIT
  1392. XPALB(I,6) = XAMOT
  1393. *
  1394. * normalisation de la normale
  1395. *
  1396. IPNV = (IDIM + 1) * (IPOI - 1)
  1397. IPEX = (IDIM + 1) * (IEXC - 1)
  1398. PS = 0.D0
  1399. DO 330 ID = 1,IDIM
  1400. XC = XCOOR(IPNV + ID)
  1401. PS = PS + XC * XC
  1402. 330 CONTINUE
  1403. * end do
  1404. *** write (6,*) ' ps - 4 ',ps
  1405. IF (PS.LE.0.D0) THEN
  1406. CALL ERREUR(162)
  1407. RETURN
  1408. ENDIF
  1409. IF (MONAMO.EQ.'FLOTTANT') THEN
  1410. ID1 = 7
  1411. cbp IPALB(I,1) = 26
  1412. ITYP=ITYP+1
  1413. IPALB(I,1) = ITYP
  1414. XPALB(I,7) = XAMON
  1415. ELSE
  1416. ID1 = 6
  1417. ENDIF
  1418. ID10 = ID1 + 9*IDIM
  1419. XPALB(I,ID10+1) = XRAYP
  1420. ID2 = ID1 + IDIM
  1421. ID3 = ID1 + 2*IDIM
  1422. DO 332 ID = 1,IDIM
  1423. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1424. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1425. 332 CONTINUE
  1426. * end do
  1427. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1428. IPLIB(I,1) = IPLAC
  1429. *
  1430. else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then
  1431. if(cmatee.eq.'PR_PR_IN') ityp = 31
  1432. IF(cmatee.eq.'PR_PR_EX') ITYP = 32
  1433.  
  1434. do io = 1,n2
  1435. if (nomche(io)(1:4).eq.'NORM') then
  1436. melval = ielval(io)
  1437. segact melval
  1438. INOR = ielche(1,1)
  1439. else if (nomche(io)(1:4).eq.'RAID') then
  1440. melval = ielval(io)
  1441. segact melval
  1442. xraid = velche(1,1)
  1443. MARAID = 'FLOTTANT'
  1444. else if (nomche(io)(1:4).eq.'PFIX') then
  1445. melval = ielval(io)
  1446. segact melval
  1447. IMA1 = ielche(1,1)
  1448. else if (nomche(io)(1:4).eq.'PMOB') then
  1449. melval = ielval(io)
  1450. segact melval
  1451. IMA2 = ielche(1,1)
  1452. else if (nomche(io)(1:4).eq.'ERAI') then
  1453. melval = ielval(io)
  1454. segact melval
  1455. xpuis = velche(1,1)
  1456. else
  1457. endif
  1458. enddo
  1459. IF (IERR.NE.0) RETURN
  1460. *
  1461. IPALB(I,1) = ITYP
  1462. IPALB(I,3) = IDIM
  1463. XPALB(I,1) = XRAID
  1464. XPALB(I,3) = XPUIS
  1465. ID1 = 3
  1466. IP1 = 5
  1467. *
  1468. * le maillage IMA1 est en element de type POI1
  1469. MELEME = IMA1
  1470. SEGACT MELEME
  1471. NOMBN1 = NUM(/2)
  1472. IPALB(I,4) = NOMBN1
  1473. IDP = ID1 + 5*IDIM
  1474. DO 512 IE = 1,NOMBN1
  1475. IPT = NUM(1,IE)
  1476. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1477. DO 514 ID = 1,IDIM
  1478. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1479. 514 CONTINUE
  1480. * end do
  1481. IDP = IDP + IDIM
  1482. 512 CONTINUE
  1483. * end do
  1484. SEGDES MELEME
  1485. *
  1486. * le maillage IMA2 est en element de type POI1
  1487. MELEME = IMA2
  1488. SEGACT MELEME
  1489. NOMBN2 = NUM(/2)
  1490. IPALB(I,5) = NOMBN2
  1491. DO 516 IE = 1,NOMBN2
  1492. IPT = NUM(1,IE)
  1493. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1494. DO 518 ID = 1,IDIM
  1495. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1496. 518 CONTINUE
  1497. * end do
  1498. IDP = IDP + IDIM
  1499. 516 CONTINUE
  1500. * end do
  1501. SEGDES MELEME
  1502. CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
  1503. IPLIB(I,1) = IPLAC
  1504. *
  1505. * creation d'un rep}re orthonorme dans le plan des maillages
  1506. * le point origine est le premier point de IMA1
  1507. CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
  1508. IF (IERR.NE.0) RETURN
  1509. *
  1510. * coefficient des droites formees par les elements de IMA1
  1511. CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  1512. *
  1513. * position initiale de IMA2 par rapport a IMA1
  1514. CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  1515. *
  1516. * calcul de la section du profil mobile
  1517. CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
  1518. XPALB(I,2) = XSECT
  1519. *
  1520. *
  1521. else if(cmatee.eq.'LI_LI_FR') then
  1522. ITYP = 35
  1523. MONJEU = ' '
  1524. MONAMO = ' '
  1525. MARAID = ' '
  1526. CMOT = ' '
  1527. MONESC = ' '
  1528. MONSYM = ' '
  1529. MONREC = ' '
  1530. INOR = 0
  1531. SEGINI MLIGNE
  1532. do io = 1,n2
  1533. if (nomche(io)(1:4).eq.'NORM') then
  1534. melval = ielval(io)
  1535. segact melval
  1536. INOR = ielche(1,1)
  1537. else if (nomche(io)(1:4).eq.'RAID') then
  1538. melval = ielval(io)
  1539. segact melval
  1540. typret=typche(io)(1:8)
  1541. if (typret.eq.'POINTEUR') then
  1542. IRAIES = ielche(1,1)
  1543. MARAID = 'CHPOINT'
  1544. else
  1545. xraide = velche(1,1)
  1546. MARAID = 'FLOTTANT'
  1547. endif
  1548. else if (nomche(io)(1:4).eq.'LIMA') then
  1549. melval = ielval(io)
  1550. segact melval
  1551. IMAI = ielche(1,1)
  1552. else if (nomche(io)(1:4).eq.'LIES') then
  1553. melval = ielval(io)
  1554. segact melval
  1555. MONESC = typche(io)(9:16)
  1556. IESC = ielche(1,1)
  1557. else if (nomche(io)(1:4).eq.'JEU') then
  1558. melval = ielval(io)
  1559. segact melval
  1560. MONJEU = 'FLOTTANT'
  1561. xjeu = velche(1,1)
  1562. else if (nomche(io)(1:4).eq.'RAYB') then
  1563. melval = ielval(io)
  1564. segact melval
  1565. XRAYB = velche(1,1)
  1566. else if (nomche(io)(1:4).eq.'GLIS') then
  1567. melval = ielval(io)
  1568. segact melval
  1569. XGLIS = velche(1,1)
  1570. else if (nomche(io)(1:4).eq.'ADHE') then
  1571. melval = ielval(io)
  1572. segact melval
  1573. XADHE = velche(1,1)
  1574. else if (nomche(io)(1:4).eq.'RTAN') then
  1575. melval = ielval(io)
  1576. segact melval
  1577. XRAIT = velche(1,1)
  1578. else if (nomche(io)(1:4).eq.'ATAN') then
  1579. melval = ielval(io)
  1580. segact melval
  1581. XAMOT = velche(1,1)
  1582. else if (nomche(io)(1:4).eq.'AMOR') then
  1583. melval = ielval(io)
  1584. segact melval
  1585. typret=typche(io)(1:8)
  1586. if (typret.eq.'POINTEUR') then
  1587. typret=typche(io)(9:16)
  1588. iamoes = ielche(1,1)
  1589. MONAMO = 'CHPOINT'
  1590. else
  1591. XAMO = velche(1,1)
  1592. MONAMO = 'FLOTTANT'
  1593. endif
  1594. else if (nomche(io)(1:4).eq.'SYME') then
  1595. melval = ielval(io)
  1596. segact melval
  1597. isyme = ielche(1,1)
  1598. MONSYM = 'MOT'
  1599. if (isyme.eq.1) CMOT1(1:7)='LOCALE'
  1600. if (isyme.eq.2) CMOT1(1:4)='VRAI'
  1601. if (isyme.eq.3) CMOT1(1:7)='GLOBALE'
  1602. else if (nomche(io)(1:4).eq.'RECH') then
  1603. melval = ielval(io)
  1604. segact melval
  1605. irchec = ielche(1,1)
  1606. MONREC = 'MOT'
  1607. if (irchec.eq.1) CMOT(1:7)= 'GLOBALE'
  1608. else
  1609. endif
  1610. enddo
  1611. * IF (IERR.NE.0) RETURN
  1612. *
  1613. IPALB(I,1) = ITYP
  1614. IPALB(I,3) = IDIM
  1615. XPALB(I,3) = XGLIS
  1616. XPALB(I,4) = XADHE
  1617. XPALB(I,5) = XRAIT
  1618. XPALB(I,6) = XAMOT
  1619. *
  1620. IF (MONAMO.EQ.'CHPOINT') THEN
  1621. IPALB(I,1) = 36
  1622. ID1 = 7
  1623. ELSE
  1624. ID1 = 6
  1625. ENDIF
  1626. * Normale au plan
  1627. IF (IDIM.EQ.3) THEN
  1628. if (inor.eq.0) call erreur(5)
  1629. IPNO = (IDIM + 1) * (INOR - 1)
  1630. PS = 0.D0
  1631. DO 80 ID = 1,IDIM
  1632. XC = XCOOR(IPNO + ID)
  1633. PS = PS + XC * XC
  1634. 80 CONTINUE
  1635. * end do
  1636. IF (PS.LE.0.D0) THEN
  1637. CALL ERREUR(162)
  1638. RETURN
  1639. ENDIF
  1640. DO 81 ID=1,IDIM
  1641. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1642. 81 CONTINUE
  1643. ELSE
  1644. DO 82 ID=1,IDIM
  1645. XPALB(I,ID1+ID) = 0.D0
  1646. 82 CONTINUE
  1647. ENDIF
  1648. IF (MONJEU.EQ.'FLOTTANT') THEN
  1649. XPALB(I,2) = XJEU
  1650. ELSE
  1651. XPALB(I,2) = 0.D0
  1652. ENDIF
  1653. * La recherche s'effectue par defaut localement
  1654. IF (MONREC.EQ.'MOT') THEN
  1655. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1656. IPALB(I,23) = 1
  1657. ELSE
  1658. IPALB(I,23) = 0
  1659. ENDIF
  1660. ELSE
  1661. IPALB(I,23) = 0
  1662. ENDIF
  1663. * Coordonnees du maillage_maitre
  1664. MELEME = IMAI
  1665. SEGACT MELEME
  1666. * Pour savoir si le contour est ferme
  1667. NELEMA = NUM(/2)
  1668. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1669. NNOEMA = NELEMA
  1670. IFERMA = 1
  1671. ELSE
  1672. NNOEMA = NELEMA +1
  1673. IFERMA = 0
  1674. ENDIF
  1675. IPALB(I,21) = NNOEMA
  1676. IPALB(I,24) = IFERMA
  1677. ID2 = ID1 + 4*IDIM
  1678. IPT = NUM(1,1)
  1679. INPT = (IDIM+1)*(IPT-1)
  1680. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1681. IPLIB(I,1) = IPLAC
  1682. KPLIB(1) = IPT
  1683. DO 84 ID=1,IDIM
  1684. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1685. 84 CONTINUE
  1686. DO 85 IE=1,(NNOEMA-1)
  1687. IPT = NUM(2,IE)
  1688. INPT = (IDIM+1)*(IPT-1)
  1689. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1690. IPLIB(I,IE+1) = IPLAC
  1691. KPLIB(IE+1) = IPT
  1692. IDIE = ID2 + IE*IDIM
  1693. DO 86 ID=1,IDIM
  1694. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1695. 86 CONTINUE
  1696. 85 CONTINUE
  1697. SEGDES MELEME
  1698. * Maillage_esclave
  1699. ID3 = ID2 + NNOEMA*IDIM
  1700. IF (MONESC.EQ.'POINT') THEN
  1701. * La ligne esclave est un point
  1702. NNOEES=1
  1703. IFERES=0
  1704. ISYMET=-1
  1705. * Lecture des coordonnees
  1706. IPESC = (IDIM+1)*(IESC-1)
  1707. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1708. IPLIB(I,NNOEMA+1) = IPLAC
  1709. KPLIB(NNOEMA+1) = IESC
  1710. DO 90 ID = 1,IDIM
  1711. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1712. 90 CONTINUE
  1713. *
  1714. IPALB(I,22) = NNOEES
  1715. IPALB(I,25) = IFERES
  1716. IPALB(I,26) = ISYMET
  1717. ELSE
  1718. IF (MONESC.EQ.'MAILLAGE') THEN
  1719. * La ligne esclave est un maillage
  1720. MELEME = IESC
  1721. SEGACT MELEME
  1722. * Pour savoir si le contour est ferme
  1723. NELEES = NUM(/2)
  1724. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1725. NNOEES = NELEES
  1726. IFERES = 1
  1727. ELSE
  1728. NNOEES = NELEES +1
  1729. IFERES = 0
  1730. ENDIF
  1731. IPALB(I,22) = NNOEES
  1732. IPALB(I,25) = IFERES
  1733. * Coordonnees du maillage_esclave
  1734. IPT = NUM(1,1)
  1735. INPT = (IDIM+1)*(IPT-1)
  1736. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1737. IPLIB(I,NNOEMA+1) = IPLAC
  1738. KPLIB(NNOEMA+1) = IPT
  1739. DO 94 ID=1,IDIM
  1740. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1741. 94 CONTINUE
  1742. DO 95 IE=1,(NNOEES-1)
  1743. IPT = NUM(2,IE)
  1744. INPT = (IDIM+1)*(IPT-1)
  1745. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1746. IPLIB(I,NNOEMA+IE+1) = IPLAC
  1747. KPLIB(NNOEMA+IE+1) = IPT
  1748. IDIE = ID3 + IE*IDIM
  1749. DO 96 ID=1,IDIM
  1750. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1751. 96 CONTINUE
  1752. 95 CONTINUE
  1753. SEGDES MELEME
  1754. * Le traitement symetrique par defaut ne s'effectue pas
  1755. IF (MONSYM.EQ.'MOT') THEN
  1756. IF (CMOT1(1:7).EQ.'LOCALE') THEN
  1757. IPALB(I,26) = 1
  1758. ELSE
  1759. IF (CMOT1(1:4).EQ.'VRAI'.OR.
  1760. & CMOT1(1:7).EQ.'GLOBALE') THEN
  1761. IPALB(I,26) = 0
  1762. ELSE
  1763. IPALB(I,26) = -1
  1764. ENDIF
  1765. ENDIF
  1766. ELSE
  1767. IPALB(I,26) = -1
  1768. ENDIF
  1769. ELSE
  1770. * La ligne esclave n'est ni un point ni un maillage
  1771. * CALL ERREUR(...)
  1772. RETURN
  1773. ENDIF
  1774. ENDIF
  1775. * Lecture des chpoints de raideur et d amortissement
  1776. * Raideurs des noeuds esclaves et maitres
  1777. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1778. MCHPOI=IRAIES
  1779. SEGACT,MCHPOI
  1780. NSOUP=IPCHP(/1)
  1781. DO 700 IPC=1,NSOUP
  1782. MSOUPO=IPCHP(IPC)
  1783. SEGACT,MSOUPO
  1784. MELEME = IGEOC
  1785. SEGACT,MELEME
  1786. MPOVAL = IPOVAL
  1787. SEGACT,MPOVAL
  1788. NNN = NUM(/2)
  1789. DO 711 INN=1,NNN
  1790. IPT = NUM(1,INN)
  1791. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1792. IF (IPLAC.NE.0) THEN
  1793. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1794. ENDIF
  1795. 711 CONTINUE
  1796. SEGDES,MPOVAL,MELEME
  1797. SEGDES MSOUPO
  1798. 700 CONTINUE
  1799. SEGDES,MCHPOI
  1800. * Amortissement des noeuds esclaves et maitres
  1801. ID5=ID4+NNOEMA+NNOEES
  1802. IF (IPALB(I,1).EQ.36) THEN
  1803. MCHPOI=IAMOES
  1804. SEGACT,MCHPOI
  1805. NSOUP = IPCHP(/1)
  1806. DO 121 IPC=1,NSOUP
  1807. MSOUPO=IPCHP(IPC)
  1808. SEGACT,MSOUPO
  1809. MELEME = IGEOC
  1810. SEGACT,MELEME
  1811. MPOVAL = IPOVAL
  1812. SEGACT,MPOVAL
  1813. NNN=NUM(/2)
  1814. DO 130 INN=1,NNN
  1815. IPT = NUM(1,INN)
  1816. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1817. IF (IPLAC.NE.0) THEN
  1818. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1819. ENDIF
  1820. 130 CONTINUE
  1821. SEGDES MPOVAL,MELEME
  1822. SEGDES MSOUPO
  1823. 121 CONTINUE
  1824. SEGDES MCHPOI
  1825. ENDIF
  1826. SEGSUP MLIGNE
  1827.  
  1828. else if(cmatee.eq.'LI_CE_FR') then
  1829.  
  1830.  
  1831. else if(cmatee.eq.'PA_FL_RO') then
  1832. ITYP = 60
  1833. MONMOT='RODELI'
  1834. MTLIAB = KTLIAB
  1835. *
  1836. NUML = I
  1837. IP1 = imod
  1838. IF (IERR.NE.0) RETURN
  1839. CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  1840. IPLIB(NUML,1) = IPLAC
  1841. *
  1842. * Valeurs de IPALB et XPALB communes a tous les types de
  1843. * paliers fluides :
  1844. *
  1845. IPALB(NUML,1) = ITYP
  1846. IPALB(NUML,2) = 0
  1847. IPALB(NUML,3) = 3
  1848. IPALB(NUML,4) = 0
  1849. *
  1850. do io = 1,n2
  1851. if (nomche(io)(1:4).eq.'VISC') then
  1852. melval = ielval(io)
  1853. segact melval
  1854. X1 = velche(1,1)
  1855. XPALB(NUML,1) = X1
  1856. else if (nomche(io)(1:4).eq.'RHOF') then
  1857. melval = ielval(io)
  1858. segact melval
  1859. X1 = velche(1,1)
  1860. XPALB(NUML,2) = X1
  1861. else if (nomche(io)(1:4).eq.'PADM') then
  1862. melval = ielval(io)
  1863. segact melval
  1864. X1 = velche(1,1)
  1865. XPALB(NUML,3) = X1
  1866. else if (nomche(io)(1:4).eq.'LONG') then
  1867. melval = ielval(io)
  1868. segact melval
  1869. X1 = velche(1,1)
  1870. XPALB(NUML,4) = X1
  1871. else if (nomche(io)(1:4).eq.'AFFI') then
  1872. melval = ielval(io)
  1873. segact melval
  1874. X1 = velche(1,1)
  1875. XPALB(NUML,5) = X1
  1876. else if (nomche(io)(1:4).eq.'RAYO') then
  1877. melval = ielval(io)
  1878. segact melval
  1879. X1 = velche(1,1)
  1880. XPALB(NUML,6) = X1
  1881. else if (nomche(io)(1:4).eq.'VROT') then
  1882. melval = ielval(io)
  1883. segact melval
  1884. X1 = velche(1,1)
  1885. XPALB(NUML,7) = X1
  1886. else if (nomche(io)(1:4).eq.'EPSI') then
  1887. melval = ielval(io)
  1888. segact melval
  1889. X1 = velche(1,1)
  1890. XPALB(NUML,8) = X1
  1891. else if (nomche(io)(1:4).eq.'PHII') then
  1892. melval = ielval(io)
  1893. segact melval
  1894. X1 = velche(1,1)
  1895. XPALB(NUML,9) = X1
  1896. else if (nomche(io)(1:4).eq.'TLOB') then
  1897. melval = ielval(io)
  1898. segact melval
  1899. itgeom = ielche(1,1)
  1900. else
  1901. endif
  1902. enddo
  1903. *
  1904. IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN
  1905. * ----- Cas du palier cylindrique ou a lobes, avec modele de Rhode et Li
  1906. *
  1907. IPALB(NUML,5) = 1
  1908. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  1909. & 'ENTIER',NLOB,X1,' ',L1,IP1)
  1910.  
  1911. IF (IERR.NE.0) RETURN
  1912. IPALB(NUML,6) = NLOB
  1913.  
  1914. C Nombre de parametres reels :
  1915. NBPR = 6
  1916. IPALB(NUML,7) = NBPR
  1917.  
  1918. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  1919. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1920. XPALB(NUML,10) = X1
  1921.  
  1922. IF (IERR.NE.0) RETURN
  1923. DO 610 ILOB = 1, NLOB
  1924. *
  1925. CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0,
  1926. & 'TABLE',I1,X1,' ',L1,ITLOB)
  1927.  
  1928. IF (IERR.NE.0) RETURN
  1929. CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  1930. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1931. XPALB(NUML,11+NBPR*(ILOB-1)) = X1
  1932.  
  1933. IF (IERR.NE.0) RETURN
  1934. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  1935. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1936. XPALB(NUML,12+NBPR*(ILOB-1)) = X1
  1937.  
  1938. IF (IERR.NE.0) RETURN
  1939. CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  1940. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1941. XPALB(NUML,13+NBPR*(ILOB-1)) = X1
  1942.  
  1943. IF (IERR.NE.0) RETURN
  1944. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  1945. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1946. XPALB(NUML,14+NBPR*(ILOB-1)) = X1
  1947. ANGDEB = X1
  1948.  
  1949. IF (IERR.NE.0) RETURN
  1950. CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  1951. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1952. XPALB(NUML,15+NBPR*(ILOB-1)) = X1
  1953. AMPLIT=X1
  1954.  
  1955. IF (IERR.NE.0) RETURN
  1956. CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  1957. & 'FLOTTANT',I1,X1,MONMOT,L1,IP1)
  1958. XPALB(NUML,16+NBPR*(ILOB-1)) = X1
  1959.  
  1960. IF (IERR.NE.0) RETURN
  1961. CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  1962. & 'ENTIER',I1,X1,' ',L1,IP1)
  1963. cbp2018 IPALB(NUML,7+ILOB) = I1
  1964. NMAIL=I1
  1965. CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL)
  1966. IPALB(NUML,7+ILOB) = KLREEL
  1967.  
  1968. IF (IERR.NE.0) RETURN
  1969. 610 CONTINUE
  1970. ENDIF
  1971. *
  1972. else
  1973. write(6,*) 'verifier nom liaison', cmatee
  1974. call erreur(5)
  1975. return
  1976. endif
  1977. enddo
  1978. *
  1979. * traiter liaisons conditionnelles
  1980. *
  1981. DO I = 1,kmodel(/1)
  1982. ksi = 0
  1983. imodel = kmodel(I)
  1984. segact imodel
  1985. if (tymode(/2).gt.0) then
  1986. do 722 ilc = 1,tymode(/2)
  1987. do j =1,kmodel(/1)
  1988. if (kmodel(j).eq.ivamod(ilc)) then
  1989. ksi = ksi + 1
  1990. ipalb(i,4) = 1
  1991. IF (tymode(ilc).EQ.'CONDINFE' ) THEN
  1992. ipalb (i,4+ksi) = j
  1993. ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN
  1994. ipalb (i,4+ksi) = -1 * j
  1995. ENDIF
  1996. endif
  1997. goto 722
  1998. enddo
  1999. 722 continue
  2000. endif
  2001. 723 continue
  2002. ENDDO
  2003.  
  2004. * ranger
  2005. do I = 1, kmodel(/1)
  2006. imodel = kmodel(I)
  2007. ipt8 = imamod
  2008. segdes imodel,ipt8
  2009. enddo
  2010. do in = 1,n1
  2011. meleme = imache(in)
  2012. mchaml = ichaml(in)
  2013. segact mchaml
  2014. n2 = ielval(/1)
  2015. do io = 1,n2
  2016. melval = ielval(io)
  2017. segdes melval
  2018. enddo
  2019. segdes meleme,mchaml
  2020. enddo
  2021. segdes mchelm
  2022.  
  2023.  
  2024. ***** eventuel message ****
  2025.  
  2026. IF (IIMPI.EQ.333) THEN
  2027. NLIAB = IPALB(/1)
  2028. NIPALB = IPALB(/2)
  2029. NXPALB = XPALB(/2)
  2030. NPLBB = IPLIB(/2)
  2031. NPLB = JPLIB(/1)
  2032. DO 1000 IN = 1,NLIAB
  2033. DO 1002 II = 1,NIPALB
  2034. WRITE(IOIMP,*)'DYNE70 : IPALB(',IN,',',II,') =',IPALB(IN,II)
  2035. 1002 CONTINUE
  2036. DO 1004 IX = 1,NXPALB
  2037. WRITE(IOIMP,*)'DYNE70 : XPALB(',IN,',',IX,') =',XPALB(IN,IX)
  2038. 1004 CONTINUE
  2039. DO 1006 IP = 1,NPLBB
  2040. WRITE(IOIMP,*)'DYNE70 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP)
  2041. 1006 CONTINUE
  2042. 1000 CONTINUE
  2043. DO 1008 IP = 1,NPLB
  2044. WRITE(IOIMP,*)'DYNE70 : JPLIB(',IP,') =',JPLIB(IP)
  2045. 1008 CONTINUE
  2046. ENDIF
  2047.  
  2048. *
  2049. RETURN
  2050. END
  2051.  
  2052.  
  2053.  
  2054.  
  2055.  
  2056.  
  2057.  
  2058.  
  2059.  
  2060.  
  2061.  
  2062.  
  2063.  
  2064.  
  2065.  
  2066.  
  2067.  
  2068.  
  2069.  
  2070.  

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