Télécharger rglili.eso

Retour à la liste

Numérotation des lignes :

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

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