Télécharger rglimo.eso

Retour à la liste

Numérotation des lignes :

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

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