1 : C RELA1 SOURCE BP208322 12/12/17 21:15:18 7615 2 : SUBROUTINE RELA1 3 : C 4 : C RELAZIONE LINEARE TRA DDL 5 : C 6 : C ICONR NUMERO OGGETTI MELEME DELLA RELAZIONE 7 : C ITYESR(NBSOUS) LISTA TIPI ELEMENTI CONTENUTI IN MELEME-N 8 : C MUNESR(NBSOUS) NUMERO ELEMENTI IN OGNI SOTTOSTRUTTURA DI MELEME-N 9 : C LNODSR(NNR) LISTA NODI MELEME-N 10 : C IPOR1(N) PUNTATORE SU MWREL1 11 : C IPOR2(N) PUNTATORE SU MWREL2 12 : C IPOR3(N) PUNTATORE SU MWREL3 13 : C COEFR(N) COEFFICIENTI RELAZIONE 14 : C INCREL(N) IDENTIFICATORE NOME DDL 15 : C 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8(A-H,O-Z) 18 : -INC SMELEME 19 : -INC SMCOORD 20 : -INC SMRIGID 21 : -INC TMTRAV 22 : -INC CCOPTIO 23 : -INC CCGEOME 24 : -INC CCHAMP 25 : SEGMENT /MWGGM1/(IPORE1(0)) 26 : SEGMENT /MWGGM2/(IPORE2(0)) 27 : SEGMENT /MWGGM3/(IPORE3(0)) 28 : SEGMENT /MWGGM4/(INCREL(0)) 29 : SEGMENT /MWGGM5/(COEFR(0)*D) 30 : SEGMENT /MWREL1/(ITYESR(0)),IEL11.MWREL1, 31 : + IEL21.MWREL1 32 : SEGMENT /MWREL2/(MUNESR(0)),IEL12.MWREL2, 33 : + IEL22.MWREL2 34 : SEGMENT /MWREL3/(LNODSR(0)),IEL13.MWREL3, 35 : + IEL23.MWREL3 36 : CHARACTER*4 MOTPV(3) 37 : CHARACTER*4 MOCORI(7) 38 : CHARACTER*4 MOTPM(2) 39 : CHARACTER*4 MOTDDL(3) 40 : CHARACTER*4 MOTBLO(3) 41 : CHARACTER*4 MODEPL(8) 42 : CHARACTER*4 MOROTA(5) 43 : CHARACTER*8 MILMOT 44 : DIMENSION XNOR(3) 45 : DATA MOTPV /'MINI','MAXI','FROT'/ 46 : DATA MOTPM /'+ ','- '/ 47 : DATA MOCORI/'CORI','ENSE','ACCR','GLIS','BARY','MILI','TUYA'/ 48 : C 49 : DATA EPSI/1.D-12/ 50 : DATA MOTBLO/'DEPL','ROTA','DIRE'/ 51 : DATA MODEPL/'UX ','UY ','UZ ','UR ','UZ ','UT ', 52 : &'ALFA','BETA'/ 53 : DATA MOROTA/'RX ','RY ','RZ ','RT ','RS '/ 54 : C 55 : C EST-CE UNE RELATION DE CORPS RIGIDE ? 56 : C 56 : CALL LIRMOT(MOCORI,7,ICORI,0) 57 : IF (ICORI.NE.0) THEN 58 : c BARY 59 : if (icori.eq.5) then 59 : call relaba 60 : c MILI 61 : ELSE IF (ICORI.EQ.6) THEN 61 : CALL RELAMI 62 : c TUYA 63 : elseif(icori.eq.7) then 63 : call reltuy 64 : c CORI, ENSE, ACCRO, GLIS 65 : else 65 : CALL RELA2(MOCORI(ICORI)) 66 : endif 67 : RETURN 68 : ENDIF 69 : C 70 : C EST-CE UNE CONDITION UNILATERALE ? 71 : C 72 : NILATE=0 72 : CALL LIRMOT (MOTPV,3,IPO,0) 73 : IF(IPO.EQ.1) NILATE=-1 74 : IF(IPO.EQ.2) NILATE=+1 75 : IF(IPO.EQ.3) NILATE=+2 76 : C 77 : C INITIALISATIONS 78 : C 79 : COEX=1.D0 80 : C 81 : C Deformations planes ou contraintes planes ou defo. plane gene : 82 : IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN 83 : LDEPL=2 84 : IADEPL=0 85 : LROTA=1 86 : IAROTA=2 87 : C Axisymetrique : 88 : ELSE IF (IFOUR.EQ.0) THEN 89 : LDEPL=2 90 : IADEPL=3 91 : LROTA=1 92 : IAROTA=3 93 : C Fourier : 94 : ELSE IF (IFOUR.EQ.1) THEN 95 : LDEPL=3 96 : IADEPL=3 97 : LROTA=2 98 : IAROTA=2 99 : C Tridimensionnel : 100 : ELSE IF (IFOUR.EQ.2) THEN 101 : LDEPL=3 102 : IADEPL=0 103 : LROTA=3 104 : IAROTA=0 105 : C Massif 1D (IDIM=1) : 106 : ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN 107 : LDEPL=1 108 : IADEPL=0 109 : IF (IFOUR.GE.12) IADEPL=3 110 : LROTA=0 111 : IAROTA=0 112 : C Autres cas : 113 : ELSE 114 : LDEPL=0 115 : IADEPL=0 116 : LROTA=0 117 : IAROTA=0 118 : ENDIF 119 : C 120 : SEGINI MWGGM1 121 : SEGINI MWGGM2 122 : SEGINI MWGGM3 123 : SEGINI MWGGM4 124 : SEGINI MWGGM5 125 : * 126 : * LECTURE EVENTUELLE D'UN CHPOINT 127 : * 127 : CALL LIROBJ('CHPOINT',IPOCHP,0,IRECHP) 128 : IF(IRECHP.NE.0) THEN 129 : * 130 : * ON MET LE CHPOINT SOUS FORME DE TABLEAU DE TRAVAIL 131 : * 131 : CALL TRACHP(IPOCHP,MTRAV) 132 : SEGACT MTRAV 133 : DO 1990 I=1,IBIN(/1) 134 : DO 1990 J=1,IBIN(/2) 135 : IF(IBIN(I,J).EQ.0) GO TO 1990 135 : CALL PLACE(NOMDD,LNOMDD,IPO,INCO(I)) 136 : IF(IPO.EQ.0) THEN 137 : SEGSUP MTRAV 138 : GO TO 559 139 : ENDIF 140 : SEGINI MWREL1 141 : SEGINI MWREL2 142 : SEGINI MWREL3 143 : IPORE1(**)=MWREL1 144 : IPORE2(**)=MWREL2 145 : IPORE3(**)=MWREL3 146 : COEFR(**)=BB(I,J) 147 : INCREL(**)=IPO 148 : ITYESR(**)=1 149 : MUNESR(**)=1 150 : LNODSR(**)=IGEO(J) 151 : SEGDES MWREL1 152 : SEGDES MWREL2 153 : SEGDES MWREL3 154 : 1990 CONTINUE 155 : SEGSUP MTRAV 156 : GO TO 300 157 : ENDIF 158 : 200 CONTINUE 159 : C 160 : C LETTURA OPERANDI 161 : C 162 : SEGINI MWREL1 163 : SEGINI MWREL2 164 : SEGINI MWREL3 165 : IPORE1(**)=MWREL1 166 : IPORE2(**)=MWREL2 167 : IPORE3(**)=MWREL3 168 : 1320 CONTINUE 168 : CALL LIRREE(XR,0,IRETOF) 169 : IF(IRETOF.EQ.0) THEN 169 : CALL LIRENT(IR,0,IRETOI) 170 : XR=1.D0 171 : IF(IRETOI.NE.0) XR=DBLE(IR) 172 : ENDIF 172 : CALL LIRMOT(NOMDD,LNOMDD,IPO,0) 173 : IF(IPO.NE.0) THEN 174 : COEFR(**)=XR*COEX 175 : INCREL(**)=IPO 176 : ELSE 177 : * 178 : * ON REGARDE SI IL Y A DEPL OU ROTA SUIVI DE DIRECTION 179 : * 180 : C En DIMENSION 1, le mot-cle 'DIRE' est interdit. 181 : IF (IDIM.EQ.1) THEN 182 : INTERR(1)=IDIM 183 : MOTERR(1:4)=MOTBLO(3) 183 : CALL ERREUR(971) 184 : GOTO 559 185 : ENDIF 185 : CALL LIRMOT(MOTBLO,2,IMOT,1) 186 : IF (IMOT.EQ.0) GOTO 559 187 : IF (IMOT.EQ.1) THEN 188 : IBDDL=LDEPL 189 : DO 4481 IA=1,IBDDL 190 : MOTDDL(IA)=MODEPL(IADEPL+IA) 191 : 4481 CONTINUE 192 : ENDIF 193 : IF (IMOT.EQ.2) THEN 194 : IBDDL=LROTA 195 : DO 4482 IA=1,IBDDL 196 : MOTDDL(IA)=MOROTA(IAROTA+IA) 197 : 4482 CONTINUE 198 : ENDIF 198 : CALL LIRMOT(MOTBLO(3),1,IMOT,1) 199 : IF(IMOT.EQ.0) GO TO 559 200 : IDIREC=1 200 : CALL LIROBJ('POINT',KPOINT,1,IRETOU) 201 : IF(IRETOU.EQ.0) GO TO 559 202 : YL=0.D0 203 : DO 4484 IA=1,IDIM 204 : XNOR(IA)=XCOOR((KPOINT-1)*(IDIM+1)+IA) 205 : 4484 YL=YL+XNOR(IA)*XNOR(IA) 206 : IF (YL.LT.EPSI) THEN 206 : CALL ERREUR(239) 207 : GO TO 559 208 : ENDIF 209 : YL=1.D0/SQRT(YL) 210 : DO 4485 IA=1,IDIM 211 : 4485 XNOR(IA)=XNOR(IA)*YL 212 : * 213 : * ON LIT LE MAILLAGE 214 : * 214 : CALL LIROBJ('POINT ',MILPOI,0,IRETOU) 215 : IF(IRETOU.NE.0) THEN 216 : MILMOT='POINT ' 217 : ELSE 217 : CALL LIROBJ('MAILLAGE',MILPOI,1,IRETOU) 218 : IF(IRETOU.EQ.0) GO TO 559 219 : MILMOT='MAILLAGE' 220 : ENDIF 221 : * 222 : * PUIS ON REMET DES OBJETS DANS LA PILE 223 : * 224 : DO 4477 IB=1,IBDDL 224 : IF(IB.GE.2.AND.COEX.EQ. 1.D0) CALL ECRCHA(MOTPM(1)) 224 : IF(IB.GE.2.AND.COEX.EQ.-1.D0) CALL ECRCHA(MOTPM(2)) 224 : CALL ECROBJ(MILMOT,MILPOI) 224 : CALL ECRCHA(MOTDDL(IB)) 225 : IF(IBDDL.EQ.1) THEN 226 : XRCOO=XR 227 : ELSE 228 : XRCOO=XR*XNOR(IB) 229 : ENDIF 229 : CALL ECRREE(XRCOO) 230 : 4477 CONTINUE 231 : GO TO 1320 232 : ENDIF 233 : C 233 : CALL LIROBJ('POINT ',KPOINT,0,IRETOU) 234 : IF(IRETOU.NE.0) GO TO 110 234 : CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU) 235 : IF(IRETOU.EQ.0) GO TO 559 236 : MELEME=KOBJET 237 : SEGACT MELEME 238 : NBSOUS=LISOUS(/1) 239 : IF(NBSOUS.EQ.0) GO TO 120 240 : C OBJET COMPLEXE 241 : NNR=1 242 : DO 130 IS=1,NBSOUS 243 : IPT1=LISOUS(IS) 244 : SEGACT IPT1 245 : ITYESR(**)=IPT1.ITYPEL 246 : NBNN =IPT1.NUM(/1) 247 : NBELEM =IPT1.NUM(/2) 248 : MUNESR(**)=IPT1.NUM(/2) 249 : IF(NNR.EQ.1)LNODSR(**)=IPT1.NUM(1,1) 250 : DO 140 I1=1,NBELEM 251 : DO 140 I2=1,NBNN 252 : DO 150 I3=1,NNR 253 : IF(LNODSR(I3).EQ.IPT1.NUM(I2,I1)) GO TO 140 254 : 150 CONTINUE 255 : NNR=NNR+1 256 : LNODSR(**)=IPT1.NUM(I2,I1) 257 : 140 CONTINUE 258 : SEGDES IPT1 259 : 130 CONTINUE 260 : SEGDES MWREL1 261 : SEGDES MWREL2 262 : SEGDES MWREL3 263 : SEGDES MELEME 264 : GO TO 160 265 : C 266 : C OBJET SIMPLE 267 : C 268 : 120 CONTINUE 269 : ITYESR(**)=ITYPEL 270 : NBNN =NUM(/1) 271 : NBELEM =NUM(/2) 272 : MUNESR(**)=NUM(/2) 273 : NNR=0 274 : DO 170 I1=1,NBELEM 275 : DO 170 I2=1,NBNN 276 : DO 180 I3=1,NNR 277 : IF(LNODSR(I3).EQ.NUM(I2,I1)) GO TO 170 278 : 180 CONTINUE 279 : NNR=NNR+1 280 : LNODSR(**)=NUM(I2,I1) 281 : 170 CONTINUE 282 : SEGDES MWREL1 283 : SEGDES MWREL2 284 : SEGDES MWREL3 285 : SEGDES MELEME 286 : GO TO 160 287 : 110 CONTINUE 288 : C 289 : C OBJET POINT 290 : C 291 : ITYESR(**)=1 292 : MUNESR(**)=1 293 : LNODSR(**)=KPOINT 294 : SEGDES MWREL1 295 : SEGDES MWREL2 296 : SEGDES MWREL3 297 : C FINE OPERANDO RELAZIONE 298 : 160 CONTINUE 299 : ICONR=IPORE1(/1)+1 300 : C LETTURA + O - 300 : IF(ICONR.EQ.2) CALL LIRMOT(MOTPM,2,IPO,0) 301 : IF (IPO.EQ.0) GO TO 300 302 : *LIRMOT(MOTPM,2,IPO,1) goto 559 302 : IF(ICONR.GT.2) CALL LIRMOT(MOTPM,2,IPO,0) 303 : IF (IPO.EQ.0) GO TO 300 304 : COEX=1.D0 305 : IF (IPO.EQ.2) COEX=-1.D0 306 : C SI CERCA DI LEGGERE UN NUOVO OPERANDO DELLA RELAZIONE 307 : GO TO 200 308 : C 309 : C VERIFICA CONGRUENZA OPERANDI 310 : C 311 : 300 CONTINUE 312 : C 313 : ICONR=IPORE1(/1) 314 : IEL11=IPORE1(1) 315 : IEL12=IPORE2(1) 316 : IEL13=IPORE3(1) 317 : SEGACT IEL11 318 : SEGACT IEL12 319 : SEGACT IEL13 320 : NSOR1=IEL11.ITYESR(/1) 321 : NNR1=IEL13.LNODSR(/1) 322 : DO 310 IO=2,ICONR 323 : IEL21=IPORE1(IO) 324 : IEL22=IPORE2(IO) 325 : IEL23=IPORE3(IO) 326 : SEGACT IEL21 327 : SEGACT IEL22 328 : SEGACT IEL23 329 : NSOR2=IEL21.ITYESR(/1) 330 : IF(NSOR1.NE.NSOR2) GO TO 556 331 : DO 320 I1=1,NSOR1 332 : IF(IEL11.ITYESR(I1).NE.IEL21.ITYESR(I1)) GO TO 556 333 : IF(IEL12.MUNESR(I1).NE.IEL22.MUNESR(I1)) GO TO 556 334 : 320 CONTINUE 335 : NNR2=IEL23.LNODSR(/1) 336 : IF(NNR1.NE.NNR2) GO TO 556 337 : SEGDES IEL21 338 : SEGDES IEL22 339 : SEGDES IEL23 340 : 310 CONTINUE 341 : NBRELA=NNR1 342 : SEGDES IEL11 343 : SEGDES IEL12 344 : SEGDES IEL13 345 : C OPERANDI CONGRUENTI FINE VERIFICA 346 : C 347 : C CARICAMENTO MATRICE RIGIDEZZA 348 : C 349 : NRIGE=8 350 : NRIGEL=1 351 : SEGINI MRIGID 352 : ICHOLE=0 353 : IMGEO1=0 354 : IMGEO2=0 355 : ISUPEQ=0 356 : IFORIG=IFOUR 357 : COERIG(1)=1.D0 358 : MTYMAT='RIGIDITE' 359 : KRIGI=MRIGID 360 : C 361 : C ON INITIALISE LE SEGMENT MELEME ASSOCIE AUX BLOCAGES 362 : C 363 : SEGACT MCOORD*MOD 364 : NBNO=XCOOR(/1)/(IDIM+1) 365 : NBSOUS=0 366 : NBREF=0 367 : NBNN=1+ICONR 368 : NBELEM=NBRELA 369 : SEGINI IPT2 370 : IRIGEL(1,1)=IPT2 371 : IPT2.ITYPEL=22 372 : DO 400 I4=1,NBRELA 373 : IPT2.ICOLOR(I4)=IDCOUL 374 : C SI CREANO DUE PUNTI PER OGNI RELAZIONE 375 : C** I5=6 376 : C** IF(IDIM.EQ.3) I5=8 377 : I5=(IDIM+1)*2 378 : DO 410 I6=1,I5 379 : XCOOR(**)=0.D0 380 : 410 CONTINUE 381 : C 382 : I7=I4-1 383 : C PUNTI ASSOCIATI AI MOLTIPLICATORI 384 : IPT2.NUM(1,I4)=NBNO+I7+1 385 : 400 CONTINUE 386 : C CARICAMENTO NODI PSEUDO-ELEMENTI 387 : DO 420 I8=1,ICONR 388 : MWREL3=IPORE3(I8) 389 : I10=I8+1 390 : SEGACT MWREL3 391 : DO 430 I9=1,NBRELA 392 : NN=LNODSR(I9) 393 : NPN=(NN-1)*(IDIM+1) 394 : IPT2.NUM(I10,I9)=NN 395 : NPL1=(IPT2.NUM(1,I9)-1)*(IDIM+1) 396 : XCOOR(NPL1+1)=XCOOR(NPL1+1)+XCOOR(NPN+1) 397 : IF (IDIM.GE.2) THEN 398 : XCOOR(NPL1+2)=XCOOR(NPL1+2)+XCOOR(NPN+2) 399 : IF (IDIM.EQ.3) XCOOR(NPL1+3)=XCOOR(NPL1+3)+XCOOR(NPN+3) 400 : ENDIF 401 : 430 CONTINUE 402 : SEGDES MWREL3 403 : 420 CONTINUE 404 : C 405 : C COORDINATE DEI BARICENTRI ASSOCIATI ALLE RELAZIONI 406 : C 407 : DO 425 I4=1,NBRELA 408 : NPL1=(IPT2.NUM(1,I4)-1)*(IDIM+1) 409 : NPL2=NPL1+IDIM+1 410 : XCOOR(NPL1+1)=XCOOR(NPL1+1)/ICONR 411 : XCOOR(NPL2+1)=XCOOR(NPL1+1) 412 : IF (IDIM.GE.2) THEN 413 : XCOOR(NPL1+2)=XCOOR(NPL1+2)/ICONR 414 : XCOOR(NPL2+2)=XCOOR(NPL1+2) 415 : IF (IDIM.EQ.3) THEN 416 : XCOOR(NPL1+3)=XCOOR(NPL1+3)/ICONR 417 : XCOOR(NPL2+3)=XCOOR(NPL1+3) 418 : ENDIF 419 : ENDIF 420 : 425 CONTINUE 421 : SEGDES IPT2 422 : IRIGEL(2,1)=0 423 : IRIGEL(5,1)=NIFOUR 424 : IRIGEL(6,1)=NILATE 425 : NLIGRP=ICONR+1 426 : NLIGRD=NLIGRP 427 : SEGINI DESCR 428 : IRIGEL(3,1)=DESCR 429 : LISINC(1)='LX' 430 : LISDUA(1)='FLX' 431 : NOELEP(1)=1 432 : NOELED(1)=1 433 : DO 700 I1=1,ICONR 434 : I2=I1+1 435 : I3=INCREL(I1) 436 : LISINC(I2)=NOMDD(I3) 437 : LISDUA(I2)=NOMDU(I3) 438 : NOELEP(I2)=I2 439 : NOELED(I2)=I2 440 : 700 CONTINUE 441 : SEGDES DESCR 442 : NELRIG=NBRELA 443 : SEGINI xMATRI 444 : IRIGEL(4,1)=xMATRI 445 : * LVAL=(NBNN*NBNN+NBNN)/2 446 : NLIGRE=NBNN 447 : NLIGRP=NBNN 448 : NLIGRD=NBNN 449 : * SEGINI XMATRI 450 : DO 740 I6=1,NELRIG 451 : * IMATTT(I1)=XMATRI 452 : *740 CONTINUE 453 : RE(1,1,i6)= 0.D0 454 : I3=3 455 : DO 760 I1=2,NBNN 456 : I4=I1-1 457 : I2=1 458 : RE(I1,I2,i6)=COEFR(I4) 459 : RE(I2,I1,i6)=COEFR(I4) 460 : 760 CONTINUE 461 : 740 continue 462 : SEGDES XMATRI 463 : * SEGDES IMATRI 464 : SEGDES MRIGID 464 : CALL ECROBJ('RIGIDITE',KRIGI) 465 : 559 ICONR=IPORE1(/1) 466 : DO 558 I1=1,ICONR 467 : MWREL1=IPORE1(I1) 468 : MWREL2=IPORE2(I1) 469 : MWREL3=IPORE3(I1) 470 : SEGSUP MWREL1 471 : SEGSUP MWREL2 472 : SEGSUP MWREL3 473 : 558 CONTINUE 474 : SEGSUP MWGGM1 475 : SEGSUP MWGGM2 476 : SEGSUP MWGGM3 477 : SEGSUP MWGGM4 478 : SEGSUP MWGGM5 479 : RETURN 480 : 556 CONTINUE 481 : C SEGDES IEL11,IEL12,IEL13,IEL21,IEL22,IEL23 481 : CALL ERREUR(324) 482 : GO TO 559 483 : END 484 : 485 : 486 : 487 : 488 :
© Cast3M 2003 - All rights reserved.
Disclaimer