Télécharger rglimo.eso

Retour à la liste

Numérotation des lignes :

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

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