Télécharger rglimo.eso

Retour à la liste

Numérotation des lignes :

  1. C RGLIMO SOURCE BP208322 17/07/25 21:15:19 9518
  2. SUBROUTINE RGLIMO(IMODE,ISOLS,ISTRU,IRIG,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C CE SUBROUTINE CALCULE LOBJET RIGIDITE QUI COUPLE LES LIAISONS ET
  8. C LES MODES . (FORMALISME GIBERT).
  9. C CETTE RIGIDITE EST DE TYPE MASSE.
  10. C ELLE EST ASSOCIEE A L ELEMENT QUI CONTIENT :
  11. C . LE POINT QUI EST L INDICE DU MODE
  12. C . LE POINT QUI EST ASSOCIE A LA LIAISON.
  13. C ELEMENT DE TYPE 27. LE RESULTAT EST MIS DANS IRET .
  14. C
  15. C APPELE PAR RIGI, RGBASE
  16. C APPELLE ETALPR,ETALCH,ECCHPO,ERREUR(234,235)
  17. C ECRIT PAR FARVACQUE
  18. C=======================================================================
  19. C
  20. -INC CCOPTIO
  21. -INC SMRIGID
  22. -INC CCREEL
  23. *-
  24. -INC SMSOLUT
  25. -INC SMATTAC
  26. -INC SMELEME
  27. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  28. SEGMENT IINC
  29. CHARACTER*4 CIINC(0)
  30. ENDSEGMENT
  31. SEGMENT/ICONTR/(MCONTR(NNI1,IPR1))
  32. SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA
  33. SEGMENT IPB(IPR1)
  34. SEGMENT ITRAV(6)
  35. NBSOUS=0
  36. NBREF=0
  37. NBNN=2
  38. * LVAL=3
  39. NLIGRP=2
  40. NLIGRD=2
  41. IRET=0
  42. C
  43. IF(ISOLS.EQ.0.OR.IMODE.EQ.0) GO TO 5000
  44. IF(IRIG.NE.1) GO TO 5000
  45. MSOLUT=ISOLS
  46. SEGACT MSOLUT
  47. KJONC=MSOLIS(10)
  48. MELSOL=MSOLIS(3)
  49. MELEME=MELSOL
  50. MSOLE2=KJONC
  51. SEGDES MSOLUT
  52. C
  53. MSOLUT=IMODE
  54. SEGACT MSOLUT
  55. KVALM=MSOLIS(4)
  56. KDEPL=MSOLIS(5)
  57. MELMOD=MSOLIS(3)
  58. MELEME=MELMOD
  59. SEGDES MSOLUT
  60. MSOLEN=KVALM
  61. MSOLE1=KDEPL
  62. IF(MSOLE1.NE.0) GO TO 9
  63. MOTERR(1:8)='SOLUTION'
  64. MOTERR(9:26)=ITYSOL
  65. MOTERR(30:38)='DEPL'
  66. CALL ERREUR(235)
  67. C ON NE TROUVE PAS LA TABLE QUI CONTIENT LES DEPLACEMENTS
  68. GO TO 5000
  69. 9 CONTINUE
  70. SEGACT MSOLE2
  71. C
  72. C **** ON COMPTE LES LIAISONS LIBRES(NZRILI) ET BLOQUEES(NZRIBL)
  73. C **** ON INITIALISE UN MELEME POUR CHAQUE CAS : IPT1(LIBRE),IPT2(BLOQU
  74. C
  75. NZRILI=0
  76. NZRIBL=0
  77. NRIGEL=0
  78. NJONC=MSOLE2.ISOLEN(/1)
  79. IF(NJONC.NE.0) THEN
  80. DO 20 I=1,NJONC
  81. MJONCT=MSOLE2.ISOLEN(I)
  82. SEGACT MJONCT
  83. IF(MJOTYP.EQ.'MECA'.OR.MJOTYP.EQ.'FLUI') THEN
  84. IF(MJODDL.EQ.'LX ') NZRILI=NZRILI+1
  85. IF(MJODDL.EQ.'FLX ') NZRIBL=NZRIBL+1
  86. ENDIF
  87. SEGDES MJONCT
  88. 20 CONTINUE
  89. ENDIF
  90. SEGDES MSOLE2
  91. IF(NZRILI.EQ.0.AND.NZRIBL.EQ.0) GO TO 5000
  92. C
  93. SEGINI ITRAV
  94. SEGACT MSOLEN,MSOLE1,MSOLE2
  95. NMOD=ISOLEN(/1)
  96. C
  97. IF(NZRILI.EQ.0) GO TO 29
  98. NBELEM=NMOD*NZRILI
  99. SEGINI IPT1
  100. IPT1.ITYPEL=27
  101. NLIGRP=2
  102. NLIGRD=2
  103. SEGINI DESCR
  104. NOELEP(1)=1
  105. NOELEP(2)=2
  106. NOELED(1)=1
  107. NOELED(2)=2
  108. NELRIG=NBELEM
  109. SEGINI xMATRI
  110. IMATLI=xMATRI
  111. * SEGDES IMATRI
  112. LISINC(1)='ALFA'
  113. LISINC(2)='BETA'
  114. LISDUA(1)='FALF'
  115. LISDUA(2)='FBET'
  116. SEGDES DESCR
  117. NRIGEL=NRIGEL+1
  118. ITRAV(NRIGEL)=IPT1
  119. NRIGEL=NRIGEL+1
  120. ITRAV(NRIGEL)=DESCR
  121. NRIGEL=NRIGEL+1
  122. ITRAV(NRIGEL)=IMATLI
  123. C
  124. 29 IF(NZRIBL.EQ.0) GO TO 290
  125. NBELEM=NMOD*NZRIBL
  126. SEGINI IPT2
  127. IPT2.ITYPEL=27
  128. NLIGRP=2
  129. NLIGRD=2
  130. SEGINI DESCR
  131. NELRIG=NBELEM
  132. SEGINI xMATRI
  133. IMATBL=xMATRI
  134. * SEGDES IMATRI
  135. NOELEP(1)=1
  136. NOELEP(2)=2
  137. NOELED(1)=1
  138. NOELED(2)=2
  139. LISINC(1)='ALFA'
  140. LISINC(2)='FBET'
  141. LISDUA(1)='FALF'
  142. LISDUA(2)='BETA'
  143. SEGDES DESCR
  144. NRIGEL=NRIGEL+1
  145. ITRAV(NRIGEL)=IPT2
  146. NRIGEL=NRIGEL+1
  147. ITRAV(NRIGEL)=DESCR
  148. NRIGEL=NRIGEL+1
  149. ITRAV(NRIGEL)=IMATBL
  150. 290 CONTINUE
  151. C
  152. C **** PREPARATION DE KMVA,KMVB,IPB POUR ETALER LES CHPOINTS
  153. C
  154. IPM=MSOLE1.ISOLEN(1)
  155. CALL ETALPR(IPM,KIINC,KICPR,KCONTR)
  156. ICONTR=KCONTR
  157. SEGACT ICONTR
  158. IPR1=MCONTR(/2)
  159. NNI1=MCONTR(/1)
  160. SEGINI MVA
  161. KMVA=MVA
  162. SEGINI MVA
  163. KMVB=MVA
  164. SEGINI IPB
  165. KIPB=IPB
  166. C
  167. C **** BOUCLE SUR LES MODES .IPO1 EST LE POINT QUI CORRESPOND AU MODE
  168. C **** IP2 LE CHPOINT QU ON ETALE DANS KMVA
  169. C
  170. NZRILI=0
  171. NZRIBL=0
  172. MELEME=MELMOD
  173. SEGACT MELEME
  174. MELEME=MELSOL
  175. SEGACT MELEME
  176. DO 2 IM=1,ISOLEN(/1)
  177. MELEME=MELMOD
  178. IPO1=NUM(1,IM)
  179. MMODE=ISOLEN(IM)
  180. SEGACT MMODE
  181. OMEG=2.*XPI*FMMODD(1)
  182. OMEG=OMEG*OMEG
  183. SEGDES MMODE
  184. IP2=MSOLE1.ISOLEN(IM)
  185. IF(IP2.NE.0) GO TO 8
  186. MSOLUT=IMODE
  187. SEGACT MSOLUT
  188. MOTERR(1:8)=ITYSOL
  189. SEGDES MSOLUT
  190. MOTERR(9:12)='DEPL'
  191. INTERR(1)=IM
  192. CALL ERREUR(234)
  193. GO TO 5000
  194. 8 CONTINUE
  195. KZERO=0
  196. CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  197. C
  198. C **** BOUCLE SUR LES MJONCT . IPO2 EST LE POINT QUI CORRESPOND
  199. C
  200. DO 30 IJ=1,NJONC
  201. MJONCT=MSOLE2.ISOLEN(IJ)
  202. SEGACT MJONCT
  203. RLIBRE=-1.
  204. IF(MJODDL.EQ.'FLX ') RLIBRE=1.
  205. MELEME=MELSOL
  206. IPO2=NUM(1,IJ)
  207. C
  208. C **** FABRICATION DE L ELEMENT. INITIALISATION DE XMATRI
  209. C
  210. * SEGINI XMATRI
  211. IF(RLIBRE.EQ.1.) GO TO 16
  212. NZRILI=NZRILI+1
  213. IPT1.NUM(1,NZRILI)=IPO1
  214. IPT1.NUM(2,NZRILI)=IPO2
  215. xMATRI=IMATLI
  216. segact xmatri*mod
  217. izpos=nzrili
  218. * SEGACT IMATRI*MOD
  219. * IMATTT(NZRILI)=XMATRI
  220. * SEGDES IMATRI
  221. GO TO 17
  222. 16 CONTINUE
  223. NZRIBL=NZRIBL+1
  224. IPT2.NUM(1,NZRIBL)=IPO1
  225. IPT2.NUM(2,NZRIBL)=IPO2
  226. xMATRI=IMATBL
  227. segact xmatri*mod
  228. izpos=NZRIBL
  229. * SEGACT IMATRI*MOD
  230. * IMATTT(NZRIBL)=XMATRI
  231. * SEGDES IMATRI
  232. 17 CONTINUE
  233. C
  234. C **** DANS MJONCT ON CHERCHE LA STRUCTURE MSOSTU
  235. C **** IPP2 EST LE CHPOINT DE P QU ON ETALE DANS KMVB.ON REMPLIT IPB.
  236. C
  237. NST=ISTRJO(/1)
  238. DO 31 IS=1,NST
  239. IF(ISTRJO(IS).NE. ISTRU) GO TO 31
  240. IPP2=IPCHJO(IS)
  241. CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  242. C
  243. C **** OPERATION KMVA*KMVB
  244. C
  245. MVA=KMVA
  246. MVA1=KMVB
  247. IPB=KIPB
  248. SEGACT MVA,MVA1,IPB
  249. XRET=0.
  250. DO 80 J1=1,NPR2
  251. JJ1=IPB(J1)
  252. DO 80 I1=1,NNI1
  253. XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  254. 80 CONTINUE
  255. SEGDES MVA,MVA1,IPB
  256. RE(1,2,izpos)=RE(1,2,izpos)+RLIBRE*XRET/OMEG
  257. RE(2,1,izpos)=RE(1,2,izpos)
  258. C
  259. 31 CONTINUE
  260. SEGDES MJONCT,xmatri
  261. 30 CONTINUE
  262.  
  263. C
  264. 2 CONTINUE
  265. MELEME=MELSOL
  266. SEGDES MELEME
  267. MELEME=MELMOD
  268. SEGDES MELEME
  269. SEGDES MSOLE1,MSOLE2,MSOLEN
  270. xMATRI=IMATLI
  271. IF(NZRILI.NE.0)SEGDES xMATRI,IPT1
  272. xMATRI=IMATBL
  273. IF(NZRIBL.NE.0)SEGDES xMATRI,IPT2
  274. IINC=KIINC
  275. SEGSUP IINC
  276. ICPR=KICPR
  277. SEGSUP ICPR
  278. SEGSUP MVA,MVA1,IPB,ICONTR
  279. C
  280. C
  281. C **** FABRICATION DU SEGMENT MRIGID
  282. C
  283. NRIGEL=NRIGEL/3
  284. IF(NRIGEL.EQ.0) GO TO 5000
  285. NRIGE=6
  286. SEGINI MRIGID
  287. DO 40 I=1,NRIGEL
  288. IRIGEL(1,I)=ITRAV(3*I-2)
  289. IRIGEL(2,I)=0
  290. IRIGEL(3,I)=ITRAV(3*I-1)
  291. IRIGEL(4,I)=ITRAV(3*I)
  292. IRIGEL(5,I)=NIFOUR
  293. IRIGEL(6,I)=0
  294. COERIG(I)=1.D0
  295. 40 CONTINUE
  296. SEGSUP ITRAV
  297. MTYMAT='MASSE'
  298. ICHOLE=0
  299. IMGEO1=0
  300. IMGEO2=0
  301. IFORIG=IFOMOD
  302. SEGDES MRIGID
  303. IRET=MRIGID
  304. 5000 CONTINUE
  305. RETURN
  306. END
  307.  
  308.  
  309.  
  310.  
  311.  

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