Télécharger rglimo.eso

Retour à la liste

Numérotation des lignes :

  1. C RGLIMO SOURCE GF238795 18/02/05 21:15:54 9726
  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 ETALPR(IPM,KIINC,KICPR,KCONTR)
  159. ICONTR=KCONTR
  160. SEGACT ICONTR
  161. IPR1=MCONTR(/2)
  162. NNI1=MCONTR(/1)
  163. SEGINI MVA
  164. KMVA=MVA
  165. SEGINI MVA
  166. KMVB=MVA
  167. SEGINI IPB
  168. KIPB=IPB
  169. C
  170. C **** BOUCLE SUR LES MODES .IPO1 EST LE POINT QUI CORRESPOND AU MODE
  171. C **** IP2 LE CHPOINT QU ON ETALE DANS KMVA
  172. C
  173. NZRILI=0
  174. NZRIBL=0
  175. MELEME=MELMOD
  176. SEGACT MELEME
  177. MELEME=MELSOL
  178. SEGACT MELEME
  179. DO 2 IM=1,ISOLEN(/1)
  180. MELEME=MELMOD
  181. IPO1=NUM(1,IM)
  182. MMODE=ISOLEN(IM)
  183. SEGACT MMODE
  184. OMEG=2.*XPI*FMMODD(1)
  185. OMEG=OMEG*OMEG
  186. SEGDES MMODE
  187. IP2=MSOLE1.ISOLEN(IM)
  188. IF(IP2.NE.0) GO TO 8
  189. MSOLUT=IMODE
  190. SEGACT MSOLUT
  191. MOTERR(1:8)=ITYSOL
  192. SEGDES MSOLUT
  193. MOTERR(9:12)='DEPL'
  194. INTERR(1)=IM
  195. CALL ERREUR(234)
  196. GO TO 5000
  197. 8 CONTINUE
  198. KZERO=0
  199. CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID,1)
  200. C
  201. C **** BOUCLE SUR LES MJONCT . IPO2 EST LE POINT QUI CORRESPOND
  202. C
  203. DO 30 IJ=1,NJONC
  204. MJONCT=MSOLE2.ISOLEN(IJ)
  205. SEGACT MJONCT
  206. RLIBRE=-1.
  207. IF(MJODDL.EQ.'FLX ') RLIBRE=1.
  208. MELEME=MELSOL
  209. IPO2=NUM(1,IJ)
  210. C
  211. C **** FABRICATION DE L ELEMENT. INITIALISATION DE XMATRI
  212. C
  213. * SEGINI XMATRI
  214. IF(RLIBRE.EQ.1.) GO TO 16
  215. NZRILI=NZRILI+1
  216. IPT1.NUM(1,NZRILI)=IPO1
  217. IPT1.NUM(2,NZRILI)=IPO2
  218. xMATRI=IMATLI
  219. segact xmatri*mod
  220. izpos=nzrili
  221. * SEGACT IMATRI*MOD
  222. * IMATTT(NZRILI)=XMATRI
  223. * SEGDES IMATRI
  224. GO TO 17
  225. 16 CONTINUE
  226. NZRIBL=NZRIBL+1
  227. IPT2.NUM(1,NZRIBL)=IPO1
  228. IPT2.NUM(2,NZRIBL)=IPO2
  229. xMATRI=IMATBL
  230. segact xmatri*mod
  231. izpos=NZRIBL
  232. * SEGACT IMATRI*MOD
  233. * IMATTT(NZRIBL)=XMATRI
  234. * SEGDES IMATRI
  235. 17 CONTINUE
  236. C
  237. C **** DANS MJONCT ON CHERCHE LA STRUCTURE MSOSTU
  238. C **** IPP2 EST LE CHPOINT DE P QU ON ETALE DANS KMVB.ON REMPLIT IPB.
  239. C
  240. NST=ISTRJO(/1)
  241. DO 31 IS=1,NST
  242. IF(ISTRJO(IS).NE. ISTRU) GO TO 31
  243. IPP2=IPCHJO(IS)
  244. CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2,1)
  245. C
  246. C **** OPERATION KMVA*KMVB
  247. C
  248. MVA=KMVA
  249. MVA1=KMVB
  250. IPB=KIPB
  251. SEGACT MVA,MVA1,IPB
  252. XRET=0.
  253. DO 80 J1=1,NPR2
  254. JJ1=IPB(J1)
  255. DO 80 I1=1,NNI1
  256. XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1)
  257. 80 CONTINUE
  258. SEGDES MVA,MVA1,IPB
  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. SEGDES MELEME
  270. MELEME=MELMOD
  271. SEGDES MELEME
  272. SEGDES MSOLE1,MSOLE2,MSOLEN
  273. xMATRI=IMATLI
  274. IF(NZRILI.NE.0)SEGDES xMATRI,IPT1
  275. xMATRI=IMATBL
  276. IF(NZRIBL.NE.0)SEGDES xMATRI,IPT2
  277. IINC=KIINC
  278. SEGSUP IINC
  279. ICPR=KICPR
  280. SEGSUP ICPR
  281. SEGSUP MVA,MVA1,IPB,ICONTR
  282. C
  283. C
  284. C **** FABRICATION DU SEGMENT MRIGID
  285. C
  286. NRIGEL=NRIGEL/3
  287. IF(NRIGEL.EQ.0) GO TO 5000
  288. NRIGE=6
  289. SEGINI MRIGID
  290. DO 40 I=1,NRIGEL
  291. IRIGEL(1,I)=ITRAV(3*I-2)
  292. IRIGEL(2,I)=0
  293. IRIGEL(3,I)=ITRAV(3*I-1)
  294. IRIGEL(4,I)=ITRAV(3*I)
  295. IRIGEL(5,I)=NIFOUR
  296. IRIGEL(6,I)=0
  297. COERIG(I)=1.D0
  298. 40 CONTINUE
  299. SEGSUP ITRAV
  300. MTYMAT='MASSE'
  301. ICHOLE=0
  302. IMGEO1=0
  303. IMGEO2=0
  304. IFORIG=IFOMOD
  305. SEGDES MRIGID
  306. IRET=MRIGID
  307. 5000 CONTINUE
  308. RETURN
  309. END
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  

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