Télécharger rela1.eso

Retour à la liste

Numérotation des lignes :

  1. C RELA1 SOURCE GG250959 17/12/21 21:15:13 9680
  2. SUBROUTINE RELA1
  3. C
  4. C RELAZIONE LINEARE TRA DDL
  5. C
  6. C ICONR NUMERO OGGETTI MELEME DELLA RELAZIONE
  7. C ITYESR(NBSOUS) LISTA TIPI ELEMENTI CONTENUTI IN MELEME-N
  8. C MUNESR(NBSOUS) NUMERO ELEMENTI IN OGNI SOTTOSTRUTTURA DI MELEME-N
  9. C LNODSR(NNR) LISTA NODI MELEME-N
  10. C IPOR1(N) PUNTATORE SU MWREL1
  11. C IPOR2(N) PUNTATORE SU MWREL2
  12. C IPOR3(N) PUNTATORE SU MWREL3
  13. C COEFR(N) COEFFICIENTI RELAZIONE
  14. C INCREL(N) IDENTIFICATORE NOME DDL
  15. C
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18. -INC SMELEME
  19. -INC SMCOORD
  20. -INC SMRIGID
  21. -INC TMTRAV
  22. -INC CCOPTIO
  23. -INC CCGEOME
  24. -INC CCHAMP
  25. SEGMENT /MWGGM1/(IPORE1(0))
  26. SEGMENT /MWGGM2/(IPORE2(0))
  27. SEGMENT /MWGGM3/(IPORE3(0))
  28. SEGMENT /MWGGM4/(INCREL(0))
  29. SEGMENT /MWGGM5/(COEFR(0)*D)
  30. SEGMENT /MWREL1/(ITYESR(0)),IEL11.MWREL1,
  31. + IEL21.MWREL1
  32. SEGMENT /MWREL2/(MUNESR(0)),IEL12.MWREL2,
  33. + IEL22.MWREL2
  34. SEGMENT /MWREL3/(LNODSR(0)),IEL13.MWREL3,
  35. + IEL23.MWREL3
  36. CHARACTER*4 MOTPV(3)
  37. CHARACTER*4 MOCORI(7)
  38. CHARACTER*4 MOTPM(2)
  39. CHARACTER*4 MOTDDL(3)
  40. CHARACTER*4 MOTBLO(3)
  41. CHARACTER*4 MODEPL(8)
  42. CHARACTER*4 MOROTA(5)
  43. CHARACTER*8 MILMOT
  44. DIMENSION XNOR(3)
  45. DATA MOTPV /'MINI','MAXI','FROT'/
  46. DATA MOTPM /'+ ','- '/
  47. DATA MOCORI/'CORI','ENSE','ACCR','GLIS','BARY','MILI','TUYA'/
  48. C
  49. DATA EPSI/1.D-12/
  50. DATA MOTBLO/'DEPL','ROTA','DIRE'/
  51. DATA MODEPL/'UX ','UY ','UZ ','UR ','UZ ','UT ',
  52. &'ALFA','BETA'/
  53. DATA MOROTA/'RX ','RY ','RZ ','RT ','RS '/
  54. C
  55. C EST-CE UNE RELATION DE CORPS RIGIDE ?
  56. C
  57.  
  58. CALL LIRMOT(MOCORI,7,ICORI,0)
  59. IF (ICORI.NE.0) THEN
  60. c BARY
  61. if (icori.eq.5) then
  62. call relaba
  63. c MILI
  64. ELSE IF (ICORI.EQ.6) THEN
  65. CALL RELAMI
  66. c TUYA
  67. elseif(icori.eq.7) then
  68. call reltuy
  69. c CORI, ENSE, ACCRO, GLIS
  70. else
  71. CALL RELA2(MOCORI(ICORI))
  72. endif
  73. RETURN
  74. ENDIF
  75. C
  76. C EST-CE UNE CONDITION UNILATERALE ?
  77. C
  78. NILATE=0
  79. CALL LIRMOT (MOTPV,3,IPO,0)
  80. IF(IPO.EQ.1) NILATE=-1
  81. IF(IPO.EQ.2) NILATE=+1
  82. IF(IPO.EQ.3) NILATE=+2
  83. C
  84. C INITIALISATIONS
  85. C
  86. COEX=1.D0
  87. C
  88. C Deformations planes ou contraintes planes ou defo. plane gene :
  89. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN
  90. LDEPL=2
  91. IADEPL=0
  92. LROTA=1
  93. IAROTA=2
  94. C Axisymetrique :
  95. ELSE IF (IFOUR.EQ.0) THEN
  96. LDEPL=2
  97. IADEPL=3
  98. LROTA=1
  99. IAROTA=3
  100. C Fourier :
  101. ELSE IF (IFOUR.EQ.1) THEN
  102. LDEPL=3
  103. IADEPL=3
  104. LROTA=2
  105. IAROTA=2
  106. C Tridimensionnel :
  107. ELSE IF (IFOUR.EQ.2) THEN
  108. LDEPL=3
  109. IADEPL=0
  110. LROTA=3
  111. IAROTA=0
  112. C Massif 1D (IDIM=1) :
  113. ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  114. LDEPL=1
  115. IADEPL=0
  116. IF (IFOUR.GE.12) IADEPL=3
  117. LROTA=0
  118. IAROTA=0
  119. C Autres cas :
  120. ELSE
  121. LDEPL=0
  122. IADEPL=0
  123. LROTA=0
  124. IAROTA=0
  125. ENDIF
  126. C
  127. SEGINI MWGGM1
  128. SEGINI MWGGM2
  129. SEGINI MWGGM3
  130. SEGINI MWGGM4
  131. SEGINI MWGGM5
  132. *
  133. * LECTURE EVENTUELLE D'UN MODELLE
  134. *
  135.  
  136. CALL LIROBJ('MMODEL',IPOMOD,0,IREMOD)
  137. IF(IREMOD.NE.0) THEN
  138. CALL RELMOD(IPOMOD)
  139. RETURN
  140. ENDIF
  141. *
  142. * LECTURE EVENTUELLE D'UN CHPOINT
  143. *
  144. CALL LIROBJ('CHPOINT',IPOCHP,0,IRECHP)
  145. IF(IRECHP.NE.0) THEN
  146. *
  147. * ON MET LE CHPOINT SOUS FORME DE TABLEAU DE TRAVAIL
  148. *
  149. CALL TRACHP(IPOCHP,MTRAV)
  150. SEGACT MTRAV
  151. DO 1990 I=1,IBIN(/1)
  152. DO 1990 J=1,IBIN(/2)
  153. IF(IBIN(I,J).EQ.0) GO TO 1990
  154. CALL PLACE(NOMDD,LNOMDD,IPO,INCO(I))
  155. IF(IPO.EQ.0) THEN
  156. SEGSUP MTRAV
  157. GO TO 559
  158. ENDIF
  159. SEGINI MWREL1
  160. SEGINI MWREL2
  161. SEGINI MWREL3
  162. IPORE1(**)=MWREL1
  163. IPORE2(**)=MWREL2
  164. IPORE3(**)=MWREL3
  165. COEFR(**)=BB(I,J)
  166. INCREL(**)=IPO
  167. ITYESR(**)=1
  168. MUNESR(**)=1
  169. LNODSR(**)=IGEO(J)
  170. SEGDES MWREL1
  171. SEGDES MWREL2
  172. SEGDES MWREL3
  173. 1990 CONTINUE
  174. SEGSUP MTRAV
  175. GO TO 300
  176. ENDIF
  177. 200 CONTINUE
  178. C
  179. C LETTURA OPERANDI
  180. C
  181. SEGINI MWREL1
  182. SEGINI MWREL2
  183. SEGINI MWREL3
  184. IPORE1(**)=MWREL1
  185. IPORE2(**)=MWREL2
  186. IPORE3(**)=MWREL3
  187. 1320 CONTINUE
  188. CALL LIRREE(XR,0,IRETOF)
  189. IF(IRETOF.EQ.0) THEN
  190. CALL LIRENT(IR,0,IRETOI)
  191. XR=1.D0
  192. IF(IRETOI.NE.0) XR=DBLE(IR)
  193. ENDIF
  194. CALL LIRMOT(NOMDD,LNOMDD,IPO,0)
  195. IF(IPO.NE.0) THEN
  196. COEFR(**)=XR*COEX
  197. INCREL(**)=IPO
  198. ELSE
  199. *
  200. * ON REGARDE SI IL Y A DEPL OU ROTA SUIVI DE DIRECTION
  201. *
  202. C En DIMENSION 1, le mot-cle 'DIRE' est interdit.
  203. IF (IDIM.EQ.1) THEN
  204. INTERR(1)=IDIM
  205. MOTERR(1:4)=MOTBLO(3)
  206. CALL ERREUR(971)
  207. GOTO 559
  208. ENDIF
  209. CALL LIRMOT(MOTBLO,2,IMOT,1)
  210. IF (IMOT.EQ.0) GOTO 559
  211. IF (IMOT.EQ.1) THEN
  212. IBDDL=LDEPL
  213. DO 4481 IA=1,IBDDL
  214. MOTDDL(IA)=MODEPL(IADEPL+IA)
  215. 4481 CONTINUE
  216. ENDIF
  217. IF (IMOT.EQ.2) THEN
  218. IBDDL=LROTA
  219. DO 4482 IA=1,IBDDL
  220. MOTDDL(IA)=MOROTA(IAROTA+IA)
  221. 4482 CONTINUE
  222. ENDIF
  223. CALL LIRMOT(MOTBLO(3),1,IMOT,1)
  224. IF(IMOT.EQ.0) GO TO 559
  225. IDIREC=1
  226. CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  227. IF(IRETOU.EQ.0) GO TO 559
  228. YL=0.D0
  229. DO 4484 IA=1,IDIM
  230. XNOR(IA)=XCOOR((KPOINT-1)*(IDIM+1)+IA)
  231. 4484 YL=YL+XNOR(IA)*XNOR(IA)
  232. IF (YL.LT.EPSI) THEN
  233. CALL ERREUR(239)
  234. GO TO 559
  235. ENDIF
  236. YL=1.D0/SQRT(YL)
  237. DO 4485 IA=1,IDIM
  238. 4485 XNOR(IA)=XNOR(IA)*YL
  239. *
  240. * ON LIT LE MAILLAGE
  241. *
  242. CALL LIROBJ('POINT ',MILPOI,0,IRETOU)
  243. IF(IRETOU.NE.0) THEN
  244. MILMOT='POINT '
  245. ELSE
  246. CALL LIROBJ('MAILLAGE',MILPOI,1,IRETOU)
  247. IF(IRETOU.EQ.0) GO TO 559
  248. MILMOT='MAILLAGE'
  249. ENDIF
  250. *
  251. * PUIS ON REMET DES OBJETS DANS LA PILE
  252. *
  253. DO 4477 IB=1,IBDDL
  254. IF(IB.GE.2.AND.COEX.EQ. 1.D0) CALL ECRCHA(MOTPM(1))
  255. IF(IB.GE.2.AND.COEX.EQ.-1.D0) CALL ECRCHA(MOTPM(2))
  256. CALL ECROBJ(MILMOT,MILPOI)
  257. CALL ECRCHA(MOTDDL(IB))
  258. IF(IBDDL.EQ.1) THEN
  259. XRCOO=XR
  260. ELSE
  261. XRCOO=XR*XNOR(IB)
  262. ENDIF
  263. CALL ECRREE(XRCOO)
  264. 4477 CONTINUE
  265. GO TO 1320
  266. ENDIF
  267. C
  268. CALL LIROBJ('POINT ',KPOINT,0,IRETOU)
  269. IF(IRETOU.NE.0) GO TO 110
  270. CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  271. IF(IRETOU.EQ.0) GO TO 559
  272. MELEME=KOBJET
  273. SEGACT MELEME
  274. NBSOUS=LISOUS(/1)
  275. IF(NBSOUS.EQ.0) GO TO 120
  276. C OBJET COMPLEXE
  277. NNR=1
  278. DO 130 IS=1,NBSOUS
  279. IPT1=LISOUS(IS)
  280. SEGACT IPT1
  281. ITYESR(**)=IPT1.ITYPEL
  282. NBNN =IPT1.NUM(/1)
  283. NBELEM =IPT1.NUM(/2)
  284. MUNESR(**)=IPT1.NUM(/2)
  285. IF(NNR.EQ.1)LNODSR(**)=IPT1.NUM(1,1)
  286. DO 140 I1=1,NBELEM
  287. DO 140 I2=1,NBNN
  288. DO 150 I3=1,NNR
  289. IF(LNODSR(I3).EQ.IPT1.NUM(I2,I1)) GO TO 140
  290. 150 CONTINUE
  291. NNR=NNR+1
  292. LNODSR(**)=IPT1.NUM(I2,I1)
  293. 140 CONTINUE
  294. SEGDES IPT1
  295. 130 CONTINUE
  296. SEGDES MWREL1
  297. SEGDES MWREL2
  298. SEGDES MWREL3
  299. SEGDES MELEME
  300. GO TO 160
  301. C
  302. C OBJET SIMPLE
  303. C
  304. 120 CONTINUE
  305. ITYESR(**)=ITYPEL
  306. NBNN =NUM(/1)
  307. NBELEM =NUM(/2)
  308. MUNESR(**)=NUM(/2)
  309. NNR=0
  310. DO 170 I1=1,NBELEM
  311. DO 170 I2=1,NBNN
  312. DO 180 I3=1,NNR
  313. IF(LNODSR(I3).EQ.NUM(I2,I1)) GO TO 170
  314. 180 CONTINUE
  315. NNR=NNR+1
  316. LNODSR(**)=NUM(I2,I1)
  317. 170 CONTINUE
  318. SEGDES MWREL1
  319. SEGDES MWREL2
  320. SEGDES MWREL3
  321. SEGDES MELEME
  322. GO TO 160
  323. 110 CONTINUE
  324. C
  325. C OBJET POINT
  326. C
  327. ITYESR(**)=1
  328. MUNESR(**)=1
  329. LNODSR(**)=KPOINT
  330. SEGDES MWREL1
  331. SEGDES MWREL2
  332. SEGDES MWREL3
  333. C FINE OPERANDO RELAZIONE
  334. 160 CONTINUE
  335. ICONR=IPORE1(/1)+1
  336. C LETTURA + O -
  337. IF(ICONR.EQ.2) CALL LIRMOT(MOTPM,2,IPO,0)
  338. IF (IPO.EQ.0) GO TO 300
  339. *LIRMOT(MOTPM,2,IPO,1) goto 559
  340. IF(ICONR.GT.2) CALL LIRMOT(MOTPM,2,IPO,0)
  341. IF (IPO.EQ.0) GO TO 300
  342. COEX=1.D0
  343. IF (IPO.EQ.2) COEX=-1.D0
  344. C SI CERCA DI LEGGERE UN NUOVO OPERANDO DELLA RELAZIONE
  345. GO TO 200
  346. C
  347. C VERIFICA CONGRUENZA OPERANDI
  348. C
  349. 300 CONTINUE
  350. C
  351. ICONR=IPORE1(/1)
  352. IEL11=IPORE1(1)
  353. IEL12=IPORE2(1)
  354. IEL13=IPORE3(1)
  355. SEGACT IEL11
  356. SEGACT IEL12
  357. SEGACT IEL13
  358. NSOR1=IEL11.ITYESR(/1)
  359. NNR1=IEL13.LNODSR(/1)
  360. DO 310 IO=2,ICONR
  361. IEL21=IPORE1(IO)
  362. IEL22=IPORE2(IO)
  363. IEL23=IPORE3(IO)
  364. SEGACT IEL21
  365. SEGACT IEL22
  366. SEGACT IEL23
  367. NSOR2=IEL21.ITYESR(/1)
  368. IF(NSOR1.NE.NSOR2) GO TO 556
  369. DO 320 I1=1,NSOR1
  370. IF(IEL11.ITYESR(I1).NE.IEL21.ITYESR(I1)) GO TO 556
  371. IF(IEL12.MUNESR(I1).NE.IEL22.MUNESR(I1)) GO TO 556
  372. 320 CONTINUE
  373. NNR2=IEL23.LNODSR(/1)
  374. IF(NNR1.NE.NNR2) GO TO 556
  375. SEGDES IEL21
  376. SEGDES IEL22
  377. SEGDES IEL23
  378. 310 CONTINUE
  379. NBRELA=NNR1
  380. SEGDES IEL11
  381. SEGDES IEL12
  382. SEGDES IEL13
  383. C OPERANDI CONGRUENTI FINE VERIFICA
  384. C
  385. C CARICAMENTO MATRICE RIGIDEZZA
  386. C
  387. NRIGE=8
  388. NRIGEL=1
  389. SEGINI MRIGID
  390. ICHOLE=0
  391. IMGEO1=0
  392. IMGEO2=0
  393. ISUPEQ=0
  394. IFORIG=IFOUR
  395. COERIG(1)=1.D0
  396. MTYMAT='RIGIDITE'
  397. KRIGI=MRIGID
  398. C
  399. C ON INITIALISE LE SEGMENT MELEME ASSOCIE AUX BLOCAGES
  400. C
  401. SEGACT MCOORD*MOD
  402. NBNO=XCOOR(/1)/(IDIM+1)
  403. NBSOUS=0
  404. NBREF=0
  405. NBNN=1+ICONR
  406. NBELEM=NBRELA
  407. SEGINI IPT2
  408. IRIGEL(1,1)=IPT2
  409. IPT2.ITYPEL=22
  410. DO 400 I4=1,NBRELA
  411. IPT2.ICOLOR(I4)=IDCOUL
  412. C SI CREANO DUE PUNTI PER OGNI RELAZIONE
  413. C** I5=6
  414. C** IF(IDIM.EQ.3) I5=8
  415. I5=(IDIM+1)*2
  416. DO 410 I6=1,I5
  417. XCOOR(**)=0.D0
  418. 410 CONTINUE
  419. C
  420. I7=I4-1
  421. C PUNTI ASSOCIATI AI MOLTIPLICATORI
  422. IPT2.NUM(1,I4)=NBNO+I7+1
  423. 400 CONTINUE
  424. C CARICAMENTO NODI PSEUDO-ELEMENTI
  425. DO 420 I8=1,ICONR
  426. MWREL3=IPORE3(I8)
  427. I10=I8+1
  428. SEGACT MWREL3
  429. DO 430 I9=1,NBRELA
  430. NN=LNODSR(I9)
  431. NPN=(NN-1)*(IDIM+1)
  432. IPT2.NUM(I10,I9)=NN
  433. NPL1=(IPT2.NUM(1,I9)-1)*(IDIM+1)
  434. XCOOR(NPL1+1)=XCOOR(NPL1+1)+XCOOR(NPN+1)
  435. IF (IDIM.GE.2) THEN
  436. XCOOR(NPL1+2)=XCOOR(NPL1+2)+XCOOR(NPN+2)
  437. IF (IDIM.EQ.3) XCOOR(NPL1+3)=XCOOR(NPL1+3)+XCOOR(NPN+3)
  438. ENDIF
  439. 430 CONTINUE
  440. SEGDES MWREL3
  441. 420 CONTINUE
  442. C
  443. C COORDINATE DEI BARICENTRI ASSOCIATI ALLE RELAZIONI
  444. C
  445. DO 425 I4=1,NBRELA
  446. NPL1=(IPT2.NUM(1,I4)-1)*(IDIM+1)
  447. NPL2=NPL1+IDIM+1
  448. XCOOR(NPL1+1)=XCOOR(NPL1+1)/ICONR
  449. XCOOR(NPL2+1)=XCOOR(NPL1+1)
  450. IF (IDIM.GE.2) THEN
  451. XCOOR(NPL1+2)=XCOOR(NPL1+2)/ICONR
  452. XCOOR(NPL2+2)=XCOOR(NPL1+2)
  453. IF (IDIM.EQ.3) THEN
  454. XCOOR(NPL1+3)=XCOOR(NPL1+3)/ICONR
  455. XCOOR(NPL2+3)=XCOOR(NPL1+3)
  456. ENDIF
  457. ENDIF
  458. 425 CONTINUE
  459. SEGDES IPT2
  460. IRIGEL(2,1)=0
  461. IRIGEL(5,1)=NIFOUR
  462. IRIGEL(6,1)=NILATE
  463. NLIGRP=ICONR+1
  464. NLIGRD=NLIGRP
  465. SEGINI DESCR
  466. IRIGEL(3,1)=DESCR
  467. LISINC(1)='LX'
  468. LISDUA(1)='FLX'
  469. NOELEP(1)=1
  470. NOELED(1)=1
  471. DO 700 I1=1,ICONR
  472. I2=I1+1
  473. I3=INCREL(I1)
  474. LISINC(I2)=NOMDD(I3)
  475. LISDUA(I2)=NOMDU(I3)
  476. NOELEP(I2)=I2
  477. NOELED(I2)=I2
  478. 700 CONTINUE
  479. SEGDES DESCR
  480. NELRIG=NBRELA
  481. SEGINI xMATRI
  482. IRIGEL(4,1)=xMATRI
  483. * LVAL=(NBNN*NBNN+NBNN)/2
  484. NLIGRE=NBNN
  485. NLIGRP=NBNN
  486. NLIGRD=NBNN
  487. * SEGINI XMATRI
  488. DO 740 I6=1,NELRIG
  489. * IMATTT(I1)=XMATRI
  490. *740 CONTINUE
  491. RE(1,1,i6)= 0.D0
  492. I3=3
  493. DO 760 I1=2,NBNN
  494. I4=I1-1
  495. I2=1
  496. RE(I1,I2,i6)=COEFR(I4)
  497. RE(I2,I1,i6)=COEFR(I4)
  498. 760 CONTINUE
  499. 740 continue
  500. SEGDES XMATRI
  501. * SEGDES IMATRI
  502. SEGDES MRIGID
  503. CALL ECROBJ('RIGIDITE',KRIGI)
  504. 559 ICONR=IPORE1(/1)
  505. DO 558 I1=1,ICONR
  506. MWREL1=IPORE1(I1)
  507. MWREL2=IPORE2(I1)
  508. MWREL3=IPORE3(I1)
  509. SEGSUP MWREL1
  510. SEGSUP MWREL2
  511. SEGSUP MWREL3
  512. 558 CONTINUE
  513. SEGSUP MWGGM1
  514. SEGSUP MWGGM2
  515. SEGSUP MWGGM3
  516. SEGSUP MWGGM4
  517. SEGSUP MWGGM5
  518. RETURN
  519. 556 CONTINUE
  520. C SEGDES IEL11,IEL12,IEL13,IEL21,IEL22,IEL23
  521. CALL ERREUR(324)
  522. GO TO 559
  523. END
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  

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