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