1 : C RGLILI SOURCE CHAT 09/10/09 21:23:03 6519 2 : SUBROUTINE RGLILI(ISOLS,ISTRU,IRIG,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C CE SUBROUTINE CALCULE POUR LES SOLUTIONS STATIQUES ISOLS DE TYPE : 7 : C 1-MECA OU FLUI 8 : C LES RIGIDITES DE COUPLAGE DES LIAISONS ENTRE ELLES (FORMALISME GIBERT) 9 : C DE SOUS TYPE MASSE SI IRIG=1, DE SOUS TYPE RIGIDITE SI IRIG=2 10 : C ECRIT PAR FARVACQUE 11 : C 2-DEPI 12 : C UNE MATRICE DE RIGIDITE NULLE ET UNE MATRICE DE MASSE IDENTITE 13 : C (FORMALISME DEPLACEMENTS IMPOSES SUR MODES BLOQUES POUR DEVO) 14 : C ECRIT PAR GUILBAUD 15 : C 16 : C ELLES S'APPUIENT SUR L ELEMENT QUI CONTIENT TOUS LES POINTS ASSOCIES 17 : C AUX LIAISONS MJONCT. 18 : C 19 : C APPELE PAR RIGI,RGBASE 20 : C APPELLE : ETALPR,MUCPRI,ETALCH,YTMX,ERREUR(235,108) 21 : C======================================================================= 22 : -INC CCOPTIO 23 : -INC SMSOLUT 24 : -INC SMRIGID 25 : -INC SMATTAC 26 : -INC SMELEME 27 : -INC SMSTRUC 28 : -INC CCHAMP 29 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 30 : CHARACTER*4 IDDL 31 : SEGMENT IINC 32 : CHARACTER*4 CIINC(0) 33 : ENDSEGMENT 34 : SEGMENT IIDU 35 : CHARACTER*4 CIIDU(NNI1) 36 : ENDSEGMENT 37 : SEGMENT ITRMEC(NJONC) 38 : SEGMENT ITRDEP(NJONC) 39 : SEGMENT ITRAV(6) 40 : SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA 41 : SEGMENT/ICONTR/(MCONTR(NNI1,IPR1)) 42 : SEGMENT IPB(IPR1) 43 : DATA KZERO/0/ 44 : C 45 : IRET=0 46 : IF(IRIG.NE.1.AND.IRIG.NE.2) GOTO 8000 47 : MSOSTU=ISTRU 48 : MSOLUT=ISOLS 49 : SEGACT MSOLUT 50 : NIPO=MSOLIS(/1) 51 : KJONC=MSOLIS(10) 52 : KDEPL=MSOLIS(5) 53 : IF(KDEPL.NE.0) GO TO 12 54 : MOTERR(1:8)='SOLUTION' 55 : MOTERR(9:12)='DEPL' 56 : SEGDES MSOLUT 56 : CALL ERREUR(235) 57 : C ON NE TROUVE PAS LES DEPL 58 : GO TO 8000 59 : 12 CONTINUE 60 : SEGDES MSOLUT 61 : MSOLE1=KJONC 62 : SEGACT MSOLE1 63 : NJONC=MSOLE1.ISOLEN(/1) 64 : SEGDES MSOLE1 65 : IF(NJONC.EQ.0) GO TO 8000 66 : C 67 : SEGINI ITRMEC,ITRDEP 68 : SEGACT MSOLE1 69 : NJOMEC=0 70 : NJODEP=0 71 : DO 20 I=1,NJONC 72 : MJONCT=MSOLE1.ISOLEN(I) 73 : SEGACT MJONCT 74 : IF(MJOTYP.EQ.'MECA'.OR.MJOTYP.EQ.'FLUI') THEN 75 : NJOMEC=NJOMEC+1 76 : ITRMEC(NJOMEC)=I 77 : ELSEIF(MJOTYP.EQ.'DEPI'.AND.IRIG.EQ.1) THEN 78 : NJODEP=NJODEP+1 79 : ITRDEP(NJODEP)=I 80 : ENDIF 81 : SEGDES MJONCT 82 : 20 CONTINUE 83 : SEGDES MSOLE1 84 : IF(NJOMEC.EQ.0.AND.NJODEP.EQ.0) GOTO 7000 85 : IF(NJOMEC.EQ.0) GO TO 5000 86 : C 87 : C **** INITIALISATION DE LA GEOMETRIE(1 ELEMENT QUI CONTIENT TOUS LES 88 : C **** POINT-LIAISONS) ET DE LA MATRICE ASSOCIEE XMATRI 89 : C **** INITIALISATION DE IMATRI ET DE DESCR 90 : C 91 : NJONC=NJOMEC 92 : LVAL=NJONC*(NJONC+1)/2 93 : NLIGRP=NJONC 94 : NLIGRD=NJONC 95 : nelrig=1 96 : SEGINI XMATRI 97 : * NLIGRE=NJONC 98 : SEGINI DESCR 99 : NELRIG=1 100 : * SEGINI IMATRI 101 : * IMATTT(1)=XMATRI 102 : * SEGDES IMATRI 103 : SEGACT MSOLUT 104 : IPT1=MSOLIS(3) 105 : SEGACT IPT1 106 : NBSOUS=0 107 : NBREF=0 108 : NBNN=NJONC 109 : NBELEM=1 110 : SEGINI MELEME 111 : ITYPEL=27 112 : MSOLEN=KDEPL 113 : C 114 : C **** PREPARATION DES OPERATIONS : A IPM ON DONNE LA FORME RECTANGLE 115 : C 116 : SEGACT MSOLEN 117 : IPM=ISOLEN(1) 117 : CALL ETALPR(IPM,KIINC,KICPR,KCONTR) 118 : ICONTR=KCONTR 119 : SEGACT ICONTR 120 : IPR1=MCONTR(/2) 121 : NNI1=MCONTR(/1) 122 : SEGINI MVA 123 : KMVA=MVA 124 : SEGINI MVA 125 : KMVB=MVA 126 : SEGINI IPB 127 : KIPB=IPB 128 : IINC=KIINC 129 : SEGACT IINC 130 : SEGINI IIDU 131 : DO 50 I=1,NNI1 132 : IDDL=CIINC(I) 133 : DO 51 J=1,LNOMDD 134 : IF(IDDL.NE.NOMDD(J)) GOTO 51 135 : CIIDU(I)=NOMDU(J) 136 : GOTO 50 137 : 51 CONTINUE 138 : MOTERR(1:4)=IDDL 138 : CALL ERREUR(108) 139 : C ON NE TROUVE PAS IDDL DANS CCHAMP 140 : GOTO 7000 141 : 50 CONTINUE 142 : KINCDU=IIDU 143 : IF(IIMPI.NE.0)WRITE(6,8883)(CIINC(I),CIIDU(I),I=1,NNI1) 144 : 8883 FORMAT(20(1X,A4)) 145 : C 146 : C **** CAS IRIG=1 : TERMES DANS LA MATRICE MASSE : UT.M.U 147 : C 148 : IF(IRIG.NE.1) GO TO 100 149 : SEGACT MSOSTU 150 : MATMAS=ISMASS 151 : SEGDES MSOSTU 152 : SEGACT MSOLE1,MSOLEN 153 : LTAB=ISOLEN(/1) 154 : DO 9 I=1,NJONC 155 : MJONCT=MSOLE1.ISOLEN(ITRMEC(I)) 156 : SEGACT MJONCT 157 : NOELEP(I)=I 158 : NOELED(I)=I 159 : IF(MJODDL.EQ.'LX ') GO TO 16 160 : LISINC(I)='FBET' 161 : LISDUA(I)='BETA' 162 : GO TO 17 163 : 16 LISINC(I)='BETA' 164 : LISDUA(I)='FBET' 165 : 17 CONTINUE 166 : SEGDES MJONCT 167 : NUM(I,1)=IPT1.NUM(1,ITRMEC(I)) 168 : 9 CONTINUE 169 : C 170 : KZERO=0 171 : DO 10 I=1,NJONC 172 : IP1=ISOLEN(I) 172 : CALL MUCPRI(IP1,MATMAS,MUI) 173 : IF(IERR.NE.0) GOTO 8000 173 : CALL ETALCH(MUI,KINCDU,KICPR,KCONTR,KMVB,KIPB,NPR2) 174 : IF(IERR.NE.0) GO TO 8000 175 : C 176 : IF(IIMPI.EQ.0) GOTO 804 177 : MVA=KMVB 178 : IPB=KIPB 179 : SEGACT MVA,IPB 180 : WRITE(IOIMP,7878)I 181 : 7878 FORMAT(' ************* DANS RGLILI CALCUL DE UJ.M.UI ****', 182 : 1 /,' ========== I=',I4,' ECRITURE DE M.UI SOUS LA FORME VA 183 : 1 PUIS IPB') 184 : WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1) 185 : WRITE(IOIMP,8882)(IPB(KJ2),KJ2=1,IPR1) 186 : 804 CONTINUE 187 : C 188 : DO 11 J=I,NJONC 189 : IP2=ISOLEN(J) 189 : CALL ETALCH(IP2,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID) 190 : IF(IERR.NE.0) GOTO 8000 191 : C 192 : IF(IIMPI.EQ.0) GO TO 803 193 : MVA=KMVA 194 : SEGACT MVA 195 : WRITE(IOIMP,7879)J 196 : 7879 FORMAT(' ========== J=',I4,' ECRITURE DE UJ SOUS LA FORME VA') 197 : WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1) 198 : 803 CONTINUE 199 : C 200 : C **** OPERATION UT . ( M.U ) 201 : C 202 : MVA=KMVA 203 : MVA1=KMVB 204 : IPB=KIPB 205 : SEGACT MVA,MVA1,IPB 206 : XRET=0. 207 : DO 81 J1=1,NPR2 208 : JJ1=IPB(J1) 209 : DO 81 I1=1,NNI1 210 : XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1) 211 : 81 CONTINUE 212 : C 213 : IF(IIMPI.EQ.0) GOTO 805 213 : CALL YTMX(IP1,IP2,MATMAS,WW) 214 : WRITE(IOIMP,7877)XRET,WW 215 : 7877 FORMAT(' UI.M.UJ = ',E12.5,' PAR L''OPERATEUR YTMX ON TROUVE ' 216 : 1 ,E12.5) 217 : 805 CONTINUE 218 : C 219 : * K=(J*(J-1)/2)+I 220 : RE(J,I,1)=XRET 221 : RE(I,J,1)=XRET 222 : 11 CONTINUE 223 : 10 CONTINUE 224 : GO TO 6 225 : C 226 : C **** CAS IRIG=2 : MATRICE RAIDEUR : LIGNE J COLONNE I: UI ET PJ 227 : C 228 : 100 CONTINUE 229 : C 230 : C **** PREMIERE BOUCLE SUR LESMJONCT. ON EN SORT MCHPOI QU ON ETALE 231 : C **** DANS MVA . C EST UI 232 : C 233 : SEGACT MSOLEN,MSOLE1 234 : LTAB=ISOLEN(/1) 235 : DO 30 IJO1=1,NJONC 236 : MJONCT=MSOLE1.ISOLEN(ITRMEC(IJO1)) 237 : SEGACT MJONCT 238 : RLIBRE=1. 239 : IF(MJODDL.EQ.'FLX ') RLIBRE=-1. 240 : NOELEP(IJO1)=IJO1 241 : NOELED(IJO1)=IJO1 242 : IF(MJODDL.EQ.'LX ') GO TO 18 243 : LISINC(IJO1)='FBET' 244 : LISDUA(IJO1)='BETA' 245 : GO TO 19 246 : 18 LISINC(IJO1)='BETA' 247 : LISDUA(IJO1)='FBET' 248 : 19 CONTINUE 249 : NUM(IJO1,1)=IPT1.NUM(1,ITRMEC(IJO1)) 250 : SEGDES MJONCT 251 : IP1=ISOLEN(ITRMEC(IJO1)) 252 : KZERO=0 252 : CALL ETALCH(IP1,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID) 253 : IF(IERR.NE.0) GO TO 8000 254 : IF(IIMPI.EQ.0) GO TO 800 255 : MVA=KMVA 256 : SEGACT MVA 257 : WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1) 258 : 8880 FORMAT(8(2X,E12.5)) 259 : 800 CONTINUE 260 : C 261 : C **** 2IEME BOUCLE SUR LES MJONCT: ON EN TIRE PJ QU ON ETALE DANS MVB 262 : C 263 : DO 31 IJO2=IJO1,NJONC 264 : MJONCT=MSOLE1.ISOLEN(ITRMEC(IJO2)) 265 : SEGACT MJONCT 266 : NST=ISTRJO(/1) 267 : DO 32 IS=1,NST 268 : IF(ISTRJO(IS).NE.MSOSTU) GO TO 32 269 : IPP2=IPCHJO(IS) 269 : CALL ETALCH(IPP2,KIINC,KICPR,KCONTR,KMVB,KIPB,NPR2) 270 : IF(IERR.NE.0) GO TO 8000 271 : IF(IIMPI.EQ.0) GO TO 801 272 : MVA=KMVB 273 : IPB=KIPB 274 : SEGACT MVA,IPB 275 : WRITE(IOIMP,8880)((VA(KJ1,KJ2),KJ1=1,NNI1),KJ2=1,IPR1) 276 : WRITE(IOIMP,8882)(IPB(KJ2),KJ2=1,IPR1) 277 : 8882 FORMAT( 10I6) 278 : 801 CONTINUE 279 : C 280 : C **** OPERATION VA*VB 281 : C 282 : MVA=KMVA 283 : MVA1=KMVB 284 : IPB=KIPB 285 : SEGACT MVA,MVA1,IPB 286 : C 287 : XRET=0. 288 : DO 80 J1=1,NPR2 289 : JJ1=IPB(J1) 290 : DO 80 I1=1,NNI1 291 : XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1) 292 : 80 CONTINUE 293 : C 294 : * K=(IJO2*(IJO2-1)/2)+IJO1 295 : RE(IJO2,IJO1,1)=RE(IJO2,IJO1,1)+XRET*RLIBRE 296 : RE(IJO1,IJO2,1)=RE(IJO2,IJO1,1) 297 : 32 CONTINUE 298 : SEGDES MJONCT 299 : 31 CONTINUE 300 : 30 CONTINUE 301 : SEGDES MSOLE1 302 : C 303 : 6 CONTINUE 304 : IINC=KIINC 305 : SEGSUP IINC 306 : IIDU=KINCDU 307 : SEGSUP IIDU 308 : ICPR=KICPR 309 : SEGSUP ICPR 310 : SEGSUP ICONTR 311 : SEGSUP MVA,MVA1,IPB 312 : SEGDES DESCR,MELEME,XMATRI,IPT1,MSOLUT 313 : SEGINI ITRAV 314 : ITRAV(1)=MELEME 315 : ITRAV(2)=0 316 : ITRAV(3)=DESCR 317 : ITRAV(4)=xMATRI 318 : ITRAV(5)=NIFOUR 319 : ITRAV(6)=0 320 : 5000 CONTINUE 321 : C 322 : C LIAISON POUR DEPLACEMENT IMPOSE 323 : C 324 : IF(NJODEP.EQ.0) GO TO 6000 325 : C 326 : C **** INITIALISATION DE LA GEOMETRIE(1 ELEMENT QUI CONTIENT TOUS LES 327 : C **** POINT-LIAISONS) ET DE LA MATRICE ASSOCIEE XMATRI 328 : C **** INITIALISATION DE IMATRI ET DE DESCR 329 : C 330 : NJONC=NJODEP 331 : * LVAL=NJONC*(NJONC+1)/2 332 : NLIGRP=NJONC 333 : NLIGRD=NJONC 334 : nelrig=1 335 : SEGINI XMATRI 336 : * DO 40 K=1,LVAL 337 : * RE(K)=0.D0 338 : * 40 CONTINUE 339 : SEGINI DESCR 340 : NELRIG=1 341 : * SEGINI IMATRI 342 : * IMATTT(1)=XMATRI 343 : * SEGDES IMATRI 344 : SEGACT MSOLUT 345 : IPT1=MSOLIS(3) 346 : SEGACT IPT1 347 : NBSOUS=0 348 : NBREF=0 349 : NBNN=NJONC 350 : NBELEM=1 351 : SEGINI MELEME 352 : ITYPEL=27 353 : DO 41 I=1,NJONC 354 : NOELEP(I)=I 355 : NOELED(I)=I 356 : LISINC(I)='FBET' 357 : LISDUA(I)='BETA' 358 : NUM(I,1)=IPT1.NUM(1,ITRDEP(I)) 359 : RE(I,I,1)=1.D0 360 : 41 CONTINUE 361 : SEGSUP ITRDEP 362 : SEGDES DESCR,MELEME,XMATRI,MSOLUT,IPT1 363 : C 364 : C CREATION DE MRIGID 365 : C 366 : 6000 CONTINUE 367 : NRIGEL=1 368 : IF(NJOMEC.NE.0.AND.NJODEP.NE.0) NRIGEL=2 369 : NRIGE=6 370 : SEGINI MRIGID 371 : ICHOLE=0 372 : IMGEO1=0 373 : IMGEO2=0 374 : IFORIG=IFOMOD 375 : IF(IRIG.EQ.1) THEN 376 : MTYMAT='MASSE ' 377 : ELSE 378 : MTYMAT='RIGIDITE' 379 : ENDIF 380 : I=0 381 : IF(NJOMEC.NE.0) THEN 382 : I=I+1 383 : COERIG(I)=1.D0 384 : IRIGEL(1,I)=ITRAV(1) 385 : IRIGEL(2,I)=ITRAV(2) 386 : IRIGEL(3,I)=ITRAV(3) 387 : IRIGEL(4,I)=ITRAV(4) 388 : IRIGEL(5,I)=ITRAV(5) 389 : IRIGEL(6,I)=ITRAV(6) 390 : xmatr1=itrav(4) 391 : segdes xmatr1 392 : SEGSUP ITRAV 393 : 394 : ENDIF 395 : IF(NJODEP.NE.0) THEN 396 : I=I+1 397 : COERIG(I)=1.D0 398 : IRIGEL(1,I)=MELEME 399 : IRIGEL(2,I)=0 400 : IRIGEL(3,I)=DESCR 401 : IRIGEL(4,I)=xMATRI 402 : IRIGEL(5,I)=NIFOUR 403 : IRIGEL(6,I)=0 404 : segdes xmatri 405 : ENDIF 406 : 407 : SEGDES MRIGID 408 : IRET=MRIGID 409 : 7000 CONTINUE 410 : SEGSUP ITRMEC,ITRDEP 411 : 8000 CONTINUE 412 : RETURN 413 : END 414 : 415 : 416 : 417 : 418 : 419 : 420 : 421 : 422 :
© Cast3M 2003 - All rights reserved.
Disclaimer