Télécharger rglili.eso

Retour à la liste

Numérotation des lignes :

  1. C RGLILI SOURCE BP208322 17/07/25 21:15:18 9518
  2. SUBROUTINE RGLILI(ISOLS,ISTRU,IRIG,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C CE SUBROUTINE CALCULE POUR LES SOLUTIONS STATIQUES ISOLS DE TYPE :
  7. C 1-MECA OU FLUI
  8. C LES RIGIDITES DE COUPLAGE DES LIAISONS ENTRE ELLES (FORMALISME GIBERT)
  9. C DE SOUS TYPE MASSE SI IRIG=1, DE SOUS TYPE RIGIDITE SI IRIG=2
  10. C ECRIT PAR FARVACQUE
  11. C 2-DEPI
  12. C UNE MATRICE DE RIGIDITE NULLE ET UNE MATRICE DE MASSE IDENTITE
  13. C (FORMALISME DEPLACEMENTS IMPOSES SUR MODES BLOQUES POUR DEVO)
  14. C ECRIT PAR GUILBAUD
  15. C
  16. C ELLES S'APPUIENT SUR L ELEMENT QUI CONTIENT TOUS LES POINTS ASSOCIES
  17. C AUX LIAISONS MJONCT.
  18. C
  19. C APPELE PAR RIGI,RGBASE
  20. C APPELLE : ETALPR,MUCPRI,ETALCH,YTMX,ERREUR(235,108)
  21. C=======================================================================
  22. -INC CCOPTIO
  23. -INC SMSOLUT
  24. -INC SMRIGID
  25. -INC SMATTAC
  26. -INC SMELEME
  27. -INC SMSTRUC
  28. -INC CCHAMP
  29. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  30. CHARACTER*4 IDDL
  31. SEGMENT IINC
  32. CHARACTER*4 CIINC(0)
  33. ENDSEGMENT
  34. SEGMENT IIDU
  35. CHARACTER*4 CIIDU(NNI1)
  36. ENDSEGMENT
  37. SEGMENT ITRMEC(NJONC)
  38. SEGMENT ITRDEP(NJONC)
  39. SEGMENT ITRAV(6)
  40. SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA
  41. SEGMENT/ICONTR/(MCONTR(NNI1,IPR1))
  42. SEGMENT IPB(IPR1)
  43. DATA KZERO/0/
  44. C
  45. IRET=0
  46. IF(IRIG.NE.1.AND.IRIG.NE.2) GOTO 8000
  47. MSOSTU=ISTRU
  48. MSOLUT=ISOLS
  49. SEGACT MSOLUT
  50. NIPO=MSOLIS(/1)
  51. KJONC=MSOLIS(10)
  52. KDEPL=MSOLIS(5)
  53. IF(KDEPL.NE.0) GO TO 12
  54. MOTERR(1:8)='SOLUTION'
  55. MOTERR(9:26)='SOLUTION'
  56. MOTERR(30:38)='DEPL'
  57. SEGDES MSOLUT
  58. CALL ERREUR(235)
  59. C ON NE TROUVE PAS LES DEPL
  60. GO TO 8000
  61. 12 CONTINUE
  62. SEGDES MSOLUT
  63. MSOLE1=KJONC
  64. SEGACT MSOLE1
  65. NJONC=MSOLE1.ISOLEN(/1)
  66. SEGDES MSOLE1
  67. IF(NJONC.EQ.0) GO TO 8000
  68. C
  69. SEGINI ITRMEC,ITRDEP
  70. SEGACT MSOLE1
  71. NJOMEC=0
  72. NJODEP=0
  73. DO 20 I=1,NJONC
  74. MJONCT=MSOLE1.ISOLEN(I)
  75. SEGACT MJONCT
  76. IF(MJOTYP.EQ.'MECA'.OR.MJOTYP.EQ.'FLUI') THEN
  77. NJOMEC=NJOMEC+1
  78. ITRMEC(NJOMEC)=I
  79. ELSEIF(MJOTYP.EQ.'DEPI'.AND.IRIG.EQ.1) THEN
  80. NJODEP=NJODEP+1
  81. ITRDEP(NJODEP)=I
  82. ENDIF
  83. SEGDES MJONCT
  84. 20 CONTINUE
  85. SEGDES MSOLE1
  86. IF(NJOMEC.EQ.0.AND.NJODEP.EQ.0) GOTO 7000
  87. IF(NJOMEC.EQ.0) GO TO 5000
  88. C
  89. C **** INITIALISATION DE LA GEOMETRIE(1 ELEMENT QUI CONTIENT TOUS LES
  90. C **** POINT-LIAISONS) ET DE LA MATRICE ASSOCIEE XMATRI
  91. C **** INITIALISATION DE IMATRI ET DE DESCR
  92. C
  93. NJONC=NJOMEC
  94. LVAL=NJONC*(NJONC+1)/2
  95. NLIGRP=NJONC
  96. NLIGRD=NJONC
  97. nelrig=1
  98. SEGINI XMATRI
  99. * NLIGRE=NJONC
  100. SEGINI DESCR
  101. NELRIG=1
  102. * SEGINI IMATRI
  103. * IMATTT(1)=XMATRI
  104. * SEGDES IMATRI
  105. SEGACT MSOLUT
  106. IPT1=MSOLIS(3)
  107. SEGACT IPT1
  108. NBSOUS=0
  109. NBREF=0
  110. NBNN=NJONC
  111. NBELEM=1
  112. SEGINI MELEME
  113. ITYPEL=27
  114. MSOLEN=KDEPL
  115. C
  116. C **** PREPARATION DES OPERATIONS : A IPM ON DONNE LA FORME RECTANGLE
  117. C
  118. SEGACT MSOLEN
  119. IPM=ISOLEN(1)
  120. CALL ETALPR(IPM,KIINC,KICPR,KCONTR)
  121. ICONTR=KCONTR
  122. SEGACT ICONTR
  123. IPR1=MCONTR(/2)
  124. NNI1=MCONTR(/1)
  125. SEGINI MVA
  126. KMVA=MVA
  127. SEGINI MVA
  128. KMVB=MVA
  129. SEGINI IPB
  130. KIPB=IPB
  131. IINC=KIINC
  132. SEGACT IINC
  133. SEGINI IIDU
  134. DO 50 I=1,NNI1
  135. IDDL=CIINC(I)
  136. DO 51 J=1,LNOMDD
  137. IF(IDDL.NE.NOMDD(J)) GOTO 51
  138. CIIDU(I)=NOMDU(J)
  139. GOTO 50
  140. 51 CONTINUE
  141. MOTERR(1:4)=IDDL
  142. CALL ERREUR(108)
  143. C ON NE TROUVE PAS IDDL DANS CCHAMP
  144. GOTO 7000
  145. 50 CONTINUE
  146. KINCDU=IIDU
  147. IF(IIMPI.NE.0)WRITE(6,8883)(CIINC(I),CIIDU(I),I=1,NNI1)
  148. 8883 FORMAT(20(1X,A4))
  149. C
  150. C **** CAS IRIG=1 : TERMES DANS LA MATRICE MASSE : UT.M.U
  151. C
  152. IF(IRIG.NE.1) GO TO 100
  153. SEGACT MSOSTU
  154. MATMAS=ISMASS
  155. SEGDES MSOSTU
  156. SEGACT MSOLE1,MSOLEN
  157. LTAB=ISOLEN(/1)
  158. DO 9 I=1,NJONC
  159. MJONCT=MSOLE1.ISOLEN(ITRMEC(I))
  160. SEGACT MJONCT
  161. NOELEP(I)=I
  162. NOELED(I)=I
  163. IF(MJODDL.EQ.'LX ') GO TO 16
  164. LISINC(I)='FBET'
  165. LISDUA(I)='BETA'
  166. GO TO 17
  167. 16 LISINC(I)='BETA'
  168. LISDUA(I)='FBET'
  169. 17 CONTINUE
  170. SEGDES MJONCT
  171. NUM(I,1)=IPT1.NUM(1,ITRMEC(I))
  172. 9 CONTINUE
  173. C
  174. KZERO=0
  175. DO 10 I=1,NJONC
  176. IP1=ISOLEN(I)
  177. CALL MUCPRI(IP1,MATMAS,MUI)
  178. IF(IERR.NE.0) GOTO 8000
  179. CALL ETALCH(MUI,KINCDU,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  180. IF(IERR.NE.0) GO TO 8000
  181. C
  182. IF(IIMPI.EQ.0) GOTO 804
  183. MVA=KMVB
  184. IPB=KIPB
  185. SEGACT MVA,IPB
  186. WRITE(IOIMP,7878)I
  187. 7878 FORMAT(' ************* DANS RGLILI CALCUL DE UJ.M.UI ****',
  188. 1 /,' ========== I=',I4,' ECRITURE DE M.UI SOUS LA FORME VA
  189. 1 PUIS IPB')
  190. WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  191. WRITE(IOIMP,8882)(IPB(KJ2),KJ2=1,IPR1)
  192. 804 CONTINUE
  193. C
  194. DO 11 J=I,NJONC
  195. IP2=ISOLEN(J)
  196. CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  197. IF(IERR.NE.0) GOTO 8000
  198. C
  199. IF(IIMPI.EQ.0) GO TO 803
  200. MVA=KMVA
  201. SEGACT MVA
  202. WRITE(IOIMP,7879)J
  203. 7879 FORMAT(' ========== J=',I4,' ECRITURE DE UJ SOUS LA FORME VA')
  204. WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  205. 803 CONTINUE
  206. C
  207. C **** OPERATION UT . ( M.U )
  208. C
  209. MVA=KMVA
  210. MVA1=KMVB
  211. IPB=KIPB
  212. SEGACT MVA,MVA1,IPB
  213. XRET=0.
  214. DO 81 J1=1,NPR2
  215. JJ1=IPB(J1)
  216. DO 81 I1=1,NNI1
  217. XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  218. 81 CONTINUE
  219. C
  220. IF(IIMPI.EQ.0) GOTO 805
  221. CALL YTMX(IP1,IP2,MATMAS,WW)
  222. WRITE(IOIMP,7877)XRET,WW
  223. 7877 FORMAT(' UI.M.UJ = ',E12.5,' PAR L''OPERATEUR YTMX ON TROUVE '
  224. 1 ,E12.5)
  225. 805 CONTINUE
  226. C
  227. * K=(J*(J-1)/2)+I
  228. RE(J,I,1)=XRET
  229. RE(I,J,1)=XRET
  230. 11 CONTINUE
  231. 10 CONTINUE
  232. GO TO 6
  233. C
  234. C **** CAS IRIG=2 : MATRICE RAIDEUR : LIGNE J COLONNE I: UI ET PJ
  235. C
  236. 100 CONTINUE
  237. C
  238. C **** PREMIERE BOUCLE SUR LESMJONCT. ON EN SORT MCHPOI QU ON ETALE
  239. C **** DANS MVA . C EST UI
  240. C
  241. SEGACT MSOLEN,MSOLE1
  242. LTAB=ISOLEN(/1)
  243. DO 30 IJO1=1,NJONC
  244. MJONCT=MSOLE1.ISOLEN(ITRMEC(IJO1))
  245. SEGACT MJONCT
  246. RLIBRE=1.
  247. IF(MJODDL.EQ.'FLX ') RLIBRE=-1.
  248. NOELEP(IJO1)=IJO1
  249. NOELED(IJO1)=IJO1
  250. IF(MJODDL.EQ.'LX ') GO TO 18
  251. LISINC(IJO1)='FBET'
  252. LISDUA(IJO1)='BETA'
  253. GO TO 19
  254. 18 LISINC(IJO1)='BETA'
  255. LISDUA(IJO1)='FBET'
  256. 19 CONTINUE
  257. NUM(IJO1,1)=IPT1.NUM(1,ITRMEC(IJO1))
  258. SEGDES MJONCT
  259. IP1=ISOLEN(ITRMEC(IJO1))
  260. KZERO=0
  261. CALL ETALCH(IP1,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  262. IF(IERR.NE.0) GO TO 8000
  263. IF(IIMPI.EQ.0) GO TO 800
  264. MVA=KMVA
  265. SEGACT MVA
  266. WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  267. 8880 FORMAT(8(2X,E12.5))
  268. 800 CONTINUE
  269. C
  270. C **** 2IEME BOUCLE SUR LES MJONCT: ON EN TIRE PJ QU ON ETALE DANS MVB
  271. C
  272. DO 31 IJO2=IJO1,NJONC
  273. MJONCT=MSOLE1.ISOLEN(ITRMEC(IJO2))
  274. SEGACT MJONCT
  275. NST=ISTRJO(/1)
  276. DO 32 IS=1,NST
  277. IF(ISTRJO(IS).NE.MSOSTU) GO TO 32
  278. IPP2=IPCHJO(IS)
  279. CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  280. IF(IERR.NE.0) GO TO 8000
  281. IF(IIMPI.EQ.0) GO TO 801
  282. MVA=KMVB
  283. IPB=KIPB
  284. SEGACT MVA,IPB
  285. WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1)
  286. WRITE(IOIMP,8882)(IPB(KJ2),KJ2=1,IPR1)
  287. 8882 FORMAT( 10I6)
  288. 801 CONTINUE
  289. C
  290. C **** OPERATION VA*VB
  291. C
  292. MVA=KMVA
  293. MVA1=KMVB
  294. IPB=KIPB
  295. SEGACT MVA,MVA1,IPB
  296. C
  297. XRET=0.
  298. DO 80 J1=1,NPR2
  299. JJ1=IPB(J1)
  300. DO 80 I1=1,NNI1
  301. XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  302. 80 CONTINUE
  303. C
  304. * K=(IJO2*(IJO2-1)/2)+IJO1
  305. RE(IJO2,IJO1,1)=RE(IJO2,IJO1,1)+XRET*RLIBRE
  306. RE(IJO1,IJO2,1)=RE(IJO2,IJO1,1)
  307. 32 CONTINUE
  308. SEGDES MJONCT
  309. 31 CONTINUE
  310. 30 CONTINUE
  311. SEGDES MSOLE1
  312. C
  313. 6 CONTINUE
  314. IINC=KIINC
  315. SEGSUP IINC
  316. IIDU=KINCDU
  317. SEGSUP IIDU
  318. ICPR=KICPR
  319. SEGSUP ICPR
  320. SEGSUP ICONTR
  321. SEGSUP MVA,MVA1,IPB
  322. SEGDES DESCR,MELEME,XMATRI,IPT1,MSOLUT
  323. SEGINI ITRAV
  324. ITRAV(1)=MELEME
  325. ITRAV(2)=0
  326. ITRAV(3)=DESCR
  327. ITRAV(4)=xMATRI
  328. ITRAV(5)=NIFOUR
  329. ITRAV(6)=0
  330. 5000 CONTINUE
  331. C
  332. C LIAISON POUR DEPLACEMENT IMPOSE
  333. C
  334. IF(NJODEP.EQ.0) GO TO 6000
  335. C
  336. C **** INITIALISATION DE LA GEOMETRIE(1 ELEMENT QUI CONTIENT TOUS LES
  337. C **** POINT-LIAISONS) ET DE LA MATRICE ASSOCIEE XMATRI
  338. C **** INITIALISATION DE IMATRI ET DE DESCR
  339. C
  340. NJONC=NJODEP
  341. * LVAL=NJONC*(NJONC+1)/2
  342. NLIGRP=NJONC
  343. NLIGRD=NJONC
  344. nelrig=1
  345. SEGINI XMATRI
  346. * DO 40 K=1,LVAL
  347. * RE(K)=0.D0
  348. * 40 CONTINUE
  349. SEGINI DESCR
  350. NELRIG=1
  351. * SEGINI IMATRI
  352. * IMATTT(1)=XMATRI
  353. * SEGDES IMATRI
  354. SEGACT MSOLUT
  355. IPT1=MSOLIS(3)
  356. SEGACT IPT1
  357. NBSOUS=0
  358. NBREF=0
  359. NBNN=NJONC
  360. NBELEM=1
  361. SEGINI MELEME
  362. ITYPEL=27
  363. DO 41 I=1,NJONC
  364. NOELEP(I)=I
  365. NOELED(I)=I
  366. LISINC(I)='FBET'
  367. LISDUA(I)='BETA'
  368. NUM(I,1)=IPT1.NUM(1,ITRDEP(I))
  369. RE(I,I,1)=1.D0
  370. 41 CONTINUE
  371. SEGSUP ITRDEP
  372. SEGDES DESCR,MELEME,XMATRI,MSOLUT,IPT1
  373. C
  374. C CREATION DE MRIGID
  375. C
  376. 6000 CONTINUE
  377. NRIGEL=1
  378. IF(NJOMEC.NE.0.AND.NJODEP.NE.0) NRIGEL=2
  379. NRIGE=6
  380. SEGINI MRIGID
  381. ICHOLE=0
  382. IMGEO1=0
  383. IMGEO2=0
  384. IFORIG=IFOMOD
  385. IF(IRIG.EQ.1) THEN
  386. MTYMAT='MASSE '
  387. ELSE
  388. MTYMAT='RIGIDITE'
  389. ENDIF
  390. I=0
  391. IF(NJOMEC.NE.0) THEN
  392. I=I+1
  393. COERIG(I)=1.D0
  394. IRIGEL(1,I)=ITRAV(1)
  395. IRIGEL(2,I)=ITRAV(2)
  396. IRIGEL(3,I)=ITRAV(3)
  397. IRIGEL(4,I)=ITRAV(4)
  398. IRIGEL(5,I)=ITRAV(5)
  399. IRIGEL(6,I)=ITRAV(6)
  400. xmatr1=itrav(4)
  401. segdes xmatr1
  402. SEGSUP ITRAV
  403.  
  404. ENDIF
  405. IF(NJODEP.NE.0) THEN
  406. I=I+1
  407. COERIG(I)=1.D0
  408. IRIGEL(1,I)=MELEME
  409. IRIGEL(2,I)=0
  410. IRIGEL(3,I)=DESCR
  411. IRIGEL(4,I)=xMATRI
  412. IRIGEL(5,I)=NIFOUR
  413. IRIGEL(6,I)=0
  414. segdes xmatri
  415. ENDIF
  416.  
  417. SEGDES MRIGID
  418. IRET=MRIGID
  419. 7000 CONTINUE
  420. SEGSUP ITRMEC,ITRDEP
  421. 8000 CONTINUE
  422. RETURN
  423. END
  424.  
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  

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