Télécharger rglimo.eso

Retour à la liste

Numérotation des lignes :

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

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