Télécharger jonct.eso

Retour à la liste

Numérotation des lignes :

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

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