Télécharger dyne70.eso

Retour à la liste

Numérotation des lignes :

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

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