Télécharger cyne20.eso

Retour à la liste

Numérotation des lignes :

  1. C CYNE20 SOURCE BP208322 17/03/01 21:16:48 9325
  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. * Op�rateur 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. * Param�tres: *
  15. * *
  16. * e ILIB Table rassemblant la description des liaisons *
  17. * es KTLIAB Segment descriptif des liaisons sur la base B. *
  18. * *
  19. * *
  20. * Param�tres de dimensionnement pour une liaison sur base: *
  21. * *
  22. * NIPALB : nombre de param�tres pour d�finir le type des *
  23. * liaisons (NIPALB est fix� � 3). *
  24. * NXPALB : nombre maxi de param�tres internes d�finissant 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) : param�tres 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) : num�ro global des points. *
  43. * IPLIB(NLIAB,NPLBB) : num�ros locaux des points concern�s par *
  44. * la liaison. *
  45. * *
  46. * Icorres Pour garder le numero du pointeur des tables de *
  47. * liaison *
  48. * *
  49. * *
  50. * Auteur, date de cr�ation: *
  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. IPALB(I,4) = 1
  1045. IF (.NOT.LINTER) THEN
  1046. IPALB(I,4) = 0
  1047. ENDIF
  1048. XPALB(I,1) = XRAID
  1049. XPALB(I,2) = XRAYO
  1050. XPALB(I,3) = XGLIS
  1051. XPALB(I,4) = XADHE
  1052. XPALB(I,5) = XRAIT
  1053. XPALB(I,6) = XAMOT
  1054. *
  1055. * normalisation de la normale
  1056. *
  1057. IPNV = (IDIM + 1) * (IPOI - 1)
  1058. IPNOA = (IDIM + 1) * (INOA - 1)
  1059. IPNOB = (IDIM + 1) * (INOB - 1)
  1060. PS = 0.D0
  1061. DO 202 ID = 1,IDIM
  1062. XC = XCOOR(IPNV + ID)
  1063. PS = PS + XC * XC
  1064. 202 CONTINUE
  1065. ***
  1066. IF (PS.LE.0.D0) THEN
  1067. CALL ERREUR(162)
  1068. RETURN
  1069. ENDIF
  1070. IF (MONAMO.EQ.'FLOTTANT') THEN
  1071. IPALB(I,1) = 34
  1072. XPALB(I,7) = XAMON
  1073. ID1 = 7
  1074. ELSE
  1075. ID1 = 6
  1076. ENDIF
  1077. ID2 = ID1 + IDIM
  1078. DO 222 ID = 1,IDIM
  1079. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1080. XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
  1081. 222 CONTINUE
  1082. CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
  1083. IPLIB(I,1) = IPLAC
  1084. CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
  1085. IPLIB(I,2) = IPLAC
  1086. *
  1087. else if(cmatee.eq.'PO_CE_FR') then
  1088. ITYP = 23
  1089. MONAMO = ' '
  1090. MARAID = ' '
  1091. MONINTER = ' '
  1092. LINTER = .true.
  1093. IPOI = int(valmat(1))
  1094. XRAIN = valmat(2)
  1095. if (valmat(2).gt.0) MARAID = 'FLOTTANT'
  1096. IEXC = int(valmat(3))
  1097. XRAYO = valmat(4)
  1098. XGLIS = valmat(5)
  1099. XADHE = valmat(6)
  1100. XRAIT = valmat(7)
  1101. XAMOT = valmat(8)
  1102. if (valmat(/1).gt.8) then
  1103. xamon = valmat(10)
  1104. if(valmat(10).gt.0) MONAMO = 'FLOTTANT'
  1105. xinter = valmat(9)
  1106. if(valmat(9).gt.0) LINTER = .FALSE.
  1107. endif
  1108.  
  1109. IF (IERR.NE.0) RETURN
  1110. *
  1111. IPALB(I,1) = ITYP
  1112. IPALB(I,3) = IDIM
  1113. IPALB(I,4) = 1
  1114. IF (.NOT.LINTER) THEN
  1115. IPALB(I,4) = 0
  1116. ENDIF
  1117. XPALB(I,1) = XRAIN
  1118. XPALB(I,2) = XRAYO
  1119. XPALB(I,3) = XGLIS
  1120. XPALB(I,4) = XADHE
  1121. XPALB(I,5) = XRAIT
  1122. XPALB(I,6) = XAMOT
  1123. *
  1124. * normalisation de la normale
  1125. *
  1126. IPNV = (IDIM + 1) * (IPOI - 1)
  1127. IPEX = (IDIM + 1) * (IEXC - 1)
  1128. PS = 0.D0
  1129. DO 320 ID = 1,IDIM
  1130. XC = XCOOR(IPNV + ID)
  1131. PS = PS + XC * XC
  1132. 320 CONTINUE
  1133. ***
  1134. * end do
  1135. IF (PS.LE.0.D0) THEN
  1136. CALL ERREUR(162)
  1137. RETURN
  1138. ENDIF
  1139. IF (MONAMO.EQ.'FLOTTANT') THEN
  1140. IPALB(I,1) = 24
  1141. XPALB(I,7) = XAMON
  1142. ID1 = 7
  1143. ELSE
  1144. ID1 = 6
  1145. ENDIF
  1146. ID2 = ID1 + IDIM
  1147. DO 322 ID = 1,IDIM
  1148. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1149. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1150. 322 CONTINUE
  1151. * end do
  1152. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1153. IPLIB(I,1) = IPLAC
  1154. *
  1155. else if(cmatee.eq.'PO_CE') then
  1156. ITYP = 21
  1157. MARAID = ' '
  1158. MONPER = ' '
  1159. MONAMO = ' '
  1160. TYPRET = ' '
  1161. IPOI = int(valmat(1))
  1162. XRAID = valmat(2)
  1163. if (valmat(2).gt.0) MARAID = 'FLOTTANT'
  1164. IEXC = int(valmat(3))
  1165. XRAYO = valmat(4)
  1166. if (valmat(/1).gt.4) then
  1167. xamon = valmat(5)
  1168. if(valmat(5).gt.0) MONAMO = 'FLOTTANT'
  1169. endif
  1170.  
  1171. IF (IERR.NE.0) RETURN
  1172. IPALB(I,1) = ITYP
  1173. IPALB(I,3) = IDIM
  1174. XPALB(I,1) = XRAID
  1175. XPALB(I,2) = XRAYO
  1176. *
  1177. * normalisation de la normale
  1178. *
  1179. IPNV = (IDIM + 1) * (IPOI - 1)
  1180. IPEX = (IDIM + 1) * (IEXC - 1)
  1181. PS = 0.D0
  1182. DO 210 ID = 1,IDIM
  1183. XC = XCOOR(IPNV + ID)
  1184. PS = PS + XC * XC
  1185. 210 CONTINUE
  1186. IF (PS.LE.0.D0) THEN
  1187. CALL ERREUR(162)
  1188. RETURN
  1189. ENDIF
  1190. IF (MONAMO.EQ.'FLOTTANT') THEN
  1191. IPALB(I,1) = 22
  1192. XPALB(I,3) = XAMON
  1193. ID1 = 3
  1194. ELSE
  1195. ID1 = 2
  1196. ENDIF
  1197. ID2 = ID1 + IDIM
  1198. DO 212 ID = 1,IDIM
  1199. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1200. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1201. 212 CONTINUE
  1202. * end do
  1203. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1204. IPLIB(I,1) = IPLAC
  1205. *
  1206. else if(cmatee.eq.'CE_PL_FR') then
  1207. ITYP = 5
  1208. MONAMO = ' '
  1209. IPOI = int(valmat(1))
  1210. xrain = valmat(2)
  1211. XJEU = valmat(3)
  1212. MARAID = 'FLOTTANT'
  1213. XRAYP = valmat(4)
  1214. XGLIS = valmat(5)
  1215. XADHE = valmat(6)
  1216. XRAIT = valmat(7)
  1217. XAMOT = valmat(8)
  1218. xamon = valmat(9)
  1219. if (xamon.ne.0.d0) MONAMO = 'FLOTTANT'
  1220.  
  1221. IPALB(I,1) = ITYP
  1222. IPALB(I,3) = IDIM
  1223. XPALB(I,1) = XRAIN
  1224. XPALB(I,2) = XJEU
  1225. XPALB(I,3) = XGLIS
  1226. XPALB(I,4) = XADHE
  1227. XPALB(I,5) = XRAIT
  1228. XPALB(I,6) = XAMOT
  1229. *
  1230. IPNV = (IDIM + 1) * (IPOI - 1)
  1231. PS = 0.D0
  1232. DO 230 ID = 1,IDIM
  1233. XC = XCOOR(IPNV + ID)
  1234. PS = PS + XC * XC
  1235. 230 CONTINUE
  1236. * end do
  1237. IF (PS.LE.0.D0) THEN
  1238. CALL ERREUR(162)
  1239. RETURN
  1240. ENDIF
  1241. IF (MONAMO.EQ.'FLOTTANT') THEN
  1242. IPALB(I,1) = 6
  1243. XPALB(I,7) = XAMON
  1244. ID1 = 7
  1245. ELSE
  1246. ID1 = 6
  1247. ENDIF
  1248. ID8 = ID1 + 7*IDIM
  1249. XPALB(I,ID8+1) = XRAYP
  1250. DO 232 ID = 1,IDIM
  1251. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1252. 232 CONTINUE
  1253. * end do
  1254. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1255. IPLIB(I,1) = IPLAC
  1256. *
  1257. else if(cmatee.eq.'CE_CE_FR') then
  1258. ITYP = 25
  1259. MONAMO = ' '
  1260. MARAID = ' '
  1261. MONINTER = ' '
  1262. LINTER = .true.
  1263. IPOI = int(valmat(1))
  1264. xrain = valmat(2)
  1265. if(valmat(2).gt.0) MARAID = 'FLOTTANT'
  1266. IEXC = int(valmat(3))
  1267. XRAYP = valmat(4)
  1268. XGLIS = valmat(5)
  1269. XADHE = valmat(6)
  1270. XRAIT = valmat(7)
  1271. XAMOT = valmat(8)
  1272. XRAYB = valmat(9)
  1273. if(valmat(10).gt.0) then
  1274. xamon = valmat(10)
  1275. if (valmat(10).gt.0) MONAMO = 'FLOTTANT'
  1276. xinter = valmat(11)
  1277. if (valmat(11).gt.0) LINTER = .false.
  1278. endif
  1279.  
  1280. IF (IERR.NE.0) RETURN
  1281. *
  1282. IPALB(I,1) = ITYP
  1283. IPALB(I,3) = IDIM
  1284. IPALB(I,4) = 1
  1285. IF (.NOT.LINTER) THEN
  1286. IPALB(I,4) = 0
  1287. ENDIF
  1288. XPALB(I,1) = XRAIN
  1289. XPALB(I,2) = XRAYB
  1290. XPALB(I,3) = XGLIS
  1291. XPALB(I,4) = XADHE
  1292. XPALB(I,5) = XRAIT
  1293. XPALB(I,6) = XAMOT
  1294. *
  1295. * normalisation de la normale
  1296. *
  1297. IPNV = (IDIM + 1) * (IPOI - 1)
  1298. IPEX = (IDIM + 1) * (IEXC - 1)
  1299. PS = 0.D0
  1300. DO 330 ID = 1,IDIM
  1301. XC = XCOOR(IPNV + ID)
  1302. PS = PS + XC * XC
  1303. 330 CONTINUE
  1304. * end do
  1305. ***
  1306. IF (PS.LE.0.D0) THEN
  1307. CALL ERREUR(162)
  1308. RETURN
  1309. ENDIF
  1310. IF (MONAMO.EQ.'FLOTTANT') THEN
  1311. ID1 = 7
  1312. IPALB(I,1) = 26
  1313. XPALB(I,7) = XAMON
  1314. ELSE
  1315. ID1 = 6
  1316. ENDIF
  1317. ID10 = ID1 + 9*IDIM
  1318. XPALB(I,ID10+1) = XRAYP
  1319. ID2 = ID1 + IDIM
  1320. ID3 = ID1 + 2*IDIM
  1321. DO 332 ID = 1,IDIM
  1322. XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
  1323. XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
  1324. 332 CONTINUE
  1325. * end do
  1326. CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
  1327. IPLIB(I,1) = IPLAC
  1328. *
  1329. else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then
  1330. if(cmatee.eq.'PR_PR_IN') ityp = 31
  1331. IF(cmatee.eq.'PR_PR_EX') ITYP = 32
  1332.  
  1333. INOR = int(valmat(1))
  1334. xraid = valmat(2)
  1335. MARAID = 'FLOTTANT'
  1336. IMA1 = int(valmat(3))
  1337. IMA2 = int(valmat(4))
  1338. xpuis = valmat(5)
  1339.  
  1340. IF (IERR.NE.0) RETURN
  1341. *
  1342. IPALB(I,1) = ITYP
  1343. IPALB(I,3) = IDIM
  1344. XPALB(I,1) = XRAID
  1345. XPALB(I,3) = XPUIS
  1346. ID1 = 3
  1347. IP1 = 5
  1348. *
  1349. * le maillage IMA1 est en {l{ment de type POI1
  1350. MELEME = IMA1
  1351. SEGACT MELEME
  1352. NOMBN1 = NUM(/2)
  1353. IPALB(I,4) = NOMBN1
  1354. IDP = ID1 + 5*IDIM
  1355. DO 512 IE = 1,NOMBN1
  1356. IPT = NUM(1,IE)
  1357. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1358. DO 514 ID = 1,IDIM
  1359. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1360. 514 CONTINUE
  1361. * end do
  1362. IDP = IDP + IDIM
  1363. 512 CONTINUE
  1364. * end do
  1365. SEGDES MELEME
  1366. *
  1367. * le maillage IMA2 est en {l{ment de type POI1
  1368. MELEME = IMA2
  1369. SEGACT MELEME
  1370. NOMBN2 = NUM(/2)
  1371. IPALB(I,5) = NOMBN2
  1372. DO 516 IE = 1,NOMBN2
  1373. IPT = NUM(1,IE)
  1374. INPT = ( IDIM + 1 ) * ( IPT - 1 )
  1375. DO 518 ID = 1,IDIM
  1376. XPALB(I,IDP+ID) = XCOOR(INPT + ID)
  1377. 518 CONTINUE
  1378. * end do
  1379. IDP = IDP + IDIM
  1380. 516 CONTINUE
  1381. * end do
  1382. SEGDES MELEME
  1383. CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
  1384. IPLIB(I,1) = IPLAC
  1385. *
  1386. * cr{ation d'un rep}re orthonorm{ dans le plan des maillages
  1387. * le point origine est le premier point de IMA1
  1388. CALL DYNE28(INOR,ISUP,XPALB,NLIABl,I,ID1)
  1389. IF (IERR.NE.0) RETURN
  1390. *
  1391. * coefficient des droites form{es par les {l{ments de IMA1
  1392. CALL DYNE29(IPALB,XPALB,NLIABl,NOMBN1,NOMBN2,I,ID1,IP1)
  1393. *
  1394. * position initiale de IMA2 par rapport @ IMA1
  1395. CALL DYNE30(IPALB,XPALB,NLIABl,NOMBN1,NOMBN2,I,ID1,IP1)
  1396. *
  1397. * calcul de la section du profil mobile
  1398. CALL DYNE33(XPALB,IPALB,NLIABl,I,ID1,XSECT)
  1399. XPALB(I,2) = XSECT
  1400. *
  1401. *
  1402. else if(cmatee.eq.'LI_LI_FR') then
  1403. ITYP = 35
  1404. MONJEU = ' '
  1405. MONAMO = ' '
  1406. MARAID = ' '
  1407. CMOT = ' '
  1408. MONESC = ' '
  1409. MONSYM = ' '
  1410. MONREC = ' '
  1411. INOR = 0
  1412. SEGINI MLIGNE
  1413.  
  1414. *
  1415. INOR = int(valmat(1))
  1416. IMAI = int(valmat(2))
  1417. MONESC = tyval(3)(9:16)
  1418. IESC = int(valmat(3))
  1419. MELEME = IESC
  1420. SEGACT MELEME
  1421. if (num(/2).eq.1) then
  1422. MONESC = 'POINT'
  1423. IESC = num(1,1)
  1424. segdes meleme
  1425. endif
  1426. if (valmat(4).gt.0) then
  1427. if (tyval(4)(1:8).eq.'POINTEUR') then
  1428. IRAIES = int(valmat(4))
  1429. MARAID = 'CHPOINT'
  1430. else
  1431. xraide = valmat(4)
  1432. MARAID = 'FLOTTANT'
  1433. endif
  1434. endif
  1435. IPALB(I,1) = ITYP
  1436. IPALB(I,3) = IDIM
  1437. c XPALB(I,3) = XGLIS
  1438. c XPALB(I,4) = XADHE
  1439. c XPALB(I,5) = XRAIT
  1440. c XPALB(I,6) = XAMOT
  1441. XPALB(I,3) = valmat(5)
  1442. XPALB(I,4) = valmat(6)
  1443. XPALB(I,5) = valmat(7)
  1444. XPALB(I,6) = valmat(8)
  1445. xjeu = valmat(9)
  1446. if (xjeu.gt.0.) MONJEU = 'FLOTTANT'
  1447. if (valmat(10).gt.0) then
  1448. if (tyval(10)(1:8).eq.'POINTEUR') then
  1449. typret=tyval(10)(9:16)
  1450. iamoes = int(valmat(10))
  1451. MONAMO = 'CHPOINT'
  1452. else
  1453. XAMO = valmat(10)
  1454. MONAMO = 'FLOTTANT'
  1455. endif
  1456. endif
  1457. irchec = int(valmat(11))
  1458. if (irchec.gt.0) MONREC = 'MOT'
  1459. if (irchec.eq.1) CMOT(1:7)= 'GLOBALE'
  1460. isyme = int(valmat(12))
  1461. if (isyme.gt.0) MONSYM = 'MOT'
  1462. if (isyme.eq.1) CMOT1(1:7)='LOCALE'
  1463. if (isyme.eq.2) CMOT1(1:4)='VRAI'
  1464. if (isyme.eq.3) CMOT1(1:7)='GLOBALE'
  1465.  
  1466. *
  1467. IF (MONAMO.EQ.'CHPOINT') THEN
  1468. IPALB(I,1) = 36
  1469. ID1 = 7
  1470. ELSE
  1471. ID1 = 6
  1472. ENDIF
  1473. * Normale au plan
  1474. IF (IDIM.EQ.3) THEN
  1475. if (inor.eq.0) call erreur(26)
  1476. IPNO = (IDIM + 1) * (INOR - 1)
  1477. PS = 0.D0
  1478. DO 80 ID = 1,IDIM
  1479. XC = XCOOR(IPNO + ID)
  1480. PS = PS + XC * XC
  1481. 80 CONTINUE
  1482. * end do
  1483. IF (PS.LE.0.D0) THEN
  1484. CALL ERREUR(162)
  1485. RETURN
  1486. ENDIF
  1487. DO 81 ID=1,IDIM
  1488. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1489. 81 CONTINUE
  1490. ELSE
  1491. DO 82 ID=1,IDIM
  1492. XPALB(I,ID1+ID) = 0.D0
  1493. 82 CONTINUE
  1494. ENDIF
  1495. IF (MONJEU.EQ.'FLOTTANT') THEN
  1496. XPALB(I,2) = XJEU
  1497. ELSE
  1498. XPALB(I,2) = 0.D0
  1499. ENDIF
  1500. * La recherche s'effectue par d�faut localement
  1501. IF (MONREC.EQ.'MOT') THEN
  1502. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1503. IPALB(I,23) = 1
  1504. ELSE
  1505. IPALB(I,23) = 0
  1506. ENDIF
  1507. ELSE
  1508. IPALB(I,23) = 0
  1509. ENDIF
  1510. * Coordonn�es du maillage_maitre
  1511. MELEME = IMAI
  1512. SEGACT MELEME
  1513. * Pour savoir si le contour est ferm�
  1514. NELEMA = NUM(/2)
  1515. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1516. NNOEMA = NELEMA
  1517. IFERMA = 1
  1518. ELSE
  1519. NNOEMA = NELEMA +1
  1520. IFERMA = 0
  1521. ENDIF
  1522. IPALB(I,21) = NNOEMA
  1523. IPALB(I,24) = IFERMA
  1524. ID2 = ID1 + 4*IDIM
  1525. IPT = NUM(1,1)
  1526. INPT = (IDIM+1)*(IPT-1)
  1527. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1528. IPLIB(I,1) = IPLAC
  1529. KPLIB(1) = IPT
  1530. DO 84 ID=1,IDIM
  1531. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1532. 84 CONTINUE
  1533. DO 85 IE=1,(NNOEMA-1)
  1534. IPT = NUM(2,IE)
  1535. INPT = (IDIM+1)*(IPT-1)
  1536. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1537. IPLIB(I,IE+1) = IPLAC
  1538. KPLIB(IE+1) = IPT
  1539. IDIE = ID2 + IE*IDIM
  1540. DO 86 ID=1,IDIM
  1541. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1542. 86 CONTINUE
  1543. 85 CONTINUE
  1544. SEGDES MELEME
  1545. * Maillage_esclave
  1546. ID3 = ID2 + NNOEMA*IDIM
  1547. IF (MONESC.EQ.'POINT') THEN
  1548. * La ligne esclave est un point
  1549. NNOEES=1
  1550. IFERES=0
  1551. ISYMET=-1
  1552. * Lecture des coordonn�es
  1553. IPESC = (IDIM+1)*(IESC-1)
  1554. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1555. IPLIB(I,NNOEMA+1) = IPLAC
  1556. KPLIB(NNOEMA+1) = IESC
  1557. DO 90 ID = 1,IDIM
  1558. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1559. 90 CONTINUE
  1560. *
  1561. IPALB(I,22) = NNOEES
  1562. IPALB(I,25) = IFERES
  1563. IPALB(I,26) = ISYMET
  1564. ELSE
  1565. IF (MONESC.EQ.'MAILLAGE') THEN
  1566. * La ligne esclave est un maillage
  1567. MELEME = IESC
  1568. SEGACT MELEME
  1569. * Pour savoir si le contour est ferm�
  1570. NELEES = NUM(/2)
  1571. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1572. NNOEES = NELEES
  1573. IFERES = 1
  1574. ELSE
  1575. NNOEES = NELEES +1
  1576. IFERES = 0
  1577. ENDIF
  1578. IPALB(I,22) = NNOEES
  1579. IPALB(I,25) = IFERES
  1580. * Coordonn�es du maillage_esclave
  1581. IPT = NUM(1,1)
  1582. INPT = (IDIM+1)*(IPT-1)
  1583. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1584. IPLIB(I,NNOEMA+1) = IPLAC
  1585. KPLIB(NNOEMA+1) = IPT
  1586. DO 94 ID=1,IDIM
  1587. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1588. 94 CONTINUE
  1589. DO 95 IE=1,(NNOEES-1)
  1590. IPT = NUM(2,IE)
  1591. INPT = (IDIM+1)*(IPT-1)
  1592. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1593. IPLIB(I,NNOEMA+IE+1) = IPLAC
  1594. KPLIB(NNOEMA+IE+1) = IPT
  1595. IDIE = ID3 + IE*IDIM
  1596. DO 96 ID=1,IDIM
  1597. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1598. 96 CONTINUE
  1599. 95 CONTINUE
  1600. SEGDES MELEME
  1601. * Le traitement sym�trique par d�faut ne s'effectue pas
  1602. IF (MONSYM.EQ.'MOT') THEN
  1603. IF (CMOT1(1:7).EQ.'LOCALE') THEN
  1604. IPALB(I,26) = 1
  1605. ELSE
  1606. IF (CMOT1(1:4).EQ.'VRAI'.OR.
  1607. & CMOT1(1:7).EQ.'GLOBALE') THEN
  1608. IPALB(I,26) = 0
  1609. ELSE
  1610. IPALB(I,26) = -1
  1611. ENDIF
  1612. ENDIF
  1613. ELSE
  1614. IPALB(I,26) = -1
  1615. ENDIF
  1616. ELSE
  1617. * La ligne esclave n'est ni un point ni un maillage
  1618. * CALL ERREUR(...)
  1619. RETURN
  1620. ENDIF
  1621. ENDIF
  1622. * Lecture des chpoints de raideur et d amortissement
  1623. * Raideurs des noeuds esclaves et maitres
  1624. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1625. MCHPOI=IRAIES
  1626. SEGACT,MCHPOI
  1627. NSOUP=IPCHP(/1)
  1628. DO 700 IPC=1,NSOUP
  1629. MSOUPO=IPCHP(IPC)
  1630. SEGACT,MSOUPO
  1631. MELEME = IGEOC
  1632. SEGACT,MELEME
  1633. MPOVAL = IPOVAL
  1634. SEGACT,MPOVAL
  1635. NNN = NUM(/2)
  1636. DO 711 INN=1,NNN
  1637. IPT = NUM(1,INN)
  1638. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1639. IF (IPLAC.NE.0) THEN
  1640. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1641. ENDIF
  1642. 711 CONTINUE
  1643. SEGDES,MPOVAL,MELEME
  1644. SEGDES MSOUPO
  1645. 700 CONTINUE
  1646. SEGDES,MCHPOI
  1647. * Amortissement des noeuds esclaves et maitres
  1648. ID5=ID4+NNOEMA+NNOEES
  1649. IF (IPALB(I,1).EQ.36) THEN
  1650. MCHPOI=IAMOES
  1651. SEGACT,MCHPOI
  1652. NSOUP = IPCHP(/1)
  1653. DO 121 IPC=1,NSOUP
  1654. MSOUPO=IPCHP(IPC)
  1655. SEGACT,MSOUPO
  1656. MELEME = IGEOC
  1657. SEGACT,MELEME
  1658. MPOVAL = IPOVAL
  1659. SEGACT,MPOVAL
  1660. NNN=NUM(/2)
  1661. DO 130 INN=1,NNN
  1662. IPT = NUM(1,INN)
  1663. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1664. IF (IPLAC.NE.0) THEN
  1665. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1666. ENDIF
  1667. 130 CONTINUE
  1668. SEGDES MPOVAL,MELEME
  1669. SEGDES MSOUPO
  1670. 121 CONTINUE
  1671. SEGDES MCHPOI
  1672. ENDIF
  1673. SEGSUP MLIGNE
  1674.  
  1675. else if(cmatee.eq.'LI_CE_FR') then
  1676. *
  1677. * --- choc élémentaire LIGNE_CERCLE_FROTTEMENT
  1678. * avec ou sans amortissement
  1679. *
  1680. ITYP = 37
  1681. MONJEU = ' '
  1682. MONAMO = ' '
  1683. MARAID = ' '
  1684. CMOT = ' '
  1685. MONESC = ' '
  1686. MONSYM = ' '
  1687. MONREC = ' '
  1688. INOR = 0
  1689. SEGINI MLIGNE
  1690.  
  1691. IMAI = int(valmat(2))
  1692. MONESC = tyval(3)(9:16)
  1693. IESC = int(valmat(3))
  1694. MELEME = IESC
  1695. SEGACT MELEME
  1696. if (num(/2).eq.1) then
  1697. MONESC = 'POINT'
  1698. IESC = num(1,1)
  1699. segdes meleme
  1700. endif
  1701. IRAIES = int(valmat(4))
  1702. XGLIS = valmat(5)
  1703. XADHE = valmat(6)
  1704. XRAIT = valmat(7)
  1705. XAMOT = valmat(8)
  1706. *
  1707. if (valmat(/1).gt.8) MONAMO = tyval(9)(9:16)
  1708. IAMOES = int(valmat(9))
  1709. *
  1710. if (valmat(/1).gt.8) MONREC = tyval(10)
  1711. iorec = int(valmat(10))
  1712. if (iorec.eq.1) CMOT='VRAI'
  1713. *
  1714. if (valmat(/1).gt.8) MONRAY = tyval(11)
  1715. XRAY = valmat(11)
  1716.  
  1717. if (valmat(/1).gt.8) MONCAL = tyval(12)
  1718. iotnor = int(valmat(12))
  1719. if (iotnor.eq.1) CMOT2='VRAI'
  1720. *
  1721. IPALB(I,1) = ITYP
  1722. IPALB(I,3) = IDIM
  1723. XPALB(I,3) = XGLIS
  1724. XPALB(I,4) = XADHE
  1725. XPALB(I,5) = XRAIT
  1726. XPALB(I,6) = XAMOT
  1727. *
  1728. IF (MONCAL.EQ.'ENTIER') THEN
  1729. IF (CMOT2(1:4).EQ.'VRAI') THEN
  1730. IPALB(I,1)=39
  1731. ENDIF
  1732. ENDIF
  1733.  
  1734.  
  1735. IF (MONAMO.EQ.'CHPOINT') THEN
  1736. IPALB(I,1) = IPALB(I,1)+1
  1737. ID1 = 7
  1738. ELSE
  1739. ID1 = 6
  1740. ENDIF
  1741.  
  1742.  
  1743. * Normale aux butees ou au cylindre enveloppant le segment
  1744. IF (IDIM.EQ.3) THEN
  1745. INOR = int(valmat(1))
  1746. IF (IERR.NE.0) RETURN
  1747. IPNO = (IDIM + 1) * (INOR - 1)
  1748. PS = 0.D0
  1749. DO 3780 ID = 1,IDIM
  1750. XC = XCOOR(IPNO + ID)
  1751. PS = PS + XC * XC
  1752. 3780 CONTINUE
  1753. * end do
  1754. IF (PS.LE.0.D0) THEN
  1755. CALL ERREUR(162)
  1756. RETURN
  1757. ENDIF
  1758. DO 3781 ID=1,IDIM
  1759. XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS)
  1760. 3781 CONTINUE
  1761. ELSE
  1762. DO 3782 ID=1,IDIM
  1763. XPALB(I,ID1+ID) = 0.D0
  1764. 3782 CONTINUE
  1765. ENDIF
  1766. IF (MONRAY.EQ.'FLOTTANT') THEN
  1767. XPALB(I,2) = XRAY
  1768. ELSE
  1769. XPALB(I,2) = 0.D0
  1770. ENDIF
  1771. * La recherche s'effectue par défaut localement
  1772. IF (MONREC.EQ.'MOT') THEN
  1773. IF (CMOT(1:7).EQ.'GLOBALE') THEN
  1774. IPALB(I,23) = 1
  1775. ELSE
  1776. IPALB(I,23) = 0
  1777. ENDIF
  1778. ELSE
  1779. IPALB(I,23) = 0
  1780. ENDIF
  1781. *
  1782. * Coordonnées du maillage_maitre
  1783. MELEME = IMAI
  1784.  
  1785. SEGACT MELEME
  1786.  
  1787.  
  1788. * Pour savoir si le contour est fermé
  1789. NELEMA = NUM(/2)
  1790. IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN
  1791. NNOEMA = NELEMA
  1792. IFERMA = 1
  1793. ELSE
  1794. NNOEMA = NELEMA +1
  1795. IFERMA = 0
  1796. ENDIF
  1797. IPALB(I,21) = NNOEMA
  1798. IPALB(I,24) = IFERMA
  1799. ID2 = ID1 + 4*IDIM
  1800. IPT = NUM(1,1)
  1801. INPT = (IDIM+1)*(IPT-1)
  1802. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1803. IPLIB(I,1) = IPLAC
  1804. KPLIB(1) = IPT
  1805. DO 3784 ID=1,IDIM
  1806. XPALB(I,ID2+ID) = XCOOR(INPT+ID)
  1807. 3784 CONTINUE
  1808. DO 3785 IE=1,(NNOEMA-1)
  1809. IPT = NUM(2,IE)
  1810. INPT = (IDIM+1)*(IPT-1)
  1811. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1812. IPLIB(I,IE+1) = IPLAC
  1813. KPLIB(IE+1) = IPT
  1814. IDIE = ID2 + IE*IDIM
  1815. DO 3786 ID=1,IDIM
  1816. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1817. 3786 CONTINUE
  1818. 3785 CONTINUE
  1819. SEGDES MELEME
  1820. *
  1821. * Maillage_esclave
  1822. ID3 = ID2 + NNOEMA*IDIM
  1823. IF (MONESC.EQ.'POINT') THEN
  1824. * La ligne esclave est un point
  1825. NNOEES=1
  1826. IFERES=0
  1827. ISYMET=-1
  1828. * Lecture des coordonnées
  1829. IPESC = (IDIM+1)*(IESC-1)
  1830. CALL PLACE2(JPLIB,NPLB,IPLAC,IESC)
  1831. IPLIB(I,NNOEMA+1) = IPLAC
  1832. KPLIB(NNOEMA+1) = IESC
  1833. DO 3790 ID = 1,IDIM
  1834. XPALB(I,ID3+ID) = XCOOR(IPESC+ID)
  1835. 3790 CONTINUE
  1836. *
  1837. IPALB(I,22) = NNOEES
  1838. IPALB(I,25) = IFERES
  1839. IPALB(I,26) = ISYMET
  1840. ELSE
  1841. IF (MONESC.EQ.'MAILLAGE') THEN
  1842. * La ligne esclave est un maillage
  1843. MELEME = IESC
  1844. SEGACT MELEME
  1845. * Pour savoir si le contour est fermé
  1846. NELEES = NUM(/2)
  1847. IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN
  1848. NNOEES = NELEES
  1849. IFERES = 1
  1850. ELSE
  1851. NNOEES = NELEES +1
  1852. IFERES = 0
  1853. ENDIF
  1854. IPALB(I,22) = NNOEES
  1855. IPALB(I,25) = IFERES
  1856. * Coordonnées du maillage_esclave
  1857. IPT = NUM(1,1)
  1858. INPT = (IDIM+1)*(IPT-1)
  1859. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1860. IPLIB(I,NNOEMA+1) = IPLAC
  1861. KPLIB(NNOEMA+1) = IPT
  1862. DO 3794 ID=1,IDIM
  1863. XPALB(I,ID3+ID) = XCOOR(INPT+ID)
  1864. 3794 CONTINUE
  1865. DO 3795 IE=1,(NNOEES-1)
  1866. IPT = NUM(2,IE)
  1867. INPT = (IDIM+1)*(IPT-1)
  1868. CALL PLACE2(JPLIB,NPLB,IPLAC,IPT)
  1869. IPLIB(I,NNOEMA+IE+1) = IPLAC
  1870. KPLIB(NNOEMA+IE+1) = IPT
  1871. IDIE = ID3 + IE*IDIM
  1872. DO 3796 ID=1,IDIM
  1873. XPALB(I,IDIE+ID) = XCOOR(INPT+ID)
  1874. 3796 CONTINUE
  1875. 3795 CONTINUE
  1876. SEGDES MELEME
  1877. MONINV=' '
  1878. if (valmat(/1).gt.8) then
  1879. if (valmat(13).gt.0) then
  1880. MONINV = 'LOGIQUE'
  1881. Lo1 = .true.
  1882. endif
  1883. else
  1884. endif
  1885. * Le traitement symétrique ne s'effectue pas PAR DÉFAUT
  1886.  
  1887. IF (MONINV.EQ.'LOGIQUE') THEN
  1888. IF (.NOT.Lo1) THEN
  1889. IPALB(I,26) = -1
  1890. ELSE
  1891. IPALB(I,26) = 0
  1892. ENDIF
  1893. ELSE
  1894. IPALB(I,26) = -1
  1895. ENDIF
  1896.  
  1897. ELSE
  1898. * La ligne esclave n'est ni un point ni un maillage
  1899. * CALL ERREUR(...)
  1900. RETURN
  1901. ENDIF
  1902. ENDIF
  1903. * Lecture des chpoints de raideur et d amortissement
  1904. * Raideurs des noeuds esclaves et maitres
  1905. ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM
  1906. MCHPOI=IRAIES
  1907. SEGACT,MCHPOI
  1908. NSOUP=IPCHP(/1)
  1909. DO 37100 IPC=1,NSOUP
  1910. MSOUPO=IPCHP(IPC)
  1911. SEGACT,MSOUPO
  1912. MELEME = IGEOC
  1913. SEGACT,MELEME
  1914. MPOVAL = IPOVAL
  1915. SEGACT,MPOVAL
  1916. NNN = NUM(/2)
  1917. DO 37110 INN=1,NNN
  1918. IPT = NUM(1,INN)
  1919. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1920. IF (IPLAC.NE.0) THEN
  1921. XPALB(I,ID4+IPLAC)=VPOCHA(INN,1)
  1922. ENDIF
  1923. 37110 CONTINUE
  1924. SEGDES,MPOVAL,MELEME
  1925. SEGDES MSOUPO
  1926. 37100 CONTINUE
  1927. SEGDES,MCHPOI
  1928. * Amortissement des noeuds esclaves et maitres
  1929. ID5=ID4+NNOEMA+NNOEES
  1930. IF (IPALB(I,1).EQ.38 .OR. IPALB(I,1).EQ.40) THEN
  1931. MCHPOI=IAMOES
  1932. SEGACT,MCHPOI
  1933. NSOUP = IPCHP(/1)
  1934. DO 37120 IPC=1,NSOUP
  1935. MSOUPO=IPCHP(IPC)
  1936. SEGACT,MSOUPO
  1937. MELEME = IGEOC
  1938. SEGACT,MELEME
  1939. MPOVAL = IPOVAL
  1940. SEGACT,MPOVAL
  1941. NNN=NUM(/2)
  1942. DO 37130 INN=1,NNN
  1943. IPT = NUM(1,INN)
  1944. CALL PLACE2(KPLIB,NPLB,IPLAC,IPT)
  1945. IF (IPLAC.NE.0) THEN
  1946. XPALB(I,ID5+IPLAC)=VPOCHA(INN,1)
  1947. ENDIF
  1948. 37130 CONTINUE
  1949. SEGDES MPOVAL,MELEME
  1950. SEGDES MSOUPO
  1951. 37120 CONTINUE
  1952. SEGDES MCHPOI
  1953. ENDIF
  1954. SEGSUP MLIGNE
  1955. *
  1956.  
  1957. else if(cmatee.eq.'PA_FL_RO') then
  1958. ITYP = 60
  1959. MONMOT='RODELI'
  1960. MTLIAB = KTLIAB
  1961. *
  1962. NUML = I
  1963. IP1 = imod
  1964. IF (IERR.NE.0) RETURN
  1965. CALL PLACE2(JPLIB,NPLB,IPLAC,IP1)
  1966. IPLIB(NUML,1) = IPLAC
  1967. *
  1968. * Valeurs de IPALB et XPALB communes à tous les types de
  1969. * paliers fluides :
  1970. *
  1971. IPALB(NUML,1) = ITYP
  1972. IPALB(NUML,2) = 0
  1973. IPALB(NUML,3) = 3
  1974. IPALB(NUML,4) = 0
  1975. *
  1976. XPALB(NUML,4) = valmat(1)
  1977. XPALB(NUML,6) = valmat(2)
  1978. XPALB(NUML,1) = valmat(3)
  1979. XPALB(NUML,2) = valmat(4)
  1980. XPALB(NUML,3) = valmat(5)
  1981. XPALB(NUML,7) = valmat(6)
  1982. XPALB(NUML,8) = valmat(7)
  1983. XPALB(NUML,9) = valmat(8)
  1984. XPALB(NUML,5) = valmat(9)
  1985. itgeom = int(valmat(10))
  1986.  
  1987. *
  1988. IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN
  1989. * ----- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li
  1990. *
  1991. IPALB(NUML,5) = 1
  1992. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0,
  1993. & 'ENTIER',NLOB,X1,' ',Lo1,IP1)
  1994.  
  1995. IF (IERR.NE.0) RETURN
  1996. IPALB(NUML,6) = NLOB
  1997.  
  1998. C Nombre de parametres reels :
  1999. NBPR = 6
  2000. IPALB(NUML,7) = NBPR
  2001.  
  2002. CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0,
  2003. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2004. XPALB(NUML,10) = X1
  2005.  
  2006. IF (IERR.NE.0) RETURN
  2007. DO 610 ILOB = 1, NLOB
  2008. *
  2009. CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0,
  2010. & 'TABLE',I1,X1,' ',Lo1,ITLOB)
  2011.  
  2012. IF (IERR.NE.0) RETURN
  2013. CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0,
  2014. & 'ENTIER',I1,X1,' ',Lo1,IP1)
  2015. IPALB(NUML,7+ILOB) = I1
  2016.  
  2017. IF (IERR.NE.0) RETURN
  2018. CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0,
  2019. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2020. XPALB(NUML,11+NBPR*(ILOB-1)) = X1
  2021.  
  2022. IF (IERR.NE.0) RETURN
  2023. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0,
  2024. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2025. XPALB(NUML,12+NBPR*(ILOB-1)) = X1
  2026.  
  2027. IF (IERR.NE.0) RETURN
  2028. CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0,
  2029. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2030. XPALB(NUML,13+NBPR*(ILOB-1)) = X1
  2031.  
  2032. IF (IERR.NE.0) RETURN
  2033. CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0,
  2034. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2035. XPALB(NUML,14+NBPR*(ILOB-1)) = X1
  2036.  
  2037. IF (IERR.NE.0) RETURN
  2038. CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0,
  2039. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2040. XPALB(NUML,15+NBPR*(ILOB-1)) = X1
  2041.  
  2042. IF (IERR.NE.0) RETURN
  2043. CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0,
  2044. & 'FLOTTANT',I1,X1,MONMOT,Lo1,IP1)
  2045. XPALB(NUML,16+NBPR*(ILOB-1)) = X1
  2046.  
  2047. IF (IERR.NE.0) RETURN
  2048. 610 CONTINUE
  2049. ENDIF
  2050. *
  2051. else
  2052. c write(6,*) 'verifier nom liaison', cmatee
  2053. call erreur(5)
  2054. return
  2055. endif
  2056.  
  2057. *
  2058. * traiter liaisons conditionnelles
  2059. *
  2060. if (.false.) then
  2061. DO I = 1,kmodel(/1)
  2062. ksi = 0
  2063. imodel = kmodel(I)
  2064. segact imodel
  2065. if (tymode(/2).gt.0) then
  2066. do 722 ilc = 1,tymode(/2)
  2067. do j =1,kmodel(/1)
  2068. if (kmodel(j).eq.ivamod(ilc)) then
  2069. ksi = ksi + 1
  2070. ipalb(i,4) = 1
  2071. IF (tymode(ilc).EQ.'CONDINFE' ) THEN
  2072. ipalb (i,4+ksi) = j
  2073. ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN
  2074. ipalb (i,4+ksi) = -1 * j
  2075. ENDIF
  2076. endif
  2077. goto 722
  2078. enddo
  2079. 722 continue
  2080. endif
  2081. 723 continue
  2082. ENDDO
  2083. endif
  2084.  
  2085. * ranger
  2086. segdes ipt8
  2087. *
  2088. 10 CONTINUE
  2089. *
  2090. *
  2091. * ----- liaisons conditionnelles ?
  2092. *
  2093. IF (IIMPI.EQ.333) THEN
  2094. c NLIAB = IPALB(/1)
  2095. c NIPALB = IPALB(/2)
  2096. c NXPALB = XPALB(/2)
  2097. c NPLBB = IPLIB(/2)
  2098. c NPLB = JPLIB(/1)
  2099. DO 1000 IN = 1,NLIAB
  2100. DO 1002 II = 1,NIPALB
  2101. WRITE(IOIMP,*)'cYNE20 : IPALB(',IN,',',II,') =',IPALB(IN,II)
  2102. 1002 CONTINUE
  2103. DO 1004 IX = 1,NXPALB
  2104. WRITE(IOIMP,*)'cYNE20 : XPALB(',IN,',',IX,') =',XPALB(IN,IX)
  2105. 1004 CONTINUE
  2106. DO 1006 IP = 1,NPLBB
  2107. WRITE(IOIMP,*)'cYNE20 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP)
  2108. 1006 CONTINUE
  2109. 1000 CONTINUE
  2110. DO 1008 IP = 1,NPLB
  2111. WRITE(IOIMP,*)'cYNE20 : JPLIB(',IP,') =',JPLIB(IP)
  2112. 1008 CONTINUE
  2113. ENDIF
  2114. *
  2115. * remplissage MTPHI
  2116. *
  2117. NPLSB=1
  2118. SEGINI,MTPHI
  2119. KTPHI = MTPHI
  2120. MTLIAB = KTLIAB
  2121. *
  2122. c NLIAB = IPALB(/1)
  2123. c NPLB = JPLIB(/1)
  2124. c NSB = XPHILB(/1)
  2125. c NPLSB = XPHILB(/2)
  2126. c NA2 = XPHILB(/3)
  2127. c IDIMB = XPHILB(/4)
  2128. IA1 = 0
  2129.  
  2130. do IB = 1,nsstru
  2131. *
  2132. * de DYNE26.ESO
  2133. *
  2134. IORSB(IB) = IA1 + 1
  2135. IAROTA(IB) = 0
  2136. IROT = 0
  2137. IN = 0
  2138.  
  2139. do 41 ik =1,ldefo(/1)
  2140.  
  2141. if (lsstru(ik).ne.ib) goto 41
  2142. IN = IN + 1
  2143.  
  2144. IA1 = IA1 + 1
  2145.  
  2146. icdm = ldefo(ik)
  2147.  
  2148. **
  2149. * Prise en compte d'un mode de rotation de corps rigide
  2150. if (lcgra(ik).gt.0) then
  2151. ICDG = lcgra(ik)
  2152. IAROTA(IB)=IA1
  2153. IROT = IN
  2154. endif
  2155. *
  2156. *
  2157. IF (NLIAB.NE.0) THEN
  2158. DO 42 ID = 1,IDIMB
  2159. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  2160. CMOT = NOMAXI(ID)
  2161. ELSE
  2162. IF (IFOMOD.EQ.-1) THEN
  2163. CMOT = NOMPLA(ID)
  2164. ELSE
  2165. CMOT = NOMTRI(ID)
  2166. ENDIF
  2167. ENDIF
  2168. IF (IIMPI.EQ.333) THEN
  2169. WRITE(IOIMP,*)'DYNE26 : composante @ extraire :',CMOT
  2170. ENDIF
  2171. ICOMP = 0
  2172. DO 44 IP = 1,NPLB
  2173. IPOINT = JPLIB(IP)
  2174. *
  2175. * On extrait du chpoint ICDM au point IPOINT de composante CMOT
  2176. *
  2177. CALL EXTRA9(ICDM,IPOINT,CMOT,KEREU,XVAL)
  2178. ICOMP = ICOMP + 1
  2179. *
  2180. * on ajuste la taille si necessaire
  2181. * MP
  2182. IF(ICOMP.GT.NPLSB) THEN
  2183. NPLSB=ICOMP
  2184. SEGADJ MTPHI
  2185. ENDIF
  2186. IPLSB(IP) = ICOMP
  2187. * suite ? la modif dans extra9, car on attribue une valeur meme
  2188. * si le point n'existe pas dans le chpoint
  2189. IF (XVAL.NE.0.) THEN
  2190. IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  2191. call erreur (783)
  2192. RETURN
  2193. ENDIF
  2194. IBASB(IP) = IB
  2195. ELSE
  2196. IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB
  2197. ENDIF
  2198. *
  2199. XPHILB(IB,ICOMP,IN,ID) = XVAL
  2200. IF (IIMPI.EQ.333) THEN
  2201. WRITE(IOIMP,*)'cyne20 : IPLSB(',IP,') =',IPLSB(IP)
  2202. WRITE(IOIMP,*)'cyne20 : IBASB(',IP,') =',IBASB(IP)
  2203. XVA2 = XPHILB(IB,ICOMP,IN,ID)
  2204. WRITE(IOIMP,*)'cyne20 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  2205. ENDIF
  2206.  
  2207. 44 CONTINUE
  2208. * end do
  2209. 42 CONTINUE
  2210. * end do
  2211. ENDIF
  2212. *
  2213.  
  2214. 41 continue
  2215. INMSB(IB) = IN
  2216. IN = IN + 1
  2217.  
  2218. **
  2219. * Remplissage des fausses d?form?es modales de rotations
  2220. **
  2221. 50 continue
  2222. IF (IAROTA(IB).NE.0) THEN
  2223. ** RIGIDE = .TRUE.
  2224. MERR = 0
  2225. NPLUS = IN + 1
  2226. IF (NPLUS.GT.NA2) THEN
  2227. * On r?ajuste le dimension NA2 de XPHILB
  2228. NA2 = NPLUS
  2229. SEGADJ MTPHI
  2230. ENDIF
  2231. DO 118 IP=1,NPLB
  2232. IPOINT=JPLIB(IP)
  2233. IPOS=IPLSB(IP)
  2234. IBBAS= IBASB(IP)
  2235. IF (IBBAS.EQ.IB) THEN
  2236. DO 220 ID=(IDIM+1),IDIMB
  2237. XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID)
  2238. 220 CONTINUE
  2239. * En tridimensionnel l'axe de rotation est le vecteur propre de rotation
  2240. * On norme l axe du plan de rotation
  2241. CALL DYNE41(XAXROT,MERR,IDIM)
  2242. * En bidimensionnel l'axe de rotation est fixe
  2243. * Calcul des fausses d?form?es modales de rotation
  2244. CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  2245. DO 622 ID =1,IDIMB
  2246. XPHILB(IB,IPOS,IN,ID) = XROTA(1,ID)
  2247. XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID)
  2248. 622 CONTINUE
  2249. ENDIF
  2250. 118 CONTINUE
  2251. ENDIF
  2252. IF (IIMPI.EQ.333) THEN
  2253. WRITE(IOIMP,*)'DYNE26 : INMSB(',IB,') =',INMSB(IB)
  2254. WRITE(IOIMP,*)'DYNE26 : IORSB(',IB,') =',IORSB(IB)
  2255. WRITE(IOIMP,*)'DYNE26 : IAROTA(',IB,') =',IAROTA(IB)
  2256. ENDIF
  2257. *
  2258. IF (IERR.NE.0) RETURN
  2259. * fin boucle sousstructure
  2260. enddo
  2261.  
  2262. RETURN
  2263. END
  2264.  
  2265.  
  2266.  
  2267.  
  2268.  
  2269.  
  2270.  

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