Télécharger rglili.eso

Retour à la liste

Numérotation des lignes :

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

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