Télécharger cyne20.eso

Retour à la liste

Numérotation des lignes :

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

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