Télécharger rela1.eso

Retour à la liste

Numérotation des lignes :

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

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