Télécharger rela.eso

Retour à la liste

Numérotation des lignes :

  1. C RELA SOURCE BP208322 15/06/22 21:21:36 8543
  2. SUBROUTINE RELA
  3. C
  4. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C C FABRIQUE UN OBJET ATTACHE CORRESPONDANT A UNE LIAISON ELEMENTAIRE
  6. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (a-h,o-z)
  10. -INC CCOPTIO
  11. -INC CCHAMP
  12. -INC SMELSTR
  13. -INC SMCLSTR
  14. -INC SMSTRUC
  15. -INC SMELEME
  16. -INC SMCOORD
  17. -INC SMRIGID
  18. -INC SMCHPOI
  19. -INC SMATTAC
  20. -INC SMLREEL
  21. SEGMENT ITRA1(0)
  22. SEGMENT IWOR1(0)
  23. SEGMENT ITRA2(0)
  24. SEGMENT ITRA3(0)
  25. SEGMENT ITRA4(0)
  26. SEGMENT ITRA5(0)
  27. SEGMENT RCOEF(0)
  28. SEGMENT IGEO(0)
  29. SEGMENT IDEN(NPO)
  30. SEGMENT ICO(NPO)
  31. SEGMENT SINCO
  32. CHARACTER*4 INCO(ICMAX)
  33. ENDSEGMENT
  34. SEGMENT NTABK(NLIGRE)
  35. SEGMENT MNOC
  36. CHARACTER*4 NOCO(ICMAX,NPO)
  37. ENDSEGMENT
  38. SEGMENT/MVAL/(VALE(ICMAX,NPO))
  39. CHARACTER*4 NOMCO
  40. DATA ICMAX/15/
  41. CALL LIROBJ ('ELEMSTRU',IRET,0,IRETO1)
  42. IRETO2=0
  43. IF (IRETO1.EQ.0) CALL LIROBJ ('BLOQSTRU',IRET,0,IRETO2)
  44. IF ((IRETO1+IRETO2).EQ.0) THEN
  45. CALL RELA1
  46. RETURN
  47. ENDIF
  48. SEGINI ITRA1
  49. SEGINI IWOR1
  50. MJON=0
  51. NBCLST=0
  52. IF (IRETO1.EQ.1) GO TO 15
  53. IF (IRETO2.EQ.1) GO TO 25
  54. 1 CONTINUE
  55. C
  56. C LECTURE DES MELSTR
  57. C
  58. CALL LIROBJ('ELEMSTRU',IRET,0,IRETOU)
  59. IF(IRETOU.EQ.0) GOTO 10
  60. 15 MELSTR=IRET
  61. CALL LIRMOT(NOMDD,LNOMDD,IMOT,1)
  62. IF(IERR.EQ.0) GOTO 2
  63. C *** OUBLI DE LA COMPOSANTE
  64. CALL ERREUR(116)
  65. GOTO 3
  66. 2 NOMCO=NOMDD(IMOT)
  67. CALL LIRPRO(NBVAL,IPROG)
  68. IF(IPROG.EQ.0) GOTO 3
  69. SEGACT MELSTR
  70. NBSTRU=ISOSTU(/1)
  71. MSOSTU=ISOSTU(1)
  72. MELEME=IMELEM(1)
  73. SEGDES MELSTR
  74. IF(NBSTRU.EQ.1) GOTO 4
  75. C *** LA SOUS-STRUCTURE N'EST PAS ELEMENTAIRE
  76. INTERR(1)=MSOSTU
  77. CALL ERREUR(90)
  78. 3 CONTINUE
  79. SEGSUP ITRA1,IWOR1
  80. RETURN
  81. 4 ITRA1(**)=MSOSTU
  82. ITRA1(**)=MELEME
  83. READ (NOMCO,FMT='(A4)') IPV
  84. ITRA1(**)=IPV
  85. ITRA1(**)=IPROG
  86. GOTO 1
  87. 10 CONTINUE
  88. C
  89. C LECTURE DES CLSTR
  90. C
  91. CALL LIROBJ('BLOQSTRU',IRET,0,IRETOU)
  92. IF(IRETOU.EQ.0) GOTO 20
  93. 25 MCLSTR=IRET
  94. CALL LIRMOT(NOMDD,LNOMDD,IMOT,1)
  95. IF(IERR.EQ.0) GOTO 11
  96. C *** OUBLI DE LA COMPOSANTE
  97. CALL ERREUR(116)
  98. GOTO 3
  99. 11 IF(NOMDD(IMOT).EQ.'LX ') GOTO 12
  100. C *** LA COMPOSANTE DOIT ETRE LX
  101. CALL ERREUR(120)
  102. GOTO 3
  103. 12 CONTINUE
  104. CALL LIRPRO(NBVAL,IPROG)
  105. IF(IPROG.EQ.0) GOTO 3
  106. SEGACT MCLSTR
  107. NBSTRU=ISOSTR(/1)
  108. MSOSTU=ISOSTR(1)
  109. IRIG=IRIGCL(1)
  110. SEGDES MCLSTR
  111. IF(NBSTRU.EQ.1) GOTO 13
  112. C *** LA SOUS-STRUCTURE N'EST PAS ELEMENTAIRE
  113. INTERR(1)=MSOSTU
  114. CALL ERREUR(90)
  115. GOTO 3
  116. 13 IWOR1(**)=MSOSTU
  117. IWOR1(**)=IRIG
  118. IWOR1(**)=IPROG
  119. GOTO 1
  120. 20 NBELST=ITRA1(/1)/4
  121. IF(NBELST.EQ.0) GOTO 380
  122. C
  123. C TRAITEMENT DES MELSTRS
  124. C **********************
  125. C
  126. SEGINI ITRA5
  127. C
  128. C RECHERCHE DES SOUS STRUCTURES INTERVENANT DS LA LIAISON
  129. C BOUCLE SUR L'ENSMBLE DES MELSTRS
  130. C QUAND UNE SOUS STRUCTURE EST EPUISEE ITRA1( )=0
  131. C
  132. DO 350 NB=1,NBELST
  133. IT=4*(NB-1)
  134. MSOSTU=ITRA1(IT+1)
  135. IF(MSOSTU.EQ.0) GOTO 350
  136. C
  137. C *********** 1 ***********
  138. C
  139. C CREATION DES TABLEAUX AUXILLIAIRES :
  140. C IGEO(IP)=NUM LE IP-IEME PT A LE NUMERO NUM
  141. C ITRA2(IKI)=IP NUMERO D'ORDRE DU PT NUM DS IGEO
  142. C ITRA2(IKI+1)=NOMCO NOM DU DDL ASSOCIE AU PT
  143. C RCOEF(I)=COEF COEFFICIENT ASSOCIE AU DDL NOMCO DU IP-IEME P
  144. C
  145. SEGINI ITRA2,IGEO,RCOEF
  146. C
  147. C RECHERCHE DES MELEMES D'UNE MEME SOUS STRUCTURE
  148. C
  149. IP=0
  150. NPO=0
  151. DO 140 NBB=NB,NBELST
  152. IT=4*(NBB-1)
  153. IF(MSOSTU.NE.ITRA1(IT+1)) GOTO 140
  154. MELEME=ITRA1(IT+2)
  155. MLREEL=ITRA1(IT+4)
  156. SEGACT MELEME,MLREEL
  157. NBELEM=NUM(/2)
  158. NBVAL=PROG(/1)
  159. IF(NBVAL.EQ.NBELEM) GOTO 80
  160. C *** LE NB DE COEF N'EST PAS EGAL AU NB DE PTS
  161. CALL ERREUR(117)
  162. SEGDES MELEME,MLREEL
  163. SEGSUP ITRA2,ITRA5,IGEO,RCOEF
  164. GOTO 3
  165. C
  166. C BOUCLE SUR LES PTS DU MELEME DU MELSTR
  167. C
  168. 80 DO 130 NBE=1,NBELEM
  169. IKI=NUM(1,NBE)
  170. IF(NPO.EQ.0) GOTO 100
  171. DO 90 J=1,NPO
  172. IPP=J
  173. IF(IKI.EQ.IGEO(J)) GOTO 120
  174. 90 CONTINUE
  175. 100 IP=IP+1
  176. IGEO(**)=IKI
  177. IPP=IP
  178. 120 ITRA2(**)=IPP
  179. ITRA2(**)=ITRA1(IT+3)
  180. RCOEF(**)=PROG(NBE)
  181. 130 CONTINUE
  182. SEGDES MELEME,MLREEL
  183. NPO=IGEO(/1)
  184. ITRA1(IT+1)=0
  185. 140 CONTINUE
  186. I2=ITRA2(/1)
  187. I21=I2-1
  188. I3=RCOEF(/1)
  189. I4=IGEO(/1)
  190. IF(IIMPI.EQ.2) WRITE(IOIMP,1000)(I,ITRA2(I),I=1,I21,2)
  191. IF(IIMPI.EQ.2) WRITE(IOIMP,1001)(I,ITRA2(I),I=2,I2,2)
  192. IF(IIMPI.EQ.2) WRITE(IOIMP,1002)(I,RCOEF(I),I=1,I3)
  193. IF(IIMPI.EQ.2) WRITE(IOIMP,1003)(I,IGEO(I) ,I=1,I4)
  194. 1000 FORMAT(1X,' ITRA2 ',10(I4,I4,1X))
  195. 1001 FORMAT(1X,' ITRA2 ',10(I4,1X,A4,1X))
  196. 1002 FORMAT(1X,' RCOEF ',8(I4,1PE12.5,1X))
  197. 1003 FORMAT(1X,' IGEO ',10(I4,I4,1X))
  198. C
  199. C ********** 2 **********
  200. C
  201. C RECHERCHE ET REPERAGE DES DDL
  202. C CREATION DES TABLEAUX AUXILLIAIRES :
  203. C NOCO(IC,IP) NOM DU IC-IEME DDL DU PT IP
  204. C IDEN(IP) SI IDEN(IP)=IDEN(IPP) =>IP ET IPP ONT MEMES DDLS
  205. C ICO(IP) NB DE DDL DU PT IP
  206. C INCO(NUCO) NOM DU NUCO-IEME DDL
  207. C
  208. SEGACT MSOSTU
  209. MRIGID=ISRAID
  210. SEGDES MSOSTU
  211. SEGACT MRIGID
  212. NRIGEL=IRIGEL(/2)
  213. NDDL=0
  214. SEGINI MNOC,IDEN,ICO,SINCO
  215. ICMA=0
  216. C
  217. C BOUCLE SUR LES POINTS DE LA SOUS STRUCTURE
  218. C
  219. DO 250 IP=1,NPO
  220. NDCP=0
  221. C
  222. C BOUCLE SUR LES ZONES GEOMETRIQUES DE LA SOUS STRUCTURE
  223. C
  224. DO 240 IAA=1,NRIGEL
  225. MELEME=IRIGEL(1,IAA)
  226. SEGACT MELEME
  227. IF(ITYPEL.EQ.22) GOTO 235
  228. NBELEM=NUM(/2)
  229. NBPT=NUM(/1)
  230. DO 150 NBE=1,NBELEM
  231. DO 150 NP=1,NBPT
  232. IKI=NUM(NP,NBE)
  233. NPEL=NP
  234. IF(IKI.EQ.IGEO(IP)) GOTO 160
  235. 150 CONTINUE
  236. GOTO 235
  237. 160 DESCR=IRIGEL(3,IAA)
  238. SEGACT DESCR
  239. NLIGRE=NOELEP(/1)
  240. IC=0
  241. ICC=0
  242. C
  243. C BOUCLE SUR LES INCONNUES DE LA MATRICE DE RIGIDITE DE L'ELEMENT
  244. C
  245. DO 230 I=1,NLIGRE
  246. IF(NOELEP(I).NE.NPEL) GOTO 230
  247. NOMCO=LISINC(I)
  248. IF(NDDL.EQ.0) GOTO 180
  249. C
  250. C BOUCLE SUR LES DDL TOTAUX DEJA CREES,ON DONNE UN NUMERO (NUCO) AU DD
  251. C
  252. DO 170 ND=1,NDDL
  253. NUCO=ND
  254. IF(NOMCO.EQ.INCO(ND)) GOTO 190
  255. 170 CONTINUE
  256. 180 IC=IC+1
  257. NUCO=NDDL+IC
  258. INCO(NUCO)=NOMCO
  259. 190 CONTINUE
  260. IF(NDCP.EQ.0) GOTO 210
  261. C
  262. C BOUCLE SUR LES DDL DU PT DEJA CREES
  263. C
  264. DO 200 NDC=1,NDCP
  265. IF(NOMCO.EQ.NOCO(NDC,IP)) GOTO 220
  266. 200 CONTINUE
  267. 210 ICC=ICC+1
  268. NDIC=NDCP+ICC
  269. IF(NDIC.LE.ICMAX) GOTO 215
  270. C *** A LA NUCO-IEME COMPOSANTE ON ASSOCIE LE NB 2**(NUCO-1)
  271. C TROP DE COMPOSANTES,ON DEPASSE LA CAPACITE DE LA MACHINE
  272. CALL ERREUR(119)
  273. SEGDES DESCR,MELEME,MRIGID,MSOSTU
  274. SEGSUP ITRA2,ITRA5,IGEO,RCOEF,MNOC,IDEN,ICO,SINCO
  275. GOTO 3
  276. 215 NOCO(NDIC,IP)=NOMCO
  277. IF(NUCO.EQ.1) IDEN(IP)=IDEN(IP)+1
  278. IF(NUCO.NE.1) IDEN(IP)=IDEN(IP)+2**(NUCO-1)
  279. 220 CONTINUE
  280. 230 CONTINUE
  281. SEGDES DESCR
  282. NDDL=NDDL+IC
  283. NDCP=NDCP+ICC
  284. 235 CONTINUE
  285. SEGDES MELEME
  286. 240 CONTINUE
  287. ICO(IP)=NDCP
  288. IF(NDCP.GT.ICMA) ICMA=NDCP
  289. 250 CONTINUE
  290. I1=NOCO(/2)
  291. I2=NOCO(/3)
  292. I3=IDEN(/1)
  293. I4=ICO(/1)
  294. I5=INCO(/2)
  295. IF(IIMPI.EQ.2) WRITE(IOIMP,1004)((J,I,NOCO(I,J),I=1,I1),J=1,I2)
  296. IF(IIMPI.EQ.2) WRITE(IOIMP,1005)(I,IDEN(I),I=1,I3)
  297. IF(IIMPI.EQ.2) WRITE(IOIMP,1006)(I,ICO(I),I=1,I4)
  298. IF(IIMPI.EQ.2) WRITE(IOIMP,1007)(I,INCO(I),I=1,I5)
  299. 1004 FORMAT(1X,' NOCO ',8(I4,1X,I4,1X,A4,1X))
  300. 1005 FORMAT(1X,' IDEN ',10(I4,1X,I4,1X))
  301. 1006 FORMAT(1X,' ICO ',10(I4,1X,I4,1X))
  302. 1007 FORMAT(1X,' INCO ',10(I4,1X,A4,1X))
  303. SEGDES MRIGID
  304. SEGSUP SINCO
  305. C
  306. C ********** 3 **********
  307. C
  308. C COMPATIBILITE DES DONNEES CORRESPONDANT AUX DDL ET
  309. C CREATION DU TABLEAU AUXILLIAIRE :
  310. C VALE(IC,IP) COEF POUR LE IC-IEME DDL DU IP-IEME PT
  311. C
  312. IKIMA=ITRA2(/1)/2
  313. ICMAX=ICMA
  314. SEGINI MVAL
  315. C
  316. C BOUCLE SUR LES POINTS DE LA SOUS-STRUCTURE
  317. C
  318. DO 290 IP=1,NPO
  319. NDCP=ICO(IP)
  320. DO 255 IC=1,ICMAX
  321. VALE(IC,IP)=0.
  322. 255 CONTINUE
  323. C
  324. C RECHERCHE DU(ES) DDL DE LIAISON DU PT
  325. C ON PARCOURS LE TABLEAU ITRA2
  326. C
  327. DO 280 IKI=1,IKIMA
  328. IT=2*(IKI-1)
  329. IKIN=ITRA2(IT+1)
  330. IF(IKIN.NE.IP) GOTO 280
  331. WRITE (NOMCO,FMT='(A4)') ITRA2(IT+2)
  332. C
  333. C BOUCLE SUR LES DDL DU PT
  334. C
  335. DO 260 IC=1,NDCP
  336. ICC=IC
  337. IF(NOMCO.EQ.NOCO(IC,IP)) GOTO 270
  338. 260 CONTINUE
  339. C *** LE DDL N'EXISTE PAS
  340. INTERR(1)=MSOSTU
  341. MOTERR(1:4)=NOMCO
  342. CALL ERREUR(118)
  343. SEGSUP ITRA2,ITRA5,IGEO,RCOEF,MVAL,MNOC,ICO,IDEN
  344. GOTO 3
  345. 270 VALE(ICC,IP)=RCOEF(IKI)
  346. 280 CONTINUE
  347. 290 CONTINUE
  348. SEGSUP ITRA2,RCOEF
  349. I1=VALE(/1)
  350. I2=VALE(/2)
  351. IF(IIMPI.EQ.2) WRITE(IOIMP,1008)((J,I,VALE(I,J),I=1,I1),J=1,I2)
  352. 1008 FORMAT(1X,' VALE ',5(I4,1X,I4,1X,1PE12.5,1X))
  353. C
  354. C ********** 4 **********
  355. C
  356. SEGINI ITRA4
  357. DO 330 IP=1,NPO
  358. IA=IDEN(IP)
  359. IF(IA.EQ.0) GOTO 330
  360. SEGINI ITRA3
  361. C
  362. C CREATION DES MSOUPO DU CHAMPOINT (ITRA4)
  363. C RECHERCHE DES PTS AYANT LES MEMES DDDL (ITRA3)
  364. C
  365. DO 300 IPP=IP,NPO
  366. IF(IA.NE.IDEN(IPP)) GOTO 300
  367. ITRA3(**)=IPP
  368. IDEN(IPP)=0
  369. 300 CONTINUE
  370. NC=ICO(IP)
  371. SEGINI MSOUPO
  372. ITRA4(**)=MSOUPO
  373. NBSOUS=0
  374. NBREF=0
  375. NBNN=1
  376. NBELEM=ITRA3(/1)
  377. SEGINI MELEME
  378. IGEOC=MELEME
  379. ITYPEL=1
  380. N=NBELEM
  381. SEGINI MPOVAL
  382. IPOVAL=MPOVAL
  383. DO 310 IC=1,NC
  384. NOCOMP(IC)=NOCO(IC,IP)
  385. NOHARM(IC)=NIFOUR
  386. 310 CONTINUE
  387. DO 320 NBE=1,NBELEM
  388. IPP=ITRA3(NBE)
  389. NUM(1,NBE)=IGEO(IPP)
  390. DO 320 IC=1,NC
  391. DO 315 ICC=1,NC
  392. IC1=ICC
  393. IF(NOCO(IC1,IPP).EQ.NOCOMP(IC)) GOTO 317
  394. 315 CONTINUE
  395. 317 VPOCHA(NBE,IC)=VALE(IC1,IPP)
  396. 320 CONTINUE
  397. SEGDES MELEME,MPOVAL,MSOUPO
  398. SEGSUP ITRA3
  399. 330 CONTINUE
  400. SEGSUP IDEN,ICO,IGEO,MNOC,MVAL
  401. NSOUPO=ITRA4(/1)
  402. NAT=1
  403. SEGINI MCHPOI
  404. IFOPOI=IFOUR
  405. DO 340 NS=1,NSOUPO
  406. IPCHP(NS)=ITRA4(NS)
  407. 340 CONTINUE
  408. SEGDES MCHPOI
  409. SEGSUP ITRA4
  410. C
  411. C ********** **********
  412. C
  413. ITRA5(**)=MSOSTU
  414. ITRA5(**)=MCHPOI
  415. 350 CONTINUE
  416. C
  417. C CREATION DU MJONCT
  418. C
  419. 355 N=ITRA5(/1)/2
  420. SEGINI MJONCT
  421. MJOTYP='MECA'
  422. MJODDL='LX'
  423. C NBCLST=0 LIAISON LIBRE NBCLST#0 LIAISON BLOQUE
  424. IF(NBCLST.NE.0) MJODDL='FLX'
  425. SEGACT MCOORD*MOD
  426. NBNO=XCOOR(/1)/(IDIM+1)
  427. XCOOR(**)=0.
  428. XCOOR(**)=0.
  429. IF(IDIM.EQ.3) XCOOR(**)=0.
  430. XCOOR(**)=0.
  431. NBNN=1
  432. NBELEM=1
  433. NBREF=0
  434. NBSOUS=0
  435. SEGINI MELEME
  436. ITYPEL=1
  437. NUM(1,1)=NBNO+1
  438. SEGDES MELEME
  439. MJOPOI=MELEME
  440. IF(NBCLST.EQ.0) MJOPO1=NBNO+1
  441. IF(NBCLST.NE.0) MJOPO2=NBNO+1
  442. DO 360 NN=1,N
  443. NNN=2*NN
  444. ISTRJO(NN)=ITRA5(NNN-1)
  445. IPCHJO(NN)=ITRA5(NNN)
  446. 360 CONTINUE
  447. SEGSUP ITRA5
  448. SEGDES MJONCT
  449. IF(MJON.EQ.0) MJON=MJONCT
  450. IF(NBCLST.NE.0) GOTO 500
  451. 380 NBCLST=IWOR1(/1)/3
  452. IF(NBCLST.EQ.0) GOTO 500
  453. C
  454. C TRAITEMENT DES CLSTRS
  455. C *********************
  456. C
  457. SEGINI ITRA5
  458. C
  459. C RECHERCHE DES SOUS STRUCTURES INTERVENANT DS LA LIAISON
  460.  
  461. C BOUCLE SUR L'ENSEMBLE DES CLSTR
  462. C
  463. DO 490 NB=1,NBCLST
  464. IT=3*(NB-1)
  465. MSOSTU=IWOR1(IT+1)
  466. IF(MSOSTU.EQ.0) GOTO 490
  467. NPO=0
  468. SEGINI IGEO,RCOEF
  469. C
  470. C RECHERCHE DES CLSTR D'UNE MEME SOUS STRUCTURE
  471. C
  472. DO 470 NBB=NB,NBCLST
  473. IT=3*(NBB-1)
  474. IF(MSOSTU.NE.IWOR1(IT+1)) GOTO 470
  475. MRIGID=IWOR1(IT+2)
  476. SEGACT MRIGID
  477. NRIGEL=IRIGEL(/2)
  478. C
  479. C BOUCLE SUR LES BLOCAGES DE LA SOUS STRUCTURE
  480. C
  481. DO 440 IAA=1,NRIGEL
  482. C RECHERCHE DE LA POSITION DES INCONNUES DE LAGRANGE
  483. DESCR=IRIGEL(3,IAA)
  484. SEGACT DESCR
  485. NLIGRE=LISINC(/2)
  486. SEGINI NTABK
  487. JK=0
  488. DO 400 I=1,NLIGRE
  489. NOMCO=LISINC(I)
  490. IF(NOMCO.NE.'LX ') GOTO 400
  491. JK=JK+1
  492. NTABK(JK)=NOELEP(I)
  493. 400 CONTINUE
  494. SEGDES DESCR
  495. MELEME=IRIGEL(1,IAA)
  496. SEGACT MELEME
  497. NBELEM=NUM(/2)
  498. C
  499. C BOUCLES SUR LES NOEUDS DU BLOCAGE
  500. C
  501. DO 430 NBE=1,NBELEM
  502. DO 420 NP=1,JK
  503. IKI=NUM(NTABK(NP),NBE)
  504. IF(NPO.EQ.0) GOTO 415
  505. DO 410 J=1,NPO
  506. IF(IKI.EQ.IGEO(J)) GOTO 450
  507. 410 CONTINUE
  508. 415 IGEO(**)=IKI
  509. 420 CONTINUE
  510. 430 CONTINUE
  511. SEGSUP NTABK
  512. SEGDES MELEME
  513. NPO=IGEO(/1)
  514. 440 CONTINUE
  515. MLREEL=IWOR1(IT+3)
  516. SEGACT MLREEL
  517. NBVAL=PROG(/1)
  518. IF(NBVAL.EQ.NPO) GOTO 460
  519. C *** LE NB DE COEF N'EST PAS EGAL AU NB DE PTS
  520. CALL ERREUR(117)
  521. SEGDES MLREEL
  522. 445 SEGDES MRIGID
  523. SEGSUP IGEO,RCOEF
  524. GOTO 3
  525. 450 CALL ERREUR(120)
  526. SEGDES MELEME
  527. C *** UN DDL EST DONNE PLUSIEURS FOIS
  528. GOTO 445
  529. 460 IWOR1(IT+1)=0
  530. SEGDES MRIGID
  531. DO 465 NV=1,NBVAL
  532. RCOEF(**)=PROG(NV)
  533. 465 CONTINUE
  534. SEGDES MLREEL
  535. 470 CONTINUE
  536. IF(IIMPI.EQ.2) WRITE(IOIMP,1009)(I,IGEO(I),RCOEF(I),I=1,NPO)
  537. 1009 FORMAT(1X,' IGEO=',5(I4,1X,I4,1X,1PE12.5,1X))
  538. C
  539. C CREATION DU CHAMPOINT (ITRA5)
  540. C
  541. NSOUPO=1
  542. NAT=1
  543. SEGINI MCHPOI
  544. IFOPOI=IFOUR
  545. NC=1
  546. SEGINI MSOUPO
  547. IPCHP(1)=MSOUPO
  548. SEGDES MCHPOI
  549. ITRA5(**)=MSOSTU
  550. ITRA5(**)=MCHPOI
  551. NBSOUS=0
  552. NBREF=0
  553. NBNN=1
  554. NBELEM=NPO
  555. SEGINI MELEME
  556. IGEOC=MELEME
  557. ITYPEL=1
  558. N=NBELEM
  559. SEGINI MPOVAL
  560. DO 480 I=1,N
  561. NUM(1,I)=IGEO(I)
  562. VPOCHA(I,1)=RCOEF(I)
  563. 480 CONTINUE
  564. NOCOMP(1)='LX'
  565. NOHARM(1)=NIFOUR
  566. IPOVAL=MPOVAL
  567. SEGDES MELEME,MPOVAL,MSOUPO
  568. SEGSUP IGEO,RCOEF
  569. 490 CONTINUE
  570. GOTO 355
  571. C
  572. C CREATION DU MATTAC
  573. C
  574. 500 SEGSUP ITRA1,IWOR1
  575. IF(MJON.NE.0) GOTO 510
  576. C *** PAS D'OPERANDE CORRECT
  577. CALL ERREUR(92)
  578. RETURN
  579. 510 N=1
  580. M=0
  581. C SI MJON # MJONCT LA LIAISON EST MIXTE
  582. IF(MJON.NE.MJONCT) N=2
  583. IF(MJON.NE.MJONCT) M=1
  584. SEGINI MSOUMA
  585. ITYATT='MECA'
  586. IGEOCH=0
  587. IPHYCH=0
  588. IATREL(1)=MJON
  589. IF(N.EQ.1) GOTO 520
  590. IATREL(2)=MJONCT
  591. C *** CREATION DE LA MATRICE DUE A LA LIAISON MIXTE
  592. * LVAL=3
  593. NLIGRE=2
  594. NLIGRP=2
  595. NLIGRD=2
  596. nelrig=1
  597. SEGINI XMATRI
  598. RE(1,1,1)=0.
  599. RE(2,1,1)=-1.
  600. RE(2,2,1)=0.
  601. RE(1,2,1)=-1.
  602. SEGDES XMATRI
  603. * NELRIG=1
  604. * SEGINI IMATRI
  605. * IMATTT(1)=XMATRI
  606. * SEGDES IMATRI
  607. NLIGRP=2
  608. NLIGRD=2
  609. SEGINI DESCR
  610. NOELEP(1)=1
  611. NOELEP(2)=2
  612. NOELED(1)=1
  613. NOELED(2)=2
  614. LISINC(1)='BETA'
  615. LISINC(2)='FBET'
  616. LISDUA(1)='FBET'
  617. LISDUA(2)='BETA'
  618. SEGDES DESCR
  619. NBNN=2
  620. NBELEM=1
  621. NBSOUS=0
  622. NBREF=0
  623. SEGINI MELEME
  624. ITYPEL=23
  625. NUM(1,1)=MJOPO1
  626. NUM(2,1)=MJOPO2
  627. SEGDES MELEME
  628. NRIGE=4
  629. NRIGEL=1
  630. SEGINI MRIGID
  631. COERIG(1)=1.D0
  632. IRIGEL(1,1)=MELEME
  633. IRIGEL(2,1)=0
  634. IRIGEL(3,1)=DESCR
  635. IRIGEL(4,1)=xMATRI
  636. MTYMAT='RIGIDITE'
  637. ICHOLE=0
  638. SEGDES MRIGID
  639. IPMATK(1)=MRIGID
  640. 520 CONTINUE
  641. SEGDES MSOUMA
  642. N=1
  643. SEGINI MATTAC
  644. LISATT(1)=MSOUMA
  645. CALL ECROBJ('ATTACHE ',MATTAC)
  646. SEGDES MATTAC
  647. RETURN
  648. END
  649.  
  650.  
  651.  
  652.  

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