Télécharger dyne20.eso

Retour à la liste

Numérotation des lignes :

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

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