Télécharger cyne20.eso

Retour à la liste

Numérotation des lignes :

  1. C CYNE20 SOURCE BP208322 19/04/03 21:15:01 10174
  2. SUBROUTINE CYNE20(ILIB,IWRK52,itruli)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * voir dyne20.eso *
  7. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  8. * ________________________________________________ *
  9. * *
  10. * Remplissage des tableaux de description des liaisons sur *
  11. * la base @ 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 e 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. * ** voir DYNE20.ESO remplissage segment MTPHI
  58. *--------------------------------------------------------------------*
  59. -INC CCOPTIO
  60. -INC SMCOORD
  61. -INC SMEVOLL
  62. -INC SMLREEL
  63. -INC SMMODEL
  64. -INC SMCHAML
  65. -INC SMELEME
  66. -INC SMCHPOI
  67. -INC DECHE
  68. -INC SMTABLE
  69. ** segment sous-structures dynamiques
  70. segment struli
  71. integer itlia,itbmod,momoda, mostat,itmail,molia
  72. integer ldefo(np1),lcgra(np1),lsstru(np1)
  73. integer nsstru,nndefo,nliab,nsb,na2,idimb
  74. integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  75. INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  76. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  77. INTEGER ICHAIN
  78. endsegment
  79. *
  80. SEGMENT,NCPR(XCOOR(/1)/(IDIM+1))
  81. * segment dimensionnement pour LIAISONS
  82. *
  83. SEGMENT MTLIAB
  84. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  85. REAL*8 XPALB(NLIAB,NXPALB)
  86. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  87. ENDSEGMENT
  88. *
  89. SEGMENT MLIGNE
  90. INTEGER KPLIB(NPLB)
  91. ENDSEGMENT
  92. *
  93. SEGMENT,MTPHI
  94. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  95. INTEGER IAROTA(NSB)
  96. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  97. ENDSEGMENT
  98. * Segment pour Champoints
  99. SEGMENT,MSAM
  100. integer jplibb(NPLB)
  101. ENDSEGMENT
  102.  
  103. SEGMENT,MTRA
  104. INTEGER IPLA(NTRA)
  105. ENDSEGMENT
  106.  
  107. SEGMENT MOLIAI
  108. integer modtla,modtlb
  109. ENDSEGMENT
  110. *
  111. *
  112. LOGICAL Lo1,L0,log1,lvar,lmodyn,lva1
  113. LOGICAL LPERM,LINTER,LECRO,LELAS,REPRIS
  114. CHARACTER*40 CMOT,MONMOT,CMOT1 ,MONECR,CMOT2
  115. CHARACTER*8 MONAMO,MONSEUIL,TYPRET,MARAID,MONPER
  116. CHARACTER*16 CHARRE
  117. CHARACTER*8 TYPREG,MONREC,MONJEU,MONSYM,MONELA,MONINTER
  118. CHARACTER*8 MONESC,MONRAY,MONCAL,MONINV
  119. CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3)
  120. REAL*8 XAXROT(3),XROTA(2,3)
  121. DATA NOMAXI/'UR ','UT ','UZ ','RR ','RT ','RZ '/
  122. DATA NOMPLA/'UX ','UY ','RZ '/
  123. DATA NOMTRI/'UX ','UY ','UZ ','RX ','RY ','RZ '/
  124.  
  125. struli = itruli
  126.  
  127. wrk52 = iwrk52
  128.  
  129. imodel = ilib
  130. segact imodel
  131. * fabrique la table de sortie
  132. *
  133. call crtabl(its1)
  134. itsort = its1
  135.  
  136. L1 = 1
  137. N1 = 1
  138. n3 = 6
  139. segini mchelm
  140. itcara = mchelm
  141.  
  142. * kich : reconstruit un mchaml ad hoc : ne pas oublier qu il s agit
  143. * de reutilisation .
  144. n2 = valmat(/1)
  145. segini mchaml
  146. ichaml(1) = mchaml
  147. imache(1) = imamod
  148. conche(1) = conmod
  149. do jn2 = 1,n2
  150. nomche(jn2) = commat(jn2)
  151. typche(jn2) = tyval(jn2)
  152. ielval(jn2) = ivalma(jn2)
  153. if(nomche(jn2).eq.'SORT') then
  154. if (ielval(jn2).eq.0) then
  155. call crtabl(ipsort)
  156. else
  157. melval = ielval(jn2)
  158. * segact melval
  159. ipsort = ielche(1,1)
  160. if (typche(jn2).ne.'POINTEURTABLE') then
  161. MOTERR(1:16) = typche(jn2)
  162. MOTERR(17:20) = nomche(jn2)
  163. MOTERR(21:36) = ' utile '
  164. CALL ERREUR(552)
  165. return
  166. endif
  167. endif
  168. c* mtab1 = ipsort
  169. c* segact mtab1
  170. call ecrobj('TABLE',ipsort)
  171. call indeta
  172. call lirobj('TABLE ',ITAC,1,IRETOU)
  173. CALL DIMEN7 (ITAC,IDIMEN)
  174. INDICE = 0
  175. 5100 CONTINUE
  176. INDICE = INDICE + 1
  177. TYPRET = ' '
  178. CALL ACCTAB(ITAC,'ENTIER',INDICE,X0,' ',L0,IP0,
  179. & TYPRET,I1,X1,CHARRE,LVA1,ITTL)
  180. IF (TYPRET.EQ.'MMODEL ' .AND. ITTL.NE.0) THEN
  181. mmode1 = ittl
  182. ipttl = ittl
  183. segact mmode1
  184. * on attend une liaison elementaire
  185. imode1 = mmode1.kmodel(1)
  186. segact imode1
  187. if (imode1.conmod.eq.conmod.or.imode1.imamod.eq.imamod) then
  188. TYPRET = ' '
  189. CALL ACCTAB(IPSORT,'MMODEL ',I0,X0,' ',L0,ITTL,
  190. & TYPRET,I1,X1,CHARRE,LVAR,ITVAR)
  191.  
  192. CALL ECCTAB(ITS1,'MMODEL',0,0.D0,' ',.TRUE.,ittl,
  193. & TYPRET,I1,X1,CHARRE,LVAR,ITVAR)
  194.  
  195. goto 5010
  196. endif
  197. ENDIF
  198. IF(INDICE.LE.IDIMEN) GOTO 5100
  199. endif
  200.  
  201.  
  202. 5010 continue
  203.  
  204. enddo
  205.  
  206. NTVAR = 6 + 4 * IDIM
  207. *
  208. * MTRA indiquera la presence de liaisons POLYNOMIALEs
  209. * (on suppose un maximum de 100 liaisons en base A)
  210. *+* passe a 10000 le 28/1/93
  211. NTRA = 10000
  212. SEGINI,MTRA
  213.  
  214. lmodyn = .true.
  215. np = 1
  216. nins = 1
  217. repris = .false.
  218. idimb1 = idimb
  219. nplb1 = nplb
  220. moliai = molia
  221. imolia = moliai
  222. segact moliai
  223. klia = 0
  224. klib = 0
  225. if (modtla.ne.0) then
  226. mmode1 = modtla
  227. segact mmode1
  228. klia = mmode1.kmodel(/1)
  229. endif
  230. if (modtlb.ne.0) then
  231. mmode1 = modtlb
  232. segact mmode1
  233. klib = mmode1.kmodel(/1)
  234. endif
  235. na1 = 0
  236. nmost0 = 0
  237. if (momoda.gt.0) then
  238. mmode2 = momoda
  239. segact mmode2
  240. nmost0 = mmode2.kmodel(/1)
  241. na1 = nmost0
  242. endif
  243. if (mostat.gt.0) then
  244. mmode2 = mostat
  245. segact mmode2
  246. na1 = na1 + mmode2.kmodel(/1)
  247. endif
  248. *
  249. nliab = klib
  250. nliabl=nliab
  251. SEGINI,MTLIAB
  252. KTLIAB = MTLIAB
  253. IF (NLIAB.NE.0) THEN
  254. NCPR = kcpr
  255. LCPR = XCOOR(/1) / (IDIM + 1)
  256. IN = 0
  257. DO 18 I = 1,LCPR
  258. IF (NCPR(I).NE.0) THEN
  259. IN = IN + 1
  260. JPLIB(IN) = I
  261. ENDIF
  262. 18 CONTINUE
  263. * segement ncpr detruit dans devini
  264. ENDIF
  265. *
  266. * Gestion de la table definissant les resultats attendus:
  267. * ( par la suite, on s'occupera de TREDU )
  268. *
  269.  
  270. jchain = ichain
  271. ikpref = kpref
  272. * if (klia.le.0) klia = 1
  273. CALL DYNE15(ITS1,iKPREF,NA1,NP,NINS,IMOLIA,iktres,jtmail,REPRIS,
  274. & JCHAIN,NTVAR,klia,nliabl,nplb1,idimb1,MTRA,ITCARA,
  275. &lmodyn,nmost0)
  276.  
  277. IF (IERR.NE.0) RETURN
  278. KTRES = iktres
  279. itmail = jtmail
  280. ichain = jchain
  281.  
  282. * Creation des objets resultats :
  283. *
  284. SEGINI,MSAM
  285. KSAM=MSAM
  286. DO 100 IP=1,NPLB
  287. JPLIBB(IP)=JPLIB(IP)
  288. 100 CONTINUE
  289. itkm = 0
  290. jtmail = itmail
  291. JTRES = KTRES
  292. JPREF = KPREF
  293. lmodyn = .true.
  294. NPLAA = 0
  295. NXPALA= 0
  296. CALL DYNE17(1,ITKM,jtmail,JTRES,JPREF,NPLAA,NXPALA,KSAM,lmodyn)
  297. IF (IERR.NE.0) RETURN
  298. MSAM=KSAM
  299. SEGSUP,MSAM
  300.  
  301. *
  302. mchelm = itcara
  303. segact mchelm
  304. do im3 = 1,ichaml(/1)
  305. mchaml = ichaml(im3)
  306. segsup mchaml
  307. enddo
  308. segsup mchelm
  309.  
  310. *
  311. * model élémentaire
  312. *
  313. II = 0
  314. *
  315. imodel = ilib
  316. segact imodel
  317. ipt8 = imamod
  318. segact ipt8
  319. imod = ipt8.num(1,1)
  320. inoa = ipt8.num(1,1)
  321. isup = ipt8.num(1,1)
  322.  
  323. I = jliaib
  324.  
  325. 51 continue
  326. TYPRET = ' '
  327. MONSEUIL = ' '
  328. if (cmatee.eq.'PO_PL_FL') then
  329. ITYP = 7
  330. IPOI = int(valmat(1))
  331. XINER = valmat(2)
  332. XCONV = valmat(3)
  333. XVISC = valmat(4)
  334. XPCEL = valmat(5)
  335. XPCRA = valmat(6)
  336. XJEU = valmat(7)
  337.  
  338. IPALB(I,1) = ITYP
  339. IPALB(I,3) = IDIM
  340. XPALB(I,1) = XINER
  341. XPALB(I,2) = XCONV
  342. XPALB(I,3) = XVISC
  343. XPALB(I,4) = XPCEL
  344. XPALB(I,5) = XPCRA
  345. XPALB(I,6) = XJEU
  346. *
  347. IPNV = (IDIM + 1) * (IPOI - 1)
  348. PS = 0.D0
  349. DO 70 ID = 1,IDIM
  350. XC = XCOOR(IPNV + ID)
  351. PS = PS + XC * XC
  352. 70 CONTINUE
  353. * end do
  354. IF (PS.LE.0.D0) THEN
  355. CALL ERREUR(162)
  356. RETURN
  357. ENDIF
  358. ID1 = 6
  359. DO 72 ID = 1,IDIM
  360. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  361. 72 CONTINUE
  362. * end do
  363. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  364. IPLIB(I,1) = IPLAC
  365. *
  366. else if(cmatee.eq.'PO_PL_FR') then
  367. ITYP = 3
  368. MARAID = ' '
  369. TYPRET = ' '
  370. MONAMO = ' '
  371.  
  372. IPOI = int(valmat(1))
  373. if (valmat(2).gt.0.) then
  374. xrain = valmat(2)
  375. MARAID = 'FLOTTANT'
  376. endif
  377. XJEU = valmat(3)
  378. XGLIS = valmat(4)
  379. XADHE = valmat(5)
  380. XRAIT = valmat(6)
  381. XAMOT = valmat(7)
  382.  
  383. if (valmat(/1).gt.7) then
  384. if (valmat(8).gt.0.) then
  385. xamon = valmat(8)
  386. MONAMO = 'FLOTTANT'
  387. endif
  388. if (tyval(9)(9:16).eq.'EVOLUTIO') then
  389. ipevo = int(valmat(9))
  390. TYPRET = 'EVOLUTIO'
  391. endif
  392. endif
  393.  
  394. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  395. CALL ERREUR(891)
  396. RETURN
  397. ENDIF
  398. IF (TYPRET.EQ.'EVOLUTIO') THEN
  399. ITYP = 103
  400. XRAIN = 0.d0
  401. ENDIF
  402. IPALB(I,1) = ITYP
  403. IPALB(I,3) = IDIM
  404. XPALB(I,1) = XRAIN
  405. XPALB(I,2) = XJEU
  406. XPALB(I,3) = XGLIS
  407. XPALB(I,4) = XADHE
  408. XPALB(I,5) = XRAIT
  409. XPALB(I,6) = XAMOT
  410. IF (MONAMO.EQ.'FLOTTANT') THEN
  411. XPALB(I,7) = XAMON
  412. ELSE
  413. XPALB(I,7) = 0.D0
  414. ENDIF
  415. *
  416. IPNV = (IDIM + 1) * (IPOI - 1)
  417. PS = 0.D0
  418. DO 20 ID = 1,IDIM
  419. XC = XCOOR(IPNV + ID)
  420. PS = PS + XC * XC
  421. 20 CONTINUE
  422. * end do
  423. IF (PS.LE.0.D0) THEN
  424. CALL ERREUR(162)
  425. RETURN
  426. ENDIF
  427. ID1 = 7
  428. DO 22 ID = 1,IDIM
  429. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  430. 22 CONTINUE
  431. * end do
  432.  
  433. IF (IPALB(I,1) .EQ. 103) THEN
  434. MEVOLL = IPEVO
  435. *
  436. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  437. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  438. * des tableaux xabsci et xordon
  439. *
  440. SEGACT MEVOLL
  441. KEVOLL = IEVOLL(1)
  442. SEGACT KEVOLL
  443. MLREE1 = IPROGX
  444. MLREE2 = IPROGY
  445. SEGACT MLREE1
  446. SEGACT MLREE2
  447. NIP = XABSCI(/2)
  448. *
  449. DO 26 MM=1,NIP
  450. XABSCI (I,MM) = MLREE1.PROG(MM)
  451. XORDON (I,MM) = MLREE2.PROG(MM)
  452. 26 CONTINUE
  453. SEGDES MLREE1
  454. SEGDES MLREE2
  455. SEGDES KEVOLL
  456. SEGDES MEVOLL
  457. ENDIF
  458. *
  459. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  460. IPLIB(I,1) = IPLAC
  461. *
  462. else if(cmatee.eq.'PO_PL') then
  463. ITYP = 1
  464. IPERM = 0
  465. XPALB(I,3) = 0.D0
  466. MONSEUIL =' '
  467. TYPRET= ' '
  468. IPOI = int(valmat(1))
  469. xraid = valmat(2)
  470. xjeu = valmat(3)
  471. if (ivalma(6).gt.0) then
  472. MONSEUIL ='FLOTTANT'
  473. xseuil = valmat(6)
  474. endif
  475. xamon = valmat(7)
  476. XPALB(I,3) = XAMON
  477. if (ivalma(4).gt.0) then
  478. ipevo = int(valmat(4))
  479. TYPRET = 'EVOLUTIO'
  480. endif
  481. *?
  482. if (valmat(5).ne.0) IPERM = 1
  483.  
  484.  
  485. IPALB(I,1) = ITYP
  486. IPALB(I,3) = IDIM
  487. IPALB(I,4) = IPERM
  488. XPALB(I,1) = XRAID
  489. XPALB(I,2) = XJEU
  490. *
  491. IPNV = (IDIM + 1) * (IPOI - 1)
  492. PS = 0.D0
  493. DO 17 ID = 1,IDIM
  494. XC = XCOOR(IPNV + ID)
  495. PS = PS + XC * XC
  496. 17 CONTINUE
  497. *
  498. IF (PS.LE.0.D0) THEN
  499. CALL ERREUR(162)
  500. RETURN
  501. ENDIF
  502. ID1 = 3
  503.  
  504. IF (MONSEUIL .EQ.'FLOTTANT') THEN
  505. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  506. IPALB(I,1) = 101
  507. ELSE
  508. IPALB(I,1) = 100
  509. ENDIF
  510. ID1 = 4
  511. XPALB(I,ID1) = XSEUIL
  512. ELSE
  513. IF (TYPRET .EQ. 'EVOLUTIO') THEN
  514. IPALB(I,1) = 102
  515. ENDIF
  516. ENDIF
  517.  
  518. *
  519. DO 12 ID = 1,IDIM
  520. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  521. 12 CONTINUE
  522. *
  523. IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN
  524. MEVOLL = IPEVO
  525. *
  526. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  527. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  528. * des tableaux xabsci et xordon
  529. *
  530. SEGACT MEVOLL
  531. KEVOLL = IEVOLL(1)
  532. SEGACT KEVOLL
  533. MLREE1 = IPROGX
  534. MLREE2 = IPROGY
  535. SEGACT MLREE1
  536. SEGACT MLREE2
  537. NIP = XABSCI(/2)
  538. *
  539. DO 16 MM=1,NIP
  540. XABSCI (I,MM) = MLREE1.PROG(MM)
  541. XORDON (I,MM) = MLREE2.PROG(MM)
  542. 16 CONTINUE
  543. *
  544. SEGDES MLREE1
  545. SEGDES MLREE2
  546. SEGDES KEVOLL
  547. SEGDES MEVOLL
  548. ENDIF
  549. *
  550. c IMOD = num(1,1)
  551. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  552. IPLIB(I,1) = IPLAC
  553. *
  554. else if (cmatee.eq.'PO_PO_FR') then
  555. ITYP = 13
  556. MARAID = ' '
  557. MONPER = ' '
  558. MONAMO = ' '
  559. TYPRET = ' '
  560. TYPREG = ' '
  561. CHARRE = ' '
  562. igibe = 0
  563. IPOI = int(valmat(1))
  564. xraid = valmat(2)
  565. xjeu = valmat(3)
  566. INOB = int(valmat(4))
  567. xadhe = valmat(5)
  568. xrait = valmat(6)
  569. xamot = valmat(7)
  570. xglis = valmat(8)
  571. if (valmat(/1).gt.8) then
  572. if (tyval(10)(9:16).eq.'EVOLUTIO') then
  573. ipevo = int(valmat(10))
  574. TYPRET = 'EVOLUTIO'
  575. endif
  576. if (tyval(11)(1:6).eq.'ENTIER') then
  577. igibe = int(valmat(11))
  578. TYPREG = 'MOT'
  579. if (igibe.eq.1) CHARRE = 'NEDJAI-GIBERT'
  580. endif
  581. if (tyval(9)(1:6).eq.'REAL*8') then
  582. xamon = valmat(9)
  583. MONAMO='FLOTTANT'
  584. endif
  585. endif
  586.  
  587.  
  588. IF (IERR.NE.0) RETURN
  589. ** dans quel cas monamo est il entier? PV
  590. ** IF (MONAMO .EQ. 'ENTIER ') THEN
  591. ** XAMON = 1.D0*I0
  592. ** MONAMO = 'FLOTTANT'
  593. ** ENDIF
  594. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  595. CALL ERREUR(891)
  596. RETURN
  597. ENDIF
  598. IF (TYPRET.EQ.'EVOLUTIO') THEN
  599. ITYP = 113
  600. XRAID = 0.d0
  601. ENDIF
  602. *
  603. IPALB(I,1) = ITYP
  604. IPALB(I,3) = IDIM
  605. XPALB(I,1) = XRAID
  606. XPALB(I,2) = XJEU
  607. XPALB(I,3) = XGLIS
  608. XPALB(I,4) = XADHE
  609. XPALB(I,5) = XRAIT
  610. XPALB(I,6) = XAMOT
  611. IF (MONAMO.EQ.'FLOTTANT') THEN
  612. XPALB(I,7) = XAMON
  613. ELSE
  614. XPALB(I,7) = 0.D0
  615. ENDIF
  616.  
  617. * cas particulier pas tres orthodoxe pour Gibert
  618. * on passe a ityp = -13 et on modifie et ajoute
  619. * devlb2, devlb1-->devfb2--->dgcha4--->dgchfr--->dgchgl, devso4
  620. IF (TYPREG.EQ.'MOT') THEN
  621. IF (CHARRE.EQ.'NEDJAI-GIBERT') THEN
  622. IPALB(I,1) = -13
  623. ELSE
  624. CALL ERREUR(891)
  625. RETURN
  626. ENDIF
  627. ELSEIF (IGIBE.NE.0) THEN
  628. CALL ERREUR(891)
  629. RETURN
  630. ENDIF
  631.  
  632. *
  633. * normalisation de la normale
  634. *
  635. IPNV = (IDIM + 1) * (IPOI - 1)
  636. PS = 0.D0
  637. DO 420 ID = 1,IDIM
  638. XC = XCOOR(IPNV + ID)
  639. PS = PS + XC * XC
  640. 420 CONTINUE
  641. * end do
  642. IF (PS.LE.0.D0) THEN
  643. CALL ERREUR(162)
  644. RETURN
  645. ENDIF
  646. DO 422 ID = 1,IDIM
  647. ID2 = 7 + ID
  648. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  649. 422 CONTINUE
  650. * end do
  651. *
  652. IF (IPALB(I,1) .EQ. 113) THEN
  653. MEVOLL = IPEVO
  654. *
  655. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  656. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  657. * des tableaux xabsci et xordon
  658. *
  659. SEGACT MEVOLL
  660. KEVOLL = IEVOLL(1)
  661. SEGACT KEVOLL
  662. MLREE1 = IPROGX
  663. MLREE2 = IPROGY
  664. SEGACT MLREE1
  665. SEGACT MLREE2
  666. NIP = XABSCI(/2)
  667. *
  668. DO 424 MM=1,NIP
  669. XABSCI (I,MM) = MLREE1.PROG(MM)
  670. XORDON (I,MM) = MLREE2.PROG(MM)
  671. 424 CONTINUE
  672. *
  673. SEGDES MLREE1
  674. SEGDES MLREE2
  675. SEGDES KEVOLL
  676. SEGDES MEVOLL
  677. ENDIF
  678. *
  679. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  680. IPLIB(I,1) = IPLAC
  681. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  682. IPLIB(I,2) = IPLAC
  683.  
  684. *
  685. else if(cmatee.eq.'PO_PO_DP') then
  686. ITYP = 16
  687. MARAID = ' '
  688. MONPER = ' '
  689. LPERM = .false.
  690. IPERM = 0
  691. MONAMO = ' '
  692. TYPRET = ' '
  693.  
  694. IPOI = int(valmat(1))
  695. IECRO = int(valmat(2))
  696. * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique
  697. LECRO = .true.
  698. if (iecro.eq.1) monecr = 'ISOTROPE'
  699. if (iecro.eq.2) monecr = 'CINEMATIQUE'
  700. xjeu = valmat(3)
  701. inob = int(valmat(4))
  702. * IPERM = 2 <= isotrope , IPERM = 3 <= cinematique
  703. if (valmat(5).gt.0) LPERM = .true.
  704. IPERM = int(valmat(5))
  705. IPEVO = int(valmat(6))
  706. if (tyval(10)(9:16).eq.'EVOLUTIO') then
  707. TYPRET = 'EVOLUTIO'
  708. endif
  709. if (valmat(/1).gt.6) then
  710. xamon = valmat(7)
  711. MONAMO='FLOTTANT'
  712. endif
  713.  
  714. IF (IERR.NE.0) RETURN
  715.  
  716. IF (LPERM) THEN
  717. IF (.NOT.(XJEU.EQ.0.D0)) THEN
  718. * WRITE (*,*) 'Liaison permanente, mise a zero du jeu.'
  719. XJEU = 0.D0
  720. ENDIF
  721.  
  722. IF (IPERM.ne.3.and.IPERM.ne.2) THEN
  723. call erreur(21)
  724. RETURN
  725. ENDIF
  726. ENDIF
  727. *
  728. MEVOLL = IPEVO
  729. *
  730. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  731. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  732. * des tableaux xabsci et xordon
  733. *
  734. SEGACT MEVOLL
  735. KEVOLL = IEVOLL(1)
  736. SEGACT KEVOLL
  737. MLREE1 = IPROGX
  738. MLREE2 = IPROGY
  739. SEGACT MLREE1
  740. SEGACT MLREE2
  741. NIP = XABSCI(/2)
  742. *
  743. DO 426 MM=1,NIP
  744. XABSCI (I,MM) = MLREE1.PROG(MM)
  745. XORDON (I,MM) = MLREE2.PROG(MM)
  746. 426 CONTINUE
  747. *
  748. SEGDES MLREE1
  749. SEGDES MLREE2
  750. SEGDES KEVOLL
  751. SEGDES MEVOLL
  752. *
  753. IPALB(I,1) = ITYP
  754. IPALB(I,3) = IDIM
  755. XPALB(I,1) = XJEU
  756. IPALB(I,5) = IPERM
  757. *
  758. * normalisation de la normale
  759. *
  760. IPNV = (IDIM + 1) * (IPOI - 1)
  761. PS = 0.D0
  762. DO 30 ID = 1,IDIM
  763. XC = XCOOR(IPNV + ID)
  764. PS = PS + XC * XC
  765. 30 CONTINUE
  766. * end do
  767. IF (PS.LE.0.D0) THEN
  768. CALL ERREUR(162)
  769. RETURN
  770. ENDIF
  771. IF (MONAMO.EQ.'FLOTTANT') THEN
  772. IPALB(I,1) = 17
  773. XPALB(I,2) = XAMON
  774. DO 32 ID = 1,IDIM
  775. ID2 = 2 + ID
  776. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  777. 32 CONTINUE
  778. * end do
  779. ELSE
  780. DO 34 ID = 1,IDIM
  781. ID2 = 1 + ID
  782. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  783. 34 CONTINUE
  784. * end do
  785. ENDIF
  786. *
  787. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  788. IPLIB(I,1) = IPLAC
  789. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  790. IPLIB(I,2) = IPLAC
  791. *
  792. else if(cmatee.eq.'PO_PO_RP') then
  793. ITYP = 50
  794. MARAID = ' '
  795. MONPER = ' '
  796. MONELA = ' '
  797. LPERM = .FALSE.
  798. LELAS = .FALSE.
  799. LECRO = .FALSE.
  800. IPERM = 0
  801. MONAMO = ' '
  802. TYPRET = ' '
  803.  
  804. IPOI = int(valmat(1))
  805. IECRO = int(valmat(2))
  806. * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique
  807. LECRO = .true.
  808. if (iecro.eq.1) monecr = 'ISOTROPE'
  809. if (iecro.eq.2) monecr = 'CINEMATIQUE'
  810. xjeu = valmat(3)
  811. inob = int(valmat(4))
  812. * iperm = -2 : liaison elastique permanente
  813. * iperm = -1 : choc elastique
  814. * iperm = 0 : donnees incoherentes ou insuffisantes
  815. * iperm = 1 : choc plastique
  816. * iperm = 2 : liaison plastique isotrope
  817. * iperm = 3 : liaison plastique cinematique
  818. if (valmat(5).gt.0) LPERM = .true.
  819. IPERM = int(valmat(5))
  820. IPEVO = int(valmat(6))
  821. if (tyval(10)(9:16).eq.'EVOLUTIO') then
  822. TYPRET = 'EVOLUTIO'
  823. endif
  824. if (valmat(/1).gt.6) then
  825. xamon = valmat(7)
  826. if (valmat(7).gt.0) MONAMO='FLOTTANT'
  827. if (valmat(8).gt.0) LELAS = .true.
  828. endif
  829.  
  830. IF (IERR.NE.0) RETURN
  831.  
  832. IF (LPERM) THEN
  833. IF (LELAS.AND.(.NOT.LECRO)) IPERM = -2
  834. IF (MONECR.EQ.'ISOTROPE'.AND.(.NOT.LELAS)) IPERM = 2
  835. IF (MONECR.EQ.'CINEMATIQUE'.AND.(.NOT.LELAS)) IPERM = 3
  836. IF (.NOT.(XJEU.EQ.0.)) THEN
  837. * WRITE(*,*) 'Liaison permanente, mise a zero du jeu.'
  838. XJEU = 0.D0
  839. ENDIF
  840. ELSE
  841. IF (.NOT.LECRO) THEN
  842. IF (LELAS) THEN
  843. IPERM = -1
  844. ELSE
  845. IPERM = 1
  846. ENDIF
  847. ENDIF
  848. ENDIF
  849. IF (IPERM.EQ.0) THEN
  850. CALL ERREUR(905)
  851. RETURN
  852. ENDIF
  853. *
  854. MEVOLL = IPEVO
  855. *
  856. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  857. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  858. * des tableaux xabsci et xordon
  859. *
  860. SEGACT MEVOLL
  861. KEVOLL = IEVOLL(1)
  862. SEGACT KEVOLL
  863. MLREE1 = IPROGX
  864. MLREE2 = IPROGY
  865. SEGACT MLREE1
  866. SEGACT MLREE2
  867. * NIP = MLREE1.PROG(/1)
  868. NIP = XABSCI(/2)
  869. *
  870. DO 110 MM=1,NIP
  871. XABSCI (I,MM) = MLREE1.PROG(MM)
  872. XORDON (I,MM) = MLREE2.PROG(MM)
  873. 110 CONTINUE
  874. *
  875. SEGDES MLREE1
  876. SEGDES MLREE2
  877. SEGDES KEVOLL
  878. SEGDES MEVOLL
  879. *
  880. IPALB(I,1) = ITYP
  881. IPALB(I,3) = IDIM
  882. IPALB(I,5) = IPERM
  883. XPALB(I,1) = XJEU
  884. *
  885. * normalisation de l'axe de rotation
  886. *
  887. IPNV = (IDIM + 1) * (IPOI - 1)
  888. PS = 0.D0
  889. DO 120 ID = 1,IDIM
  890. XC = XCOOR(IPNV + ID)
  891. PS = PS + XC * XC
  892. 120 CONTINUE
  893. * end do
  894. IF (PS.LE.0.D0) THEN
  895. CALL ERREUR(162)
  896. RETURN
  897. ENDIF
  898. IF (MONAMO.EQ.'FLOTTANT') THEN
  899. IPALB(I,1) = 51
  900. XPALB(I,2) = XAMON
  901. DO 122 ID = 1,IDIM
  902. ID2 = 2 + ID
  903. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  904. 122 CONTINUE
  905. * end do
  906. ELSE
  907. DO 124 ID = 1,IDIM
  908. ID2 = 1 + ID
  909. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  910. 124 CONTINUE
  911. * end do
  912. ENDIF
  913. *
  914. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  915. IPLIB(I,1) = IPLAC
  916. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  917. IPLIB(I,2) = IPLAC
  918. *
  919. *
  920. else if(cmatee.eq.'PO_PO') then
  921. ITYP = 11
  922. MARAID = ' '
  923. MONPER = ' '
  924. LPERM = .FALSE.
  925. IPERM = 0
  926. MONAMO = ' '
  927. TYPRET = ' '
  928. IPOI = int(valmat(1))
  929. XRAID = valmat(2)
  930. if (valmat(2).gt.0) MARAID = 'FLOTTANT'
  931. XJEU = valmat(3)
  932. INOB = int(valmat(4))
  933. IPERM = int(valmat(5))
  934. if (IPERM.gt.0) LPERM = .true.
  935. if (valmat(/1).gt.5) then
  936. xamon = valmat(6)
  937. if (valmat(6).gt.0) MONAMO='FLOTTANT'
  938. IPEVO = int(valmat(7))
  939. if (tyval(7)(9:16).eq.'EVOLUTIO') then
  940. TYPRET = 'EVOLUTIO'
  941. endif
  942.  
  943. endif
  944.  
  945. IF (IERR.NE.0) RETURN
  946.  
  947. IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN
  948. CALL ERREUR(891)
  949. RETURN
  950. ENDIF
  951. *
  952. IF (TYPRET.EQ.'EVOLUTIO') THEN
  953. ITYP = 111
  954. XRAID = 0.d0
  955. ENDIF
  956.  
  957. IPALB(I,1) = ITYP
  958. IPALB(I,3) = IDIM
  959. IPALB(I,4) = IPERM
  960. XPALB(I,1) = XRAID
  961. XPALB(I,2) = XJEU
  962. *
  963. * normalisation de la normale
  964. *
  965. IPNV = (IDIM + 1) * (IPOI - 1)
  966. PS = 0.D0
  967. DO 111 ID = 1,IDIM
  968. XC = XCOOR(IPNV + ID)
  969. PS = PS + XC * XC
  970. 111 CONTINUE
  971. * end do
  972. IF (PS.LE.0.D0) THEN
  973. CALL ERREUR(162)
  974. RETURN
  975. ENDIF
  976. IF (MONAMO.EQ.'FLOTTANT') THEN
  977. XPALB(I,3) = XAMON
  978. ELSE
  979. XPALB(I,3) = 0.d0
  980. ENDIF
  981. DO 112 ID = 1,IDIM
  982. ID2 = 3 + ID
  983. XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS)
  984. 112 CONTINUE
  985. * end do
  986. *
  987. IF (IPALB(I,1) .EQ. 111) THEN
  988. MEVOLL = IPEVO
  989. *
  990. * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe)
  991. * Ici, on recupere les abscisses et les ordonnees de l'evolution dans
  992. * des tableaux xabsci et xordon
  993. *
  994. SEGACT MEVOLL
  995. KEVOLL = IEVOLL(1)
  996. SEGACT KEVOLL
  997. MLREE1 = IPROGX
  998. MLREE2 = IPROGY
  999. SEGACT MLREE1
  1000. SEGACT MLREE2
  1001. NIP = XABSCI(/2)
  1002. *
  1003. DO 116 MM=1,NIP
  1004. XABSCI (I,MM) = MLREE1.PROG(MM)
  1005. XORDON (I,MM) = MLREE2.PROG(MM)
  1006. 116 CONTINUE
  1007. *
  1008. SEGDES MLREE1
  1009. SEGDES MLREE2
  1010. SEGDES KEVOLL
  1011. SEGDES MEVOLL
  1012. ENDIF
  1013. *
  1014. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  1015. IPLIB(I,1) = IPLAC
  1016. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  1017. IPLIB(I,2) = IPLAC
  1018. *
  1019. else if(cmatee.eq.'PO_CE_MO') then
  1020. ITYP = 33
  1021. MONAMO = ' '
  1022. MARAID = ' '
  1023. MONINTER = ' '
  1024. LINTER = .true.
  1025. IPOI = int(valmat(1))
  1026. xraid = valmat(2)
  1027. if (valmat(2).gt.0) MARAID = 'FLOTTANT'
  1028. INOB = int(valmat(3))
  1029. XRAYO = valmat(4)
  1030. XGLIS = valmat(5)
  1031. XADHE = valmat(6)
  1032. XRAIT = valmat(7)
  1033. XAMOT = valmat(8)
  1034. if (valmat(/1).gt.8) then
  1035. xamon = valmat(10)
  1036. if(valmat(10).gt.0) MONAMO = 'FLOTTANT'
  1037. xinter = valmat(9)
  1038. if(valmat(9).gt.0) LINTER = .FALSE.
  1039. endif
  1040.  
  1041. IF (IERR.NE.0) RETURN
  1042. IPALB(I,1) = ITYP
  1043. IPALB(I,3) = IDIM
  1044. cbp IPALB(I,4) = 1
  1045. IF (.NOT.LINTER) THEN
  1046. cbp IPALB(I,4) = 0
  1047. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1048. ITYP=ITYP+100
  1049. IPALB(I,1) = ITYP
  1050. ENDIF
  1051. XPALB(I,1) = XRAID
  1052. XPALB(I,2) = XRAYO
  1053. XPALB(I,3) = XGLIS
  1054. XPALB(I,4) = XADHE
  1055. XPALB(I,5) = XRAIT
  1056. XPALB(I,6) = XAMOT
  1057. *
  1058. * normalisation de la normale
  1059. *
  1060. IPNV = (IDIM + 1) * (IPOI - 1)
  1061. IPNOA = (IDIM + 1) * (INOA - 1)
  1062. IPNOB = (IDIM + 1) * (INOB - 1)
  1063. PS = 0.D0
  1064. DO 202 ID = 1,IDIM
  1065. XC = XCOOR(IPNV + ID)
  1066. PS = PS + XC * XC
  1067. 202 CONTINUE
  1068. ***
  1069. IF (PS.LE.0.D0) THEN
  1070. CALL ERREUR(162)
  1071. RETURN
  1072. ENDIF
  1073. IF (MONAMO.EQ.'FLOTTANT') THEN
  1074. IPALB(I,1) = 34
  1075. XPALB(I,7) = XAMON
  1076. ID1 = 7
  1077. ELSE
  1078. ID1 = 6
  1079. ENDIF
  1080. ID2 = ID1 + IDIM
  1081. DO 222 ID = 1,IDIM
  1082. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1083. XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  1084. 222 CONTINUE
  1085. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  1086. IPLIB(I,1) = IPLAC
  1087. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  1088. IPLIB(I,2) = IPLAC
  1089. *
  1090. else if(cmatee.eq.'PO_CE_FR') then
  1091. ITYP = 23
  1092. MONAMO = ' '
  1093. MARAID = ' '
  1094. MONINTER = ' '
  1095. LINTER = .true.
  1096. IPOI = int(valmat(1))
  1097. XRAIN = valmat(2)
  1098. if (valmat(2).gt.0) MARAID = 'FLOTTANT'
  1099. IEXC = int(valmat(3))
  1100. XRAYO = valmat(4)
  1101. XGLIS = valmat(5)
  1102. XADHE = valmat(6)
  1103. XRAIT = valmat(7)
  1104. XAMOT = valmat(8)
  1105. if (valmat(/1).gt.8) then
  1106. xamon = valmat(10)
  1107. if(valmat(10).gt.0) MONAMO = 'FLOTTANT'
  1108. xinter = valmat(9)
  1109. if(valmat(9).gt.0) LINTER = .FALSE.
  1110. endif
  1111.  
  1112. IF (IERR.NE.0) RETURN
  1113. *
  1114. IPALB(I,1) = ITYP
  1115. IPALB(I,3) = IDIM
  1116. cbp IPALB(I,4) = 1
  1117. IF (.NOT.LINTER) THEN
  1118. cbp IPALB(I,4) = 0
  1119. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1120. ITYP=ITYP+100
  1121. IPALB(I,1) = ITYP
  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. ***
  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. IPOI = int(valmat(1))
  1168. XRAID = valmat(2)
  1169. if (valmat(2).gt.0) MARAID = 'FLOTTANT'
  1170. IEXC = int(valmat(3))
  1171. XRAYO = valmat(4)
  1172. if (valmat(/1).gt.4) then
  1173. xamon = valmat(5)
  1174. if(valmat(5).gt.0) MONAMO = 'FLOTTANT'
  1175. endif
  1176.  
  1177. IF (IERR.NE.0) RETURN
  1178. IPALB(I,1) = ITYP
  1179. IPALB(I,3) = IDIM
  1180. XPALB(I,1) = XRAID
  1181. XPALB(I,2) = XRAYO
  1182. *
  1183. * normalisation de la normale
  1184. *
  1185. IPNV = (IDIM + 1) * (IPOI - 1)
  1186. IPEX = (IDIM + 1) * (IEXC - 1)
  1187. PS = 0.D0
  1188. DO 210 ID = 1,IDIM
  1189. XC = XCOOR(IPNV + ID)
  1190. PS = PS + XC * XC
  1191. 210 CONTINUE
  1192. IF (PS.LE.0.D0) THEN
  1193. CALL ERREUR(162)
  1194. RETURN
  1195. ENDIF
  1196. IF (MONAMO.EQ.'FLOTTANT') THEN
  1197. IPALB(I,1) = 22
  1198. XPALB(I,3) = XAMON
  1199. ID1 = 3
  1200. ELSE
  1201. ID1 = 2
  1202. ENDIF
  1203. ID2 = ID1 + IDIM
  1204. DO 212 ID = 1,IDIM
  1205. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1206. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1207. 212 CONTINUE
  1208. * end do
  1209. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1210. IPLIB(I,1) = IPLAC
  1211. *
  1212. else if(cmatee.eq.'CE_PL_FR') then
  1213. ITYP = 5
  1214. MONAMO = ' '
  1215. IPOI = int(valmat(1))
  1216. xrain = valmat(2)
  1217. XJEU = valmat(3)
  1218. MARAID = 'FLOTTANT'
  1219. XRAYP = valmat(4)
  1220. XGLIS = valmat(5)
  1221. XADHE = valmat(6)
  1222. XRAIT = valmat(7)
  1223. XAMOT = valmat(8)
  1224. xamon = valmat(9)
  1225. if (xamon.ne.0.d0) MONAMO = 'FLOTTANT'
  1226.  
  1227. IPALB(I,1) = ITYP
  1228. IPALB(I,3) = IDIM
  1229. XPALB(I,1) = XRAIN
  1230. XPALB(I,2) = XJEU
  1231. XPALB(I,3) = XGLIS
  1232. XPALB(I,4) = XADHE
  1233. XPALB(I,5) = XRAIT
  1234. XPALB(I,6) = XAMOT
  1235. *
  1236. IPNV = (IDIM + 1) * (IPOI - 1)
  1237. PS = 0.D0
  1238. DO 230 ID = 1,IDIM
  1239. XC = XCOOR(IPNV + ID)
  1240. PS = PS + XC * XC
  1241. 230 CONTINUE
  1242. * end do
  1243. IF (PS.LE.0.D0) THEN
  1244. CALL ERREUR(162)
  1245. RETURN
  1246. ENDIF
  1247. IF (MONAMO.EQ.'FLOTTANT') THEN
  1248. IPALB(I,1) = 6
  1249. XPALB(I,7) = XAMON
  1250. ID1 = 7
  1251. ELSE
  1252. ID1 = 6
  1253. ENDIF
  1254. ID8 = ID1 + 7*IDIM
  1255. XPALB(I,ID8+1) = XRAYP
  1256. DO 232 ID = 1,IDIM
  1257. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1258. 232 CONTINUE
  1259. * end do
  1260. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1261. IPLIB(I,1) = IPLAC
  1262. *
  1263. else if(cmatee.eq.'CE_CE_FR') then
  1264. ITYP = 25
  1265. MONAMO = ' '
  1266. MARAID = ' '
  1267. MONINTER = ' '
  1268. LINTER = .true.
  1269. IPOI = int(valmat(1))
  1270. xrain = valmat(2)
  1271. if(valmat(2).gt.0) MARAID = 'FLOTTANT'
  1272. IEXC = int(valmat(3))
  1273. XRAYP = valmat(4)
  1274. XGLIS = valmat(5)
  1275. XADHE = valmat(6)
  1276. XRAIT = valmat(7)
  1277. XAMOT = valmat(8)
  1278. XRAYB = valmat(9)
  1279. if(valmat(10).gt.0) then
  1280. xamon = valmat(10)
  1281. if (valmat(10).gt.0) MONAMO = 'FLOTTANT'
  1282. xinter = valmat(11)
  1283. if (valmat(11).gt.0) LINTER = .false.
  1284. endif
  1285.  
  1286. IF (IERR.NE.0) RETURN
  1287. *
  1288. IPALB(I,1) = ITYP
  1289. IPALB(I,3) = IDIM
  1290. cbp IPALB(I,4) = 1
  1291. IF (.NOT.LINTER) THEN
  1292. cbp IPALB(I,4) = 0
  1293. cbp : on laisse IPALB(I,4) pour les liaisons conditionnelles
  1294. ITYP=ITYP+100
  1295. IPALB(I,1) = ITYP
  1296. ENDIF
  1297. XPALB(I,1) = XRAIN
  1298. XPALB(I,2) = XRAYB
  1299. XPALB(I,3) = XGLIS
  1300. XPALB(I,4) = XADHE
  1301. XPALB(I,5) = XRAIT
  1302. XPALB(I,6) = XAMOT
  1303. *
  1304. * normalisation de la normale
  1305. *
  1306. IPNV = (IDIM + 1) * (IPOI - 1)
  1307. IPEX = (IDIM + 1) * (IEXC - 1)
  1308. PS = 0.D0
  1309. DO 330 ID = 1,IDIM
  1310. XC = XCOOR(IPNV + ID)
  1311. PS = PS + XC * XC
  1312. 330 CONTINUE
  1313. * end do
  1314. ***
  1315. IF (PS.LE.0.D0) THEN
  1316. CALL ERREUR(162)
  1317. RETURN
  1318. ENDIF
  1319. IF (MONAMO.EQ.'FLOTTANT') THEN
  1320. ID1 = 7
  1321. IPALB(I,1) = 26
  1322. XPALB(I,7) = XAMON
  1323. ELSE
  1324. ID1 = 6
  1325. ENDIF
  1326. ID10 = ID1 + 9*IDIM
  1327. XPALB(I,ID10+1) = XRAYP
  1328. ID2 = ID1 + IDIM
  1329. ID3 = ID1 + 2*IDIM
  1330. DO 332 ID = 1,IDIM
  1331. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1332. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1333. 332 CONTINUE
  1334. * end do
  1335. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1336. IPLIB(I,1) = IPLAC
  1337. *
  1338. else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then
  1339. if(cmatee.eq.'PR_PR_IN') ityp = 31
  1340. IF(cmatee.eq.'PR_PR_EX') ITYP = 32
  1341.  
  1342. INOR = int(valmat(1))
  1343. xraid = valmat(2)
  1344. MARAID = 'FLOTTANT'
  1345. IMA1 = int(valmat(3))
  1346. IMA2 = int(valmat(4))
  1347. xpuis = valmat(5)
  1348.  
  1349. IF (IERR.NE.0) RETURN
  1350. *
  1351. IPALB(I,1) = ITYP
  1352. IPALB(I,3) = IDIM
  1353. XPALB(I,1) = XRAID
  1354. XPALB(I,3) = XPUIS
  1355. ID1 = 3
  1356. IP1 = 5
  1357. *
  1358. * le maillage IMA1 est en {l{ment de type POI1
  1359. MELEME = IMA1
  1360. SEGACT MELEME
  1361. NOMBN1 = NUM(/2)
  1362. IPALB(I,4) = NOMBN1
  1363. IDP = ID1 + 5*IDIM
  1364. DO 512 IE = 1,NOMBN1
  1365. IPT = NUM(1,IE)
  1366. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1367. DO 514 ID = 1,IDIM
  1368. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1369. 514 CONTINUE
  1370. * end do
  1371. IDP = IDP + IDIM
  1372. 512 CONTINUE
  1373. * end do
  1374. SEGDES MELEME
  1375. *
  1376. * le maillage IMA2 est en {l{ment de type POI1
  1377. MELEME = IMA2
  1378. SEGACT MELEME
  1379. NOMBN2 = NUM(/2)
  1380. IPALB(I,5) = NOMBN2
  1381. DO 516 IE = 1,NOMBN2
  1382. IPT = NUM(1,IE)
  1383. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1384. DO 518 ID = 1,IDIM
  1385. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1386. 518 CONTINUE
  1387. * end do
  1388. IDP = IDP + IDIM
  1389. 516 CONTINUE
  1390. * end do
  1391. SEGDES MELEME
  1392. CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
  1393. IPLIB(I,1) = IPLAC
  1394. *
  1395. * cr{ation d'un rep}re orthonorm{ dans le plan des maillages
  1396. * le point origine est le premier point de IMA1
  1397. CALL DYNE28(INOR,ISUP,XPALB,NLIABl,I,ID1)
  1398. IF (IERR.NE.0) RETURN
  1399. *
  1400. * coefficient des droites form{es par les {l{ments de IMA1
  1401. CALL DYNE29(IPALB,XPALB,NLIABl,NOMBN1,NOMBN2,I,ID1,IP1)
  1402. *
  1403. * position initiale de IMA2 par rapport @ IMA1
  1404. CALL DYNE30(IPALB,XPALB,NLIABl,NOMBN1,NOMBN2,I,ID1,IP1)
  1405. *
  1406. * calcul de la section du profil mobile
  1407. CALL DYNE33(XPALB,IPALB,NLIABl,I,ID1,XSECT)
  1408. XPALB(I,2) = XSECT
  1409. *
  1410. *
  1411. else if(cmatee.eq.'LI_LI_FR') then
  1412. ITYP = 35
  1413. MONJEU = ' '
  1414. MONAMO = ' '
  1415. MARAID = ' '
  1416. CMOT = ' '
  1417. MONESC = ' '
  1418. MONSYM = ' '
  1419. MONREC = ' '
  1420. INOR = 0
  1421. SEGINI MLIGNE
  1422.  
  1423. *
  1424. INOR = int(valmat(1))
  1425. IMAI = int(valmat(2))
  1426. MONESC = tyval(3)(9:16)
  1427. IESC = int(valmat(3))
  1428. MELEME = IESC
  1429. SEGACT MELEME
  1430. if (num(/2).eq.1) then
  1431. MONESC = 'POINT'
  1432. IESC = num(1,1)
  1433. segdes meleme
  1434. endif
  1435. if (valmat(4).gt.0) then
  1436. if (tyval(4)(1:8).eq.'POINTEUR') then
  1437. IRAIES = int(valmat(4))
  1438. MARAID = 'CHPOINT'
  1439. else
  1440. xraide = valmat(4)
  1441. MARAID = 'FLOTTANT'
  1442. endif
  1443. endif
  1444. IPALB(I,1) = ITYP
  1445. IPALB(I,3) = IDIM
  1446. c XPALB(I,3) = XGLIS
  1447. c XPALB(I,4) = XADHE
  1448. c XPALB(I,5) = XRAIT
  1449. c XPALB(I,6) = XAMOT
  1450. XPALB(I,3) = valmat(5)
  1451. XPALB(I,4) = valmat(6)
  1452. XPALB(I,5) = valmat(7)
  1453. XPALB(I,6) = valmat(8)
  1454. xjeu = valmat(9)
  1455. if (xjeu.gt.0.) MONJEU = 'FLOTTANT'
  1456. if (valmat(10).gt.0) then
  1457. if (tyval(10)(1:8).eq.'POINTEUR') then
  1458. typret=tyval(10)(9:16)
  1459. iamoes = int(valmat(10))
  1460. MONAMO = 'CHPOINT'
  1461. else
  1462. XAMO = valmat(10)
  1463. MONAMO = 'FLOTTANT'
  1464. endif
  1465. endif
  1466. irchec = int(valmat(11))
  1467. if (irchec.gt.0) MONREC = 'MOT'
  1468. if (irchec.eq.1) CMOT(1:7)= 'GLOBALE'
  1469. isyme = int(valmat(12))
  1470. if (isyme.gt.0) MONSYM = 'MOT'
  1471. if (isyme.eq.1) CMOT1(1:7)='LOCALE'
  1472. if (isyme.eq.2) CMOT1(1:4)='VRAI'
  1473. if (isyme.eq.3) CMOT1(1:7)='GLOBALE'
  1474.  
  1475. *
  1476. IF (MONAMO.EQ.'CHPOINT') THEN
  1477. IPALB(I,1) = 36
  1478. ID1 = 7
  1479. ELSE
  1480. ID1 = 6
  1481. ENDIF
  1482. * Normale au plan
  1483. IF (IDIM.EQ.3) THEN
  1484. if (inor.eq.0) call erreur(26)
  1485. IPNO = (IDIM + 1) * (INOR - 1)
  1486. PS = 0.D0
  1487. DO 80 ID = 1,IDIM
  1488. XC = XCOOR(IPNO + ID)
  1489. PS = PS + XC * XC
  1490. 80 CONTINUE
  1491. * end do
  1492. IF (PS.LE.0.D0) THEN
  1493. CALL ERREUR(162)
  1494. RETURN
  1495. ENDIF
  1496. DO 81 ID=1,IDIM
  1497. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1498. 81 CONTINUE
  1499. ELSE
  1500. DO 82 ID=1,IDIM
  1501. XPALB(I,ID1+ID) = 0.D0
  1502. 82 CONTINUE
  1503. ENDIF
  1504. IF (MONJEU.EQ.'FLOTTANT') THEN
  1505. XPALB(I,2) = XJEU
  1506. ELSE
  1507. XPALB(I,2) = 0.D0
  1508. ENDIF
  1509. * La recherche s'effectue par defaut localement
  1510. IF (MONREC.EQ.'MOT') THEN
  1511. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1512. IPALB(I,23) = 1
  1513. ELSE
  1514. IPALB(I,23) = 0
  1515. ENDIF
  1516. ELSE
  1517. IPALB(I,23) = 0
  1518. ENDIF
  1519. * Coordonnees du maillage_maitre
  1520. MELEME = IMAI
  1521. SEGACT MELEME
  1522. * Pour savoir si le contour est ferme
  1523. NELEMA = NUM(/2)
  1524. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1525. NNOEMA = NELEMA
  1526. IFERMA = 1
  1527. ELSE
  1528. NNOEMA = NELEMA +1
  1529. IFERMA = 0
  1530. ENDIF
  1531. IPALB(I,21) = NNOEMA
  1532. IPALB(I,24) = IFERMA
  1533. ID2 = ID1 + 4*IDIM
  1534. IPT = NUM(1,1)
  1535. INPT = (IDIM+1)*(IPT-1)
  1536. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1537. IPLIB(I,1) = IPLAC
  1538. KPLIB(1) = IPT
  1539. DO 84 ID=1,IDIM
  1540. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1541. 84 CONTINUE
  1542. DO 85 IE=1,(NNOEMA-1)
  1543. IPT = NUM(2,IE)
  1544. INPT = (IDIM+1)*(IPT-1)
  1545. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1546. IPLIB(I,IE+1) = IPLAC
  1547. KPLIB(IE+1) = IPT
  1548. IDIE = ID2 + IE*IDIM
  1549. DO 86 ID=1,IDIM
  1550. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1551. 86 CONTINUE
  1552. 85 CONTINUE
  1553. SEGDES MELEME
  1554. * Maillage_esclave
  1555. ID3 = ID2 + NNOEMA*IDIM
  1556. IF (MONESC.EQ.'POINT') THEN
  1557. * La ligne esclave est un point
  1558. NNOEES=1
  1559. IFERES=0
  1560. ISYMET=-1
  1561. * Lecture des coordonnees
  1562. IPESC = (IDIM+1)*(IESC-1)
  1563. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1564. IPLIB(I,NNOEMA+1) = IPLAC
  1565. KPLIB(NNOEMA+1) = IESC
  1566. DO 90 ID = 1,IDIM
  1567. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1568. 90 CONTINUE
  1569. *
  1570. IPALB(I,22) = NNOEES
  1571. IPALB(I,25) = IFERES
  1572. IPALB(I,26) = ISYMET
  1573. ELSE
  1574. IF (MONESC.EQ.'MAILLAGE') THEN
  1575. * La ligne esclave est un maillage
  1576. MELEME = IESC
  1577. SEGACT MELEME
  1578. * Pour savoir si le contour est ferme
  1579. NELEES = NUM(/2)
  1580. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1581. NNOEES = NELEES
  1582. IFERES = 1
  1583. ELSE
  1584. NNOEES = NELEES +1
  1585. IFERES = 0
  1586. ENDIF
  1587. IPALB(I,22) = NNOEES
  1588. IPALB(I,25) = IFERES
  1589. * Coordonnees du maillage_esclave
  1590. IPT = NUM(1,1)
  1591. INPT = (IDIM+1)*(IPT-1)
  1592. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1593. IPLIB(I,NNOEMA+1) = IPLAC
  1594. KPLIB(NNOEMA+1) = IPT
  1595. DO 94 ID=1,IDIM
  1596. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1597. 94 CONTINUE
  1598. DO 95 IE=1,(NNOEES-1)
  1599. IPT = NUM(2,IE)
  1600. INPT = (IDIM+1)*(IPT-1)
  1601. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1602. IPLIB(I,NNOEMA+IE+1) = IPLAC
  1603. KPLIB(NNOEMA+IE+1) = IPT
  1604. IDIE = ID3 + IE*IDIM
  1605. DO 96 ID=1,IDIM
  1606. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1607. 96 CONTINUE
  1608. 95 CONTINUE
  1609. SEGDES MELEME
  1610. * Le traitement symetrique par defaut ne s'effectue pas
  1611. IF (MONSYM.EQ.'MOT') THEN
  1612. IF (CMOT1(1:7).EQ.'LOCALE') THEN
  1613. IPALB(I,26) = 1
  1614. ELSE
  1615. IF (CMOT1(1:4).EQ.'VRAI'.OR.
  1616. & CMOT1(1:7).EQ.'GLOBALE') THEN
  1617. IPALB(I,26) = 0
  1618. ELSE
  1619. IPALB(I,26) = -1
  1620. ENDIF
  1621. ENDIF
  1622. ELSE
  1623. IPALB(I,26) = -1
  1624. ENDIF
  1625. ELSE
  1626. * La ligne esclave n'est ni un point ni un maillage
  1627. * CALL ERREUR(...)
  1628. RETURN
  1629. ENDIF
  1630. ENDIF
  1631. * Lecture des chpoints de raideur et d amortissement
  1632. * Raideurs des noeuds esclaves et maitres
  1633. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1634. MCHPOI=IRAIES
  1635. SEGACT,MCHPOI
  1636. NSOUP=IPCHP(/1)
  1637. DO 700 IPC=1,NSOUP
  1638. MSOUPO=IPCHP(IPC)
  1639. SEGACT,MSOUPO
  1640. MELEME = IGEOC
  1641. SEGACT,MELEME
  1642. MPOVAL = IPOVAL
  1643. SEGACT,MPOVAL
  1644. NNN = NUM(/2)
  1645. DO 711 INN=1,NNN
  1646. IPT = NUM(1,INN)
  1647. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1648. IF (IPLAC.NE.0) THEN
  1649. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1650. ENDIF
  1651. 711 CONTINUE
  1652. SEGDES,MPOVAL,MELEME
  1653. SEGDES MSOUPO
  1654. 700 CONTINUE
  1655. SEGDES,MCHPOI
  1656. * Amortissement des noeuds esclaves et maitres
  1657. ID5=ID4+NNOEMA+NNOEES
  1658. IF (IPALB(I,1).EQ.36) THEN
  1659. MCHPOI=IAMOES
  1660. SEGACT,MCHPOI
  1661. NSOUP = IPCHP(/1)
  1662. DO 121 IPC=1,NSOUP
  1663. MSOUPO=IPCHP(IPC)
  1664. SEGACT,MSOUPO
  1665. MELEME = IGEOC
  1666. SEGACT,MELEME
  1667. MPOVAL = IPOVAL
  1668. SEGACT,MPOVAL
  1669. NNN=NUM(/2)
  1670. DO 130 INN=1,NNN
  1671. IPT = NUM(1,INN)
  1672. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1673. IF (IPLAC.NE.0) THEN
  1674. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1675. ENDIF
  1676. 130 CONTINUE
  1677. SEGDES MPOVAL,MELEME
  1678. SEGDES MSOUPO
  1679. 121 CONTINUE
  1680. SEGDES MCHPOI
  1681. ENDIF
  1682. SEGSUP MLIGNE
  1683.  
  1684. else if(cmatee.eq.'LI_CE_FR') then
  1685. *
  1686. * --- choc élémentaire LIGNE_CERCLE_FROTTEMENT
  1687. * avec ou sans amortissement
  1688. *
  1689. ITYP = 37
  1690. MONJEU = ' '
  1691. MONAMO = ' '
  1692. MARAID = ' '
  1693. CMOT = ' '
  1694. MONESC = ' '
  1695. MONSYM = ' '
  1696. MONREC = ' '
  1697. INOR = 0
  1698. SEGINI MLIGNE
  1699.  
  1700. IMAI = int(valmat(2))
  1701. MONESC = tyval(3)(9:16)
  1702. IESC = int(valmat(3))
  1703. MELEME = IESC
  1704. SEGACT MELEME
  1705. if (num(/2).eq.1) then
  1706. MONESC = 'POINT'
  1707. IESC = num(1,1)
  1708. segdes meleme
  1709. endif
  1710. IRAIES = int(valmat(4))
  1711. XGLIS = valmat(5)
  1712. XADHE = valmat(6)
  1713. XRAIT = valmat(7)
  1714. XAMOT = valmat(8)
  1715. *
  1716. if (valmat(/1).gt.8) MONAMO = tyval(9)(9:16)
  1717. IAMOES = int(valmat(9))
  1718. *
  1719. if (valmat(/1).gt.8) MONREC = tyval(10)
  1720. iorec = int(valmat(10))
  1721. if (iorec.eq.1) CMOT='VRAI'
  1722. *
  1723. if (valmat(/1).gt.8) MONRAY = tyval(11)
  1724. XRAY = valmat(11)
  1725.  
  1726. if (valmat(/1).gt.8) MONCAL = tyval(12)
  1727. iotnor = int(valmat(12))
  1728. if (iotnor.eq.1) CMOT2='VRAI'
  1729. *
  1730. IPALB(I,1) = ITYP
  1731. IPALB(I,3) = IDIM
  1732. XPALB(I,3) = XGLIS
  1733. XPALB(I,4) = XADHE
  1734. XPALB(I,5) = XRAIT
  1735. XPALB(I,6) = XAMOT
  1736. *
  1737. IF (MONCAL.EQ.'ENTIER') THEN
  1738. IF (CMOT2(1:4).EQ.'VRAI') THEN
  1739. IPALB(I,1)=39
  1740. ENDIF
  1741. ENDIF
  1742.  
  1743.  
  1744. IF (MONAMO.EQ.'CHPOINT') THEN
  1745. IPALB(I,1) = IPALB(I,1)+1
  1746. ID1 = 7
  1747. ELSE
  1748. ID1 = 6
  1749. ENDIF
  1750.  
  1751.  
  1752. * Normale aux butees ou au cylindre enveloppant le segment
  1753. IF (IDIM.EQ.3) THEN
  1754. INOR = int(valmat(1))
  1755. IF (IERR.NE.0) RETURN
  1756. IPNO = (IDIM + 1) * (INOR - 1)
  1757. PS = 0.D0
  1758. DO 3780 ID = 1,IDIM
  1759. XC = XCOOR(IPNO + ID)
  1760. PS = PS + XC * XC
  1761. 3780 CONTINUE
  1762. * end do
  1763. IF (PS.LE.0.D0) THEN
  1764. CALL ERREUR(162)
  1765. RETURN
  1766. ENDIF
  1767. DO 3781 ID=1,IDIM
  1768. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1769. 3781 CONTINUE
  1770. ELSE
  1771. DO 3782 ID=1,IDIM
  1772. XPALB(I,ID1+ID) = 0.D0
  1773. 3782 CONTINUE
  1774. ENDIF
  1775. IF (MONRAY.EQ.'FLOTTANT') THEN
  1776. XPALB(I,2) = XRAY
  1777. ELSE
  1778. XPALB(I,2) = 0.D0
  1779. ENDIF
  1780. * La recherche s'effectue par défaut localement
  1781. IF (MONREC.EQ.'MOT') THEN
  1782. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1783. IPALB(I,23) = 1
  1784. ELSE
  1785. IPALB(I,23) = 0
  1786. ENDIF
  1787. ELSE
  1788. IPALB(I,23) = 0
  1789. ENDIF
  1790. *
  1791. * Coordonnées du maillage_maitre
  1792. MELEME = IMAI
  1793.  
  1794. SEGACT MELEME
  1795.  
  1796.  
  1797. * Pour savoir si le contour est fermé
  1798. NELEMA = NUM(/2)
  1799. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1800. NNOEMA = NELEMA
  1801. IFERMA = 1
  1802. ELSE
  1803. NNOEMA = NELEMA +1
  1804. IFERMA = 0
  1805. ENDIF
  1806. IPALB(I,21) = NNOEMA
  1807. IPALB(I,24) = IFERMA
  1808. ID2 = ID1 + 4*IDIM
  1809. IPT = NUM(1,1)
  1810. INPT = (IDIM+1)*(IPT-1)
  1811. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1812. IPLIB(I,1) = IPLAC
  1813. KPLIB(1) = IPT
  1814. DO 3784 ID=1,IDIM
  1815. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1816. 3784 CONTINUE
  1817. DO 3785 IE=1,(NNOEMA-1)
  1818. IPT = NUM(2,IE)
  1819. INPT = (IDIM+1)*(IPT-1)
  1820. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1821. IPLIB(I,IE+1) = IPLAC
  1822. KPLIB(IE+1) = IPT
  1823. IDIE = ID2 + IE*IDIM
  1824. DO 3786 ID=1,IDIM
  1825. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1826. 3786 CONTINUE
  1827. 3785 CONTINUE
  1828. SEGDES MELEME
  1829. *
  1830. * Maillage_esclave
  1831. ID3 = ID2 + NNOEMA*IDIM
  1832. IF (MONESC.EQ.'POINT') THEN
  1833. * La ligne esclave est un point
  1834. NNOEES=1
  1835. IFERES=0
  1836. ISYMET=-1
  1837. * Lecture des coordonnées
  1838. IPESC = (IDIM+1)*(IESC-1)
  1839. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1840. IPLIB(I,NNOEMA+1) = IPLAC
  1841. KPLIB(NNOEMA+1) = IESC
  1842. DO 3790 ID = 1,IDIM
  1843. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1844. 3790 CONTINUE
  1845. *
  1846. IPALB(I,22) = NNOEES
  1847. IPALB(I,25) = IFERES
  1848. IPALB(I,26) = ISYMET
  1849. ELSE
  1850. IF (MONESC.EQ.'MAILLAGE') THEN
  1851. * La ligne esclave est un maillage
  1852. MELEME = IESC
  1853. SEGACT MELEME
  1854. * Pour savoir si le contour est fermé
  1855. NELEES = NUM(/2)
  1856. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1857. NNOEES = NELEES
  1858. IFERES = 1
  1859. ELSE
  1860. NNOEES = NELEES +1
  1861. IFERES = 0
  1862. ENDIF
  1863. IPALB(I,22) = NNOEES
  1864. IPALB(I,25) = IFERES
  1865. * Coordonnées du maillage_esclave
  1866. IPT = NUM(1,1)
  1867. INPT = (IDIM+1)*(IPT-1)
  1868. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1869. IPLIB(I,NNOEMA+1) = IPLAC
  1870. KPLIB(NNOEMA+1) = IPT
  1871. DO 3794 ID=1,IDIM
  1872. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1873. 3794 CONTINUE
  1874. DO 3795 IE=1,(NNOEES-1)
  1875. IPT = NUM(2,IE)
  1876. INPT = (IDIM+1)*(IPT-1)
  1877. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1878. IPLIB(I,NNOEMA+IE+1) = IPLAC
  1879. KPLIB(NNOEMA+IE+1) = IPT
  1880. IDIE = ID3 + IE*IDIM
  1881. DO 3796 ID=1,IDIM
  1882. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1883. 3796 CONTINUE
  1884. 3795 CONTINUE
  1885. SEGDES MELEME
  1886. MONINV=' '
  1887. if (valmat(/1).gt.8) then
  1888. if (valmat(13).gt.0) then
  1889. MONINV = 'LOGIQUE'
  1890. Lo1 = .true.
  1891. endif
  1892. else
  1893. endif
  1894. * Le traitement symétrique ne s'effectue pas PAR DÉFAUT
  1895.  
  1896. IF (MONINV.EQ.'LOGIQUE') THEN
  1897. IF (.NOT.Lo1) THEN
  1898. IPALB(I,26) = -1
  1899. ELSE
  1900. IPALB(I,26) = 0
  1901. ENDIF
  1902. ELSE
  1903. IPALB(I,26) = -1
  1904. ENDIF
  1905.  
  1906. ELSE
  1907. * La ligne esclave n'est ni un point ni un maillage
  1908. * CALL ERREUR(...)
  1909. RETURN
  1910. ENDIF
  1911. ENDIF
  1912. * Lecture des chpoints de raideur et d amortissement
  1913. * Raideurs des noeuds esclaves et maitres
  1914. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1915. MCHPOI=IRAIES
  1916. SEGACT,MCHPOI
  1917. NSOUP=IPCHP(/1)
  1918. DO 37100 IPC=1,NSOUP
  1919. MSOUPO=IPCHP(IPC)
  1920. SEGACT,MSOUPO
  1921. MELEME = IGEOC
  1922. SEGACT,MELEME
  1923. MPOVAL = IPOVAL
  1924. SEGACT,MPOVAL
  1925. NNN = NUM(/2)
  1926. DO 37110 INN=1,NNN
  1927. IPT = NUM(1,INN)
  1928. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1929. IF (IPLAC.NE.0) THEN
  1930. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1931. ENDIF
  1932. 37110 CONTINUE
  1933. SEGDES,MPOVAL,MELEME
  1934. SEGDES MSOUPO
  1935. 37100 CONTINUE
  1936. SEGDES,MCHPOI
  1937. * Amortissement des noeuds esclaves et maitres
  1938. ID5=ID4+NNOEMA+NNOEES
  1939. IF (IPALB(I,1).EQ.38 .OR. IPALB(I,1).EQ.40) THEN
  1940. MCHPOI=IAMOES
  1941. SEGACT,MCHPOI
  1942. NSOUP = IPCHP(/1)
  1943. DO 37120 IPC=1,NSOUP
  1944. MSOUPO=IPCHP(IPC)
  1945. SEGACT,MSOUPO
  1946. MELEME = IGEOC
  1947. SEGACT,MELEME
  1948. MPOVAL = IPOVAL
  1949. SEGACT,MPOVAL
  1950. NNN=NUM(/2)
  1951. DO 37130 INN=1,NNN
  1952. IPT = NUM(1,INN)
  1953. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1954. IF (IPLAC.NE.0) THEN
  1955. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1956. ENDIF
  1957. 37130 CONTINUE
  1958. SEGDES MPOVAL,MELEME
  1959. SEGDES MSOUPO
  1960. 37120 CONTINUE
  1961. SEGDES MCHPOI
  1962. ENDIF
  1963. SEGSUP MLIGNE
  1964. *
  1965.  
  1966. else if(cmatee.eq.'PA_FL_RO') then
  1967. ITYP = 60
  1968. MONMOT='RODELI'
  1969. MTLIAB = KTLIAB
  1970. *
  1971. NUML = I
  1972. IP1 = imod
  1973. IF (IERR.NE.0) RETURN
  1974. CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  1975. IPLIB(NUML,1) = IPLAC
  1976. *
  1977. * Valeurs de IPALB et XPALB communes à tous les types de
  1978. * paliers fluides :
  1979. *
  1980. IPALB(NUML,1) = ITYP
  1981. IPALB(NUML,2) = 0
  1982. IPALB(NUML,3) = 3
  1983. IPALB(NUML,4) = 0
  1984. *
  1985. XPALB(NUML,4) = valmat(1)
  1986. XPALB(NUML,6) = valmat(2)
  1987. XPALB(NUML,1) = valmat(3)
  1988. XPALB(NUML,2) = valmat(4)
  1989. XPALB(NUML,3) = valmat(5)
  1990. XPALB(NUML,7) = valmat(6)
  1991. XPALB(NUML,8) = valmat(7)
  1992. XPALB(NUML,9) = valmat(8)
  1993. XPALB(NUML,5) = valmat(9)
  1994. itgeom = int(valmat(10))
  1995.  
  1996. *
  1997. IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN
  1998. * ----- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li
  1999. *
  2000. IPALB(NUML,5) = 1
  2001. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  2002. & 'ENTIER',NLOB,X1,' ',Lo1,IP1)
  2003.  
  2004. IF (IERR.NE.0) RETURN
  2005. IPALB(NUML,6) = NLOB
  2006.  
  2007. C Nombre de parametres reels :
  2008. NBPR = 6
  2009. IPALB(NUML,7) = NBPR
  2010.  
  2011. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  2012. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2013. XPALB(NUML,10) = X1
  2014.  
  2015. IF (IERR.NE.0) RETURN
  2016. DO 610 ILOB = 1, NLOB
  2017. *
  2018. CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0,
  2019. & 'TABLE',I1,X1,' ',Lo1,ITLOB)
  2020.  
  2021. IF (IERR.NE.0) RETURN
  2022. CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  2023. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2024. XPALB(NUML,11+NBPR*(ILOB-1)) = X1
  2025.  
  2026. IF (IERR.NE.0) RETURN
  2027. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  2028. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2029. XPALB(NUML,12+NBPR*(ILOB-1)) = X1
  2030.  
  2031. IF (IERR.NE.0) RETURN
  2032. CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  2033. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2034. XPALB(NUML,13+NBPR*(ILOB-1)) = X1
  2035.  
  2036. IF (IERR.NE.0) RETURN
  2037. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  2038. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2039. XPALB(NUML,14+NBPR*(ILOB-1)) = X1
  2040. ANGDEB = X1
  2041.  
  2042. IF (IERR.NE.0) RETURN
  2043. CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  2044. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2045. XPALB(NUML,15+NBPR*(ILOB-1)) = X1
  2046. AMPLIT=X1
  2047.  
  2048. IF (IERR.NE.0) RETURN
  2049. CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  2050. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2051. XPALB(NUML,16+NBPR*(ILOB-1)) = X1
  2052.  
  2053. IF (IERR.NE.0) RETURN
  2054. CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  2055. & 'ENTIER',I1,X1,' ',Lo1,IP1)
  2056. cbp2018 IPALB(NUML,7+ILOB) = I1
  2057. NMAIL=I1
  2058. CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL)
  2059. IPALB(NUML,7+ILOB) = KLREEL
  2060.  
  2061. c on ecrit ce listreel dans la table afin qu'il ne soit pas
  2062. c supprime si menage pendant l'execution (concerne pasapas)
  2063. CALL ECCTAB(ITLOB,'MOT',0,0.d0,'COSSIN',.false.,0,
  2064. & 'LISTREEL',0,0.d0,' ',.false.,KLREEL)
  2065.  
  2066. IF (IERR.NE.0) RETURN
  2067. 610 CONTINUE
  2068. ENDIF
  2069. *
  2070. else
  2071. c write(6,*) 'verifier nom liaison', cmatee
  2072. call erreur(5)
  2073. return
  2074. endif
  2075.  
  2076. *
  2077. * traiter liaisons conditionnelles
  2078. *
  2079. if (.false.) then
  2080. DO I = 1,kmodel(/1)
  2081. ksi = 0
  2082. imodel = kmodel(I)
  2083. segact imodel
  2084. if (tymode(/2).gt.0) then
  2085. do 722 ilc = 1,tymode(/2)
  2086. do j =1,kmodel(/1)
  2087. if (kmodel(j).eq.ivamod(ilc)) then
  2088. ksi = ksi + 1
  2089. ipalb(i,4) = 1
  2090. IF (tymode(ilc).EQ.'CONDINFE' ) THEN
  2091. ipalb (i,4+ksi) = j
  2092. ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN
  2093. ipalb (i,4+ksi) = -1 * j
  2094. ENDIF
  2095. endif
  2096. goto 722
  2097. enddo
  2098. 722 continue
  2099. endif
  2100. 723 continue
  2101. ENDDO
  2102. endif
  2103.  
  2104. * ranger
  2105. segdes ipt8
  2106. *
  2107. 10 CONTINUE
  2108. *
  2109. *
  2110. * ----- liaisons conditionnelles ?
  2111. *
  2112. IF (IIMPI.EQ.333) THEN
  2113. c NLIAB = IPALB(/1)
  2114. c NIPALB = IPALB(/2)
  2115. c NXPALB = XPALB(/2)
  2116. c NPLBB = IPLIB(/2)
  2117. c NPLB = JPLIB(/1)
  2118. DO 1000 IN = 1,NLIAB
  2119. DO 1002 II = 1,NIPALB
  2120. WRITE(IOIMP,*)'cYNE20 : IPALB(',IN,',',II,') =',IPALB(IN,II)
  2121. 1002 CONTINUE
  2122. DO 1004 IX = 1,NXPALB
  2123. WRITE(IOIMP,*)'cYNE20 : XPALB(',IN,',',IX,') =',XPALB(IN,IX)
  2124. 1004 CONTINUE
  2125. DO 1006 IP = 1,NPLBB
  2126. WRITE(IOIMP,*)'cYNE20 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP)
  2127. 1006 CONTINUE
  2128. 1000 CONTINUE
  2129. DO 1008 IP = 1,NPLB
  2130. WRITE(IOIMP,*)'cYNE20 : JPLIB(',IP,') =',JPLIB(IP)
  2131. 1008 CONTINUE
  2132. ENDIF
  2133. *
  2134. * remplissage MTPHI
  2135. *
  2136. NPLSB=1
  2137. SEGINI,MTPHI
  2138. KTPHI = MTPHI
  2139. MTLIAB = KTLIAB
  2140. *
  2141. c NLIAB = IPALB(/1)
  2142. c NPLB = JPLIB(/1)
  2143. c NSB = XPHILB(/1)
  2144. c NPLSB = XPHILB(/2)
  2145. c NA2 = XPHILB(/3)
  2146. c IDIMB = XPHILB(/4)
  2147. IA1 = 0
  2148.  
  2149. do IB = 1,nsstru
  2150. *
  2151. * de DYNE26.ESO
  2152. *
  2153. IORSB(IB) = IA1 + 1
  2154. IAROTA(IB) = 0
  2155. IROT = 0
  2156. IN = 0
  2157.  
  2158. do 41 ik =1,ldefo(/1)
  2159.  
  2160. if (lsstru(ik).ne.ib) goto 41
  2161. IN = IN + 1
  2162.  
  2163. IA1 = IA1 + 1
  2164.  
  2165. icdm = ldefo(ik)
  2166.  
  2167. **
  2168. * Prise en compte d'un mode de rotation de corps rigide
  2169. if (lcgra(ik).gt.0) then
  2170. ICDG = lcgra(ik)
  2171. IAROTA(IB)=IA1
  2172. IROT = IN
  2173. endif
  2174. *
  2175. *
  2176. IF (NLIAB.NE.0) THEN
  2177. DO 42 ID = 1,IDIMB
  2178. c cas AXI ou FOURIER
  2179. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  2180. CMOT = NOMAXI(ID)
  2181. ELSE
  2182. c cas PLAN
  2183. IF (IFOMOD.EQ.-1) THEN
  2184. CMOT = NOMPLA(ID)
  2185. ELSE
  2186. CMOT = NOMTRI(ID)
  2187. ENDIF
  2188. ENDIF
  2189. IF (IIMPI.EQ.333) THEN
  2190. WRITE(IOIMP,*)'DYNE26 : composante @ extraire :',CMOT
  2191. ENDIF
  2192. ICOMP = 0
  2193. DO 44 IP = 1,NPLB
  2194. IPOINT = JPLIB(IP)
  2195. *
  2196. * On extrait du chpoint ICDM au point IPOINT de composante CMOT
  2197. *
  2198. CALL EXTRA9(ICDM,IPOINT,CMOT,0,.FALSE.,XVAL,IRET)
  2199. ICOMP = ICOMP + 1
  2200. *
  2201. * on ajuste la taille si necessaire
  2202. * MP
  2203. IF(ICOMP.GT.NPLSB) THEN
  2204. NPLSB=ICOMP
  2205. SEGADJ MTPHI
  2206. ENDIF
  2207. IPLSB(IP) = ICOMP
  2208. * suite a la modif dans extra9, car on attribue une valeur meme
  2209. * si le point n'existe pas dans le chpoint
  2210. IF (XVAL.NE.0.) THEN
  2211. IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  2212. call erreur (783)
  2213. RETURN
  2214. ENDIF
  2215. IBASB(IP) = IB
  2216. ELSE
  2217. IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB
  2218. ENDIF
  2219. *
  2220. XPHILB(IB,ICOMP,IN,ID) = XVAL
  2221. IF (IIMPI.EQ.333) THEN
  2222. WRITE(IOIMP,*)'cyne20 : IPLSB(',IP,') =',IPLSB(IP)
  2223. WRITE(IOIMP,*)'cyne20 : IBASB(',IP,') =',IBASB(IP)
  2224. XVA2 = XPHILB(IB,ICOMP,IN,ID)
  2225. WRITE(IOIMP,*)'cyne20 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  2226. ENDIF
  2227.  
  2228. 44 CONTINUE
  2229. * end do
  2230. 42 CONTINUE
  2231. * end do
  2232. ENDIF
  2233. *
  2234.  
  2235. 41 continue
  2236. INMSB(IB) = IN
  2237. IN = IN + 1
  2238.  
  2239. **
  2240. * Remplissage des fausses d?form?es modales de rotations
  2241. **
  2242. 50 continue
  2243. IF (IAROTA(IB).NE.0) THEN
  2244. ** RIGIDE = .TRUE.
  2245. MERR = 0
  2246. NPLUS = IN + 1
  2247. IF (NPLUS.GT.NA2) THEN
  2248. * On r?ajuste le dimension NA2 de XPHILB
  2249. NA2 = NPLUS
  2250. SEGADJ MTPHI
  2251. ENDIF
  2252. DO 118 IP=1,NPLB
  2253. IPOINT=JPLIB(IP)
  2254. IPOS=IPLSB(IP)
  2255. IBBAS= IBASB(IP)
  2256. IF (IBBAS.EQ.IB) THEN
  2257. DO 220 ID=(IDIM+1),IDIMB
  2258. XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID)
  2259. 220 CONTINUE
  2260. * En tridimensionnel l'axe de rotation est le vecteur propre de rotation
  2261. * On norme l axe du plan de rotation
  2262. CALL DYNE41(XAXROT,MERR,IDIM)
  2263. * En bidimensionnel l'axe de rotation est fixe
  2264. * Calcul des fausses d?form?es modales de rotation
  2265. CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  2266. DO 622 ID =1,IDIMB
  2267. XPHILB(IB,IPOS,IN,ID) = XROTA(1,ID)
  2268. XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID)
  2269. 622 CONTINUE
  2270. ENDIF
  2271. 118 CONTINUE
  2272. ENDIF
  2273. IF (IIMPI.EQ.333) THEN
  2274. WRITE(IOIMP,*)'DYNE26 : INMSB(',IB,') =',INMSB(IB)
  2275. WRITE(IOIMP,*)'DYNE26 : IORSB(',IB,') =',IORSB(IB)
  2276. WRITE(IOIMP,*)'DYNE26 : IAROTA(',IB,') =',IAROTA(IB)
  2277. ENDIF
  2278. *
  2279. IF (IERR.NE.0) RETURN
  2280. * fin boucle sousstructure
  2281. enddo
  2282.  
  2283. RETURN
  2284. END
  2285.  
  2286.  
  2287.  
  2288.  
  2289.  
  2290.  
  2291.  
  2292.  
  2293.  
  2294.  
  2295.  
  2296.  

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