1 : C RELA3 SOURCE CHAT 09/10/09 21:22:37 6519 2 : SUBROUTINE RELA3(IPC,IPM,LP,IROTA) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ***************************************************************** 6 : * 7 : * relation de corps rigide en cas des coques ou des poutres 8 : * eventuellement en combinaison avec des massifs 9 : * 10 : * entrées 11 : * IPC : pointeur sur le maillage (ou numero du point) ayant des 12 : * ddl de rotation naturellement (poutres ou coques) 13 : * 14 : * IPM : pointeur sur le maillage n'ayant pas des ddl de rotation 15 : * naturellement (massif) 16 : * 17 : * LP : 0 --> IPC est un maillage 18 : * 1 --> IPC est un point 19 : * 20 : * IROTA : 1 les rotaions de IPC sont de ddl du problème 21 : * 0 les rotaions de IPC ne sont pas de ddl du problème 22 : * (on s'en sert pour traiter le cas fourier 0 et axis 23 : * en l'absence du mot clé ROTA) 24 : * 25 : * on écrit dans la pile la rigidité KRIGI 26 : * 27 : * I. Politopoulos 09/05/95 28 : **************************************************************** 29 : -INC CCOPTIO 30 : -INC CCGEOME 31 : -INC SMELEME 32 : -INC SMCOORD 33 : -INC SMRIGID 34 : -INC CCHAMP 35 : 36 : CHARACTER*4 MODEPL(5),MODEDU(5) 37 : CHARACTER*4 MORODU(4),MOROTA(4) 38 : 39 : DATA MODEPL(1)/'UX '/ 40 : DATA MODEPL(2)/'UY '/ 41 : DATA MODEPL(3)/'UZ '/ 42 : DATA MODEPL(4)/'UR '/ 43 : DATA MODEPL(5)/'UT '/ 44 : DATA MODEDU(1)/'FX '/ 45 : DATA MODEDU(2)/'FY '/ 46 : DATA MODEDU(3)/'FZ '/ 47 : DATA MODEDU(4)/'FR '/ 48 : DATA MODEDU(5)/'FT '/ 49 : DATA MOROTA(1)/'RX '/ 50 : DATA MOROTA(2)/'RY '/ 51 : DATA MOROTA(3)/'RZ '/ 52 : DATA MOROTA(4)/'RT '/ 53 : DATA MORODU(1)/'MX '/ 54 : DATA MORODU(2)/'MY '/ 55 : DATA MORODU(3)/'MZ '/ 56 : DATA MORODU(4)/'MT '/ 57 : 58 : 59 : 60 : * activation du maillage avec des ddl de rotation 61 : * et definition du noeud maitre 62 : 63 : IF (LP.EQ.0) THEN 64 : MELEME=IPC 65 : SEGACT MELEME 65 : IF(ITYPEL .NE.1) CALL CHANGE(MELEME,1) 66 : NBPOIC=NUM(/2) 67 : IP1 = NUM(1,1) 68 : * si 1 seul point 69 : ELSE 70 : IP1 = IPC 71 : NBPOIC = 1 72 : ENDIF 73 : * activation du maillage massif 74 : IF (IPM .NE. 0) THEN 75 : IPT2 = IPM 76 : SEGACT IPT2 76 : IF(IPT2.ITYPEL .NE.1) CALL CHANGE(IPT2,1) 77 : NBPOIM = IPT2.NUM(/2) 78 : ELSE 79 : NBPOIM = 0 80 : ENDIF 81 : 82 : NBTOT = NBPOIC + NBPOIM 83 : 84 : * nombre de noeuds 85 : cc SEGACT MCOORD 86 : NBNO = XCOOR(/1)/(IDIM+1) 87 : 88 : ** definition du noeud maitre en cas fourier 0 pour 89 : ** la relation sur UT car il ne peut pas etre sur l'axe. 90 : ** Pour ne pas mettre un critere absolu on choisit le point 91 : ** le plus lointain 92 : IF ((IFOUR .EQ. 1) .AND. (NIFOUR.EQ.0)) THEN 93 : XMAX = 0.D0 94 : DO 8 I=1,NUM(/2) 95 : IPP1 = NUM(1,I) 96 : IREF1 = (IPP1-1)*(IDIM+1) 97 : XI1 = XCOOR(IREF1+1) 98 : IF(ABS(XI1).GT.XMAX) THEN 99 : XMAX = ABS(XI1) 100 : NUM(1,I)=IP1 101 : IP1 = IPP1 102 : NUM(1,1)=IP1 103 : ENDIF 104 : 8 CONTINUE 105 : ENDIF 106 : * quelques dimensions pour l'initialisation du maillage des relations 107 : NBSOUS = 0 108 : NBREF = 0 109 : NBNN = 3 110 : * coordonnees du point maitre 111 : IREFP1 = (IP1-1)*(IDIM+1) 112 : X1 = XCOOR(IREFP1+1) 113 : Y1 = XCOOR(IREFP1+2) 114 : 115 : IF((IFOMOD.EQ.0).OR.((IFOMOD.EQ.1).AND.(NIFOUR.EQ.0))) 116 : + GOTO 100 117 : 118 : c 119 : ccc debut 3D ou (2d plan cont ou defo) ou (fourier 1) 120 : c 121 : IF (IDIM .EQ.3) THEN 122 : Z1 = XCOOR(IREFP1+3) 123 : * nombre de types de matrices et nombre de relations 124 : L1 = 3 125 : L2 = 3 126 : NNMAT = 6 127 : NBRELA = (NBPOIC-1)*6 + NBPOIM*3 128 : ENDIF 129 : IF (IDIM.EQ.2) THEN 130 : IF (IFOMOD.EQ.-1) THEN 131 : L1 = 1 132 : L2 = 2 133 : NNMAT = 3 134 : NBRELA = (NBPOIC-1)*3 + NBPOIM*2 135 : * fourier 1, -1. il faut imposer en plus que ur = -ut 136 : ELSE IF (ABS(NIFOUR).EQ.1) THEN 137 : L1 = 1 138 : L2 = 3 139 : NNMAT = 4 140 : * + 2 car le nombre des relations ur=-ut et entre rt et uz est 141 : * egal au nombre des points 142 : NBRELA = (NBPOIC-1)*4 + NBPOIM*3 + 2 143 : ENDIF 144 : ENDIF 145 : IF (NBPOIC .EQ.1) THEN 146 : IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) THEN 147 : NNMAT = IDIM 148 : ELSE IF (ABS(NIFOUR).EQ.1) THEN 149 : NNMAT = 3 150 : ENDIF 151 : ENDIF 152 : 153 : * on ajuste MCOORD pour les noeuds associes aux multiplicateurs 154 : NBPTS = NBNO + NBRELA 155 : NBNOI = NBNO 156 : SEGADJ MCOORD 157 : * initialisation du segment mrigid 158 : NRIGE=7 159 : NRIGEL=NNMAT 160 : SEGINI MRIGID 161 : ICHOLE=0 162 : IMGEO1=0 163 : IMGEO2=0 164 : ISUPEQ=0 165 : IFORIG=IFOMOD 166 : MTYMAT='RIGIDITE' 167 : KRIGI=MRIGID 168 : * relations sur les rotations 169 : IND = 0 170 : IF (NBPOIC.GT.1) THEN 171 : NELRIG = (NBPOIC-1) 172 : NLIGRE = 3 173 : NLIGRP = NLIGRE 174 : NLIGRD = NLIGRE 175 : * SEGINI IMATRI 176 : SEGINI XMATRI 177 : IXMATR=XMATRI 178 : * DO 5 I=1,NELRIG 179 : * IMATTT(I) = IXMATR 180 : * 5 CONTINUE 181 : * on remplit les valeurs RE de la matrice pour les rotations 182 : RE(1,1,1)= 0.D0 183 : RE(2,1,1)= 1.D0 184 : RE(3,1,1)= -1.D0 185 : RE(2,2,1)= 0.D0 186 : RE(3,2,1)= 0.D0 187 : RE(3,3,1)= 0.D0 188 : * on definit explicitement les termes symetriques car on a constaté 189 : * des petites differences aux resultats si on le fait pas 190 : RE(1,2,1)= RE(2,1,1) 191 : RE(1,3,1)= RE(3,1,1) 192 : RE(2,3,1)= RE(3,2,1) 193 : do ioup=2,nelrig 194 : do io=1,re(/2) 195 : do iu=1,re(/1) 196 : re(iu,io,ioup)=re(iu,io,1) 197 : enddo 198 : enddo 199 : enddo 200 : SEGDES XMATRI 201 : * SEGDES IMATRI 202 : * boucle sur les differents types de matrices 203 : DO 10 IAA= 1,L1 204 : IRIGEL(2,IAA) = 0 205 : IRIGEL(5,IAA) = NIFOUR 206 : IRIGEL(6,IAA) = 0 207 : IRIGEL(7,IAA) = 0 208 : IRIGEL(4,IAA) = xMATRI 209 : COERIG(IAA) =1.D0 210 : * initialisation du segment melem associé aux blocages 211 : NBELEM = NBPOIC-1 212 : SEGINI IPT1 213 : IRIGEL(1,IAA) = IPT1 214 : IPT1.ITYPEL = 22 215 : * on remplit le tableau des descripteurs 216 : SEGINI DESCR 217 : IRIGEL(3,IAA)=DESCR 218 : LISINC(1)='LX' 219 : LISDUA(1)='FLX' 220 : NOELEP(1)=1 221 : NOELED(1)=1 222 : IF (IDIM.EQ.3) THEN 223 : LISINC(2)= MOROTA(IAA) 224 : LISINC(3)= MOROTA(IAA) 225 : LISDUA(2)= MORODU(IAA) 226 : LISDUA(3)= MORODU(IAA) 227 : ELSE IF (IFOMOD.EQ.-1) THEN 228 : LISINC(2)= MOROTA(3) 229 : LISINC(3)= MOROTA(3) 230 : LISDUA(2)= MORODU(3) 231 : LISDUA(3)= MORODU(3) 232 : ELSE IF (ABS(NIFOUR).EQ.1) THEN 233 : LISINC(2)= MOROTA(4) 234 : LISINC(3)= MOROTA(4) 235 : LISDUA(2)= MORODU(4) 236 : LISDUA(3)= MORODU(4) 237 : ENDIF 238 : NOELEP(2)=2 239 : NOELEP(3)=3 240 : NOELED(2)=2 241 : NOELED(3)=3 242 : SEGDES DESCR 243 : * boucle sur les points du maillage ayant des ddl de rotation 244 : DO 20 II=1,NBELEM 245 : IP2 = NUM(1,(II+1)) 246 : IREFP2 = (IP2-1)*(IDIM+1) 247 : X2 = XCOOR(IREFP2+1) 248 : Y2 = XCOOR(IREFP2+2) 249 : IF (IDIM.EQ.3) Z2 = XCOOR(IREFP2+3) 250 : IPT1.ICOLOR(II) = IDCOUL 251 : * points associés aux multiplicateurs 252 : IPT1.NUM(1,II) = NBNOI + 1 253 : IREFM1 = NBNOI*(IDIM+1) 254 : NBNOI = NBNOI + 1 255 : IPT1.NUM(2,II) = IP1 256 : IPT1.NUM(3,II) = IP2 257 : XCOOR(IREFM1+1) = (X1 + X2)/2 258 : XCOOR(IREFM1+2) = (Y1 + Y2)/2 259 : IF (IDIM.EQ.3) THEN 260 : XCOOR(IREFM1+3) = (Z1 + Z2)/2 261 : ENDIF 262 : 20 CONTINUE 263 : SEGDES IPT1 264 : IND = IAA 265 : 10 CONTINUE 266 : ENDIF 267 : 268 : * fin de relations sur les rotations on passe 269 : * aux relations entre le noeud maitre et les depl. des autres noeuds 270 : IF (IDIM.EQ.3) NLIGRE = 5 271 : IF (IDIM.EQ.2) NLIGRE = 4 272 : NLIGRP = NLIGRE 273 : NLIGRD = NLIGRE 274 : NELRIG = (NBTOT-1) 275 : NBELEM = NBTOT-1 276 : * boucle sur les differents types de matrices 277 : DO 40 IAAA= 1,L2 278 : IAA = IND + IAAA 279 : * relations entre rt et uz et ur = -ut en fourier 1 280 : IF((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)) then 281 : nligre = 3 282 : nligrp = nligre 283 : nligrd = nligre 284 : NELRIG = NBTOT 285 : NBELEM = NBTOT 286 : ENDIF 287 : * initialisation du segment melem associé aux blocages 288 : SEGINI IPT1 289 : IPT1.ITYPEL = 22 290 : * 291 : IRIGEL(1,IAA) = IPT1 292 : IRIGEL(2,IAA) = 0 293 : IRIGEL(5,IAA) = NIFOUR 294 : IRIGEL(6,IAA) = 0 295 : IRIGEL(7,IAA) = 0 296 : SEGINI xMATRI 297 : IRIGEL(4,IAA) = xMATRI 298 : COERIG(IAA) =1.D0 299 : * on remplit le tableau des descripteurs 300 : SEGINI DESCR 301 : IRIGEL(3,IAA)=DESCR 302 : LISINC(1)='LX' 303 : LISDUA(1)='FLX' 304 : NOELEP(1)=1 305 : NOELED(1)=1 306 : 307 : NOELEP(2)=3 308 : NOELEP(3)=2 309 : NOELED(2)=3 310 : NOELED(3)=2 311 : IF (.NOT.((ABS(NIFOUR).EQ.1).AND.(IAAA.gt.1)))THEN 312 : NOELEP(4)=2 313 : NOELED(4)=2 314 : endif 315 : IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) kk = 4 316 : IF ((IFOMOD.EQ.2).OR.(IFOMOD.EQ.-1)) KK = IAAA 317 : LISINC(2)= MODEPL(KK) 318 : LISINC(3)= MODEPL(KK) 319 : LISDUA(2)= MODEDU(KK) 320 : LISDUA(3)= MODEDU(KK) 321 : * relation entre rt et uz en fourier 1 322 : IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.2)) then 323 : LISINC(2)= MODEPL(3) 324 : LISINC(3)= MOROTA(4) 325 : LISDUA(2)= MODEDU(3) 326 : LISDUA(3)= MORODU(4) 327 : endif 328 : * relation entre ur et ut en fourier 1 329 : if ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.3)) then 330 : LISINC(2)= MODEPL(4) 331 : LISINC(3)= MODEPL(5) 332 : LISDUA(2)= MODEDU(4) 333 : LISDUA(3)= MODEDU(5) 334 : ENDIF 335 : 336 : IF (IDIM.EQ.3) THEN 337 : IF (IAAA.EQ.1) THEN 338 : LISINC(4)= MOROTA(2) 339 : LISINC(5)= MOROTA(3) 340 : LISDUA(4)= MORODU(2) 341 : LISDUA(5)= MORODU(3) 342 : ELSE IF (IAAA.EQ.2) THEN 343 : LISINC(4)= MOROTA(3) 344 : LISINC(5)= MOROTA(1) 345 : LISDUA(4)= MORODU(3) 346 : LISDUA(5)= MORODU(1) 347 : ELSE 348 : LISINC(4)= MOROTA(1) 349 : LISINC(5)= MOROTA(2) 350 : LISDUA(4)= MORODU(1) 351 : LISDUA(5)= MORODU(2) 352 : ENDIF 353 : NOELEP(5)=2 354 : NOELED(5)=2 355 : * cont. ou defo planes 356 : ELSE IF (IFOMOD.EQ.-1) THEN 357 : LISINC(4)= MOROTA(3) 358 : LISDUA(4)= MORODU(3) 359 : * fourier 1 ou -1 360 : ELSE IF ((ABS(NIFOUR).EQ.1).AND.(IAAA.eq.1)) THEN 361 : LISINC(4)= MOROTA(4) 362 : LISDUA(4)= MORODU(4) 363 : ENDIF 364 : 365 : SEGDES DESCR 366 : 367 : * boucle sur les points du maillage total 368 : DO 50 II=1,NBELEM 369 : IF(NBELEM.NE.NBTOT) THEN 370 : * partie coques ou poutres 371 : IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1)) 372 : * partie massif 373 : IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1)) 374 : ELSE 375 : * fourier 1 ou -1, relation ur = -ut et relation entre rt et uz 376 : IF (II.LE.NBPOIC) IP2 = NUM(1,II) 377 : IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC)) 378 : ENDIF 379 : IREFP2 = (IP2-1)*(IDIM+1) 380 : X2 = XCOOR(IREFP2+1) 381 : Y2 = XCOOR(IREFP2+2) 382 : IF (IDIM.EQ.3) Z2 = XCOOR(IREFP2+3) 383 : IPT1.ICOLOR(II) = IDCOUL 384 : * points associés aux multiplicateurs 385 : IPT1.NUM(1,II) = NBNOI + 1 386 : IREFM1 = NBNOI*(IDIM+1) 387 : NBNOI = NBNOI + 1 388 : IF((ABS(NIFOUR).EQ.1).AND.(IAAA.EQ.3)) THEN 389 : IP1 = IP2 390 : X1 = X2 391 : Y1 = Y2 392 : ENDIF 393 : IPT1.NUM(2,II) = IP1 394 : IPT1.NUM(3,II) = IP2 395 : XCOOR(IREFM1+1) = (X1 + X2)/2 396 : XCOOR(IREFM1+2) = (Y1 + Y2)/2 397 : IF (IDIM.EQ.3) THEN 398 : XCOOR(IREFM1+3) = (Z1 + Z2)/2 399 : ENDIF 400 : * on remplit les valeurs RE de la matrice 401 : * SEGINI XMATRI 402 : * IXMATR = XMATRI 403 : * IMATTT(II) = IXMATR 404 : 405 : IF (IAAA.EQ.1) THEN 406 : COEF1 = Z2-Z1 407 : COEF2 = Y2-Y1 408 : ELSE IF (IAAA.EQ.2) THEN 409 : COEF1 = X2-X1 410 : COEF2 = Z2-Z1 411 : ELSE 412 : COEF1 = Y2-Y1 413 : COEF2 = X2-X1 414 : ENDIF 415 : 416 : RE(1,1,ii)= 0.D0 417 : RE(2,1,ii)= 1.D0 418 : RE(3,1,ii)= -1.D0 419 : if (abs(nifour).eq.1) then 420 : * relation entre uz et rt en fourier 1 421 : if (iaaa.eq.2) then 422 : re(3,1,ii) = -x2 423 : endif 424 : * relation ur = -ut en fourier 1 425 : if (iaaa.eq.3) then 426 : RE(3,1,ii)= 1.D0 427 : endif 428 : ENDIF 429 : IF (IDIM.EQ.3) THEN 430 : RE(4,1,ii)= -1.D0*COEF1 431 : RE(5,1,ii)= 1.D0*COEF2 432 : ELSE IF (IFOMOD.EQ.-1) THEN 433 : IF (IAAA.EQ.1) THEN 434 : RE(4,1,ii)= 1.D0*COEF2 435 : ELSE 436 : RE(4,1,ii)= -1.D0*COEF1 437 : ENDIF 438 : ELSE IF ((ABS(NIFOUR).EQ.1).and.(iaaa.eq.1)) then 439 : * relation entre ur1, ur2 et rt1 en fourier 1 440 : * le signe ne respecte pas le triedre orthonorme de fourier mais 441 : * celui des calculs plans. Ce n'est pas tres elegant mais c'est 442 : * comme ca dans C2000 !!!! 443 : RE(4,1,ii)= 1.D0*COEF2 444 : ENDIF 445 : 446 : DO 7 I=1,1 447 : DO 6 J=2,NLIGRE 448 : RE(I,J,ii)=RE(J,I,ii) 449 : 6 CONTINUE 450 : 7 CONTINUE 451 : 452 : DO 3 I=2,NLIGRE 453 : DO 4 J=2,NLIGRE 454 : RE(I,J,ii)=0.D0 455 : 4 CONTINUE 456 : 3 CONTINUE 457 : 458 : * SEGDES XMATRI 459 : 50 CONTINUE 460 : SEGDES xMATRI 461 : SEGDES IPT1 462 : 40 CONTINUE 463 : GOTO 1000 464 : 465 : * 466 : *** fin 3D ou (2d plan cont ou defo) ou (fourier 1) 467 : * 468 : 469 : 100 CONTINUE 470 : * 471 : *** fourier 0 ou axis 472 : * 473 : NBNN = 2 474 : 475 : IF (IFOMOD.EQ.0) THEN 476 : * axis : UR=0 RT=0 UZ = cte 477 : L2 = 2 478 : NNMAT = 3 479 : NBRELA = NBPOIC*3 + NBPOIM*2 - 1 480 : * cas sans rotation 481 : if (irota.eq.0) then 482 : nnmat = 2 483 : nbrela = nbpoic*2 -1 484 : endif 485 : ELSE 486 : * fourier 0 : UR=0 RT=0 UZ = cte relation d'analogie sur UT 487 : L2 = 3 488 : NNMAT = 4 489 : NBRELA = NBPOIC*4 + NBPOIM*3 - 2 490 : * cas sans rotation 491 : if (irota.eq.0) then 492 : nnmat = 3 493 : nbrela = nbpoic*3 -2 494 : endif 495 : ENDIF 496 : * on ajuste MCOORD pour les noeuds associes aux multiplicateurs 497 : NBPTS = NBNO + NBRELA 498 : NBNOI = NBNO 499 : SEGADJ MCOORD 500 : * initialisation du segment mrigid 501 : NRIGE=7 502 : NRIGEL=NNMAT 503 : SEGINI MRIGID 504 : ICHOLE=0 505 : IMGEO1=0 506 : IMGEO2=0 507 : ISUPEQ=0 508 : IFORIG=IFOMOD 509 : MTYMAT='RIGIDITE' 510 : KRIGI=MRIGID 511 : if (irota.eq.0) goto 121 512 : * rotation RT = 0 513 : NELRIG = NBPOIC 514 : NLIGRE = 2 515 : NLIGRP = NLIGRE 516 : NLIGRD = NLIGRE 517 : * SEGINI IMATRI 518 : SEGINI XMATRI 519 : * IXMATR=XMATRI 520 : * DO 105 I=1,NELRIG 521 : * IMATTT(I) = IXMATR 522 : * 105 CONTINUE 523 : * on remplit les valeurs RE de la matrice pour les rotations 524 : RE(1,1,1)= 0.D0 525 : RE(2,1,1)= 1.D0 526 : RE(2,2,1)= 0.D0 527 : RE(1,2,1)= RE(2,1,1) 528 : do ioup=2,nelrig 529 : do io=1,re(/2) 530 : do iu=1,re(/1) 531 : re(iu,io,ioup)=re(iu,io,1) 532 : enddo 533 : enddo 534 : enddo 535 : * SEGDES XMATRI 536 : SEGDES xMATRI 537 : 538 : IRIGEL(2,1) = 0 539 : IRIGEL(5,1) = NIFOUR 540 : IRIGEL(6,1) = 0 541 : IRIGEL(7,1) = 0 542 : IRIGEL(4,1) = xMATRI 543 : COERIG(1) =1.D0 544 : * initialisation du segment melem associé aux blocages 545 : NBELEM = NBPOIC 546 : SEGINI IPT1 547 : IRIGEL(1,1) = IPT1 548 : IPT1.ITYPEL = 22 549 : * on remplit le tableau des descripteurs 550 : SEGINI DESCR 551 : IRIGEL(3,1)=DESCR 552 : LISINC(1)='LX' 553 : LISDUA(1)='FLX' 554 : LISINC(2)= MOROTA(4) 555 : LISDUA(2)= MORODU(4) 556 : NOELEP(1)=1 557 : NOELED(1)=1 558 : NOELEP(2)=2 559 : NOELED(2)=2 560 : SEGDES DESCR 561 : * boucle sur les points du maillage ayant des ddl de rotation 562 : DO 120 II=1,NBELEM 563 : IP2 = NUM(1,II) 564 : IREFP2 = (IP2-1)*(IDIM+1) 565 : X2 = XCOOR(IREFP2+1) 566 : Y2 = XCOOR(IREFP2+2) 567 : IPT1.ICOLOR(II) = IDCOUL 568 : * points associés aux multiplicateurs 569 : IPT1.NUM(1,II) = NBNOI + 1 570 : IREFM1 = NBNOI*(IDIM+1) 571 : NBNOI = NBNOI + 1 572 : IPT1.NUM(2,II) = IP2 573 : XCOOR(IREFM1+1) = X2 574 : XCOOR(IREFM1+2) = Y2 575 : 120 CONTINUE 576 : SEGDES IPT1 577 : 121 continue 578 : 579 : * fin de relations sur la rotation on passe aux relations 580 : * sur les déplacements 581 : DO 140 IAAA= 1,L2 582 : IAA = 1 + IAAA 583 : if (irota.eq.0) iaa = iaaa 584 : IF (IAAA.EQ.1) THEN 585 : NLIGRE = 2 586 : NBELEM = NBTOT 587 : ELSE 588 : NLIGRE =3 589 : NBELEM = NBTOT-1 590 : NBNN = 3 591 : ENDIF 592 : NLIGRP = NLIGRE 593 : NLIGRD = NLIGRE 594 : NELRIG = NBELEM 595 : * initialisation du segment melem associé aux blocages 596 : SEGINI IPT1 597 : IPT1.ITYPEL = 22 598 : IRIGEL(1,IAA) = IPT1 599 : IRIGEL(2,IAA) = 0 600 : IRIGEL(5,IAA) = NIFOUR 601 : IRIGEL(6,IAA) = 0 602 : IRIGEL(7,IAA) = 0 603 : SEGINI xMATRI 604 : 605 : 606 : IRIGEL(4,IAA) = xMATRI 607 : COERIG(IAA) =1.D0 608 : * on remplit le tableau des descripteurs 609 : SEGINI DESCR 610 : IRIGEL(3,IAA)=DESCR 611 : LISINC(1)='LX' 612 : LISDUA(1)='FLX' 613 : NOELEP(1)=1 614 : NOELED(1)=1 615 : NOELEP(2)=2 616 : NOELED(2)=2 617 : IF(IAAA.EQ.1) THEN 618 : LISINC(2) = MODEPL(4) 619 : LISDUA(2) = MODEDU(4) 620 : ELSE 621 : NOELEP(3)=4 622 : NOELED(3)=4 623 : IF(IAAA.EQ.2) THEN 624 : LISINC(2) = MODEPL(3) 625 : LISDUA(2) = MODEDU(3) 626 : LISINC(3) = MODEPL(3) 627 : LISDUA(3) = MODEDU(3) 628 : ELSE 629 : LISINC(2) = MODEPL(5) 630 : LISDUA(2) = MODEDU(5) 631 : LISINC(3) = MODEPL(5) 632 : LISDUA(3) = MODEDU(5) 633 : ENDIF 634 : ENDIF 635 : SEGDES DESCR 636 : DO 150 II=1,NBELEM 637 : IF(IAAA.GT.1) THEN 638 : IF (II.LT.NBPOIC) IP2 = NUM(1,(II+1)) 639 : IF (II.GE.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC+1)) 640 : ELSE 641 : IF (II.LE.NBPOIC) IP2 = NUM(1,II) 642 : IF (II.GT.NBPOIC) IP2 = IPT2.NUM(1,(II-NBPOIC)) 643 : ENDIF 644 : IREFP2 = (IP2-1)*(IDIM+1) 645 : X2 = XCOOR(IREFP2+1) 646 : Y2 = XCOOR(IREFP2+2) 647 : IPT1.ICOLOR(II) = IDCOUL 648 : * points associés aux multiplicateurs 649 : IPT1.NUM(1,II) = NBNOI + 1 650 : IREFM1 = NBNOI*(IDIM+1) 651 : NBNOI = NBNOI + 1 652 : IPT1.NUM(3,II) = IP2 653 : IF(IAAA.GT.1) THEN 654 : IPT1.NUM(4,II) = IP1 655 : XCOOR(IREFM1+1) = (X1 + X2)/2 656 : XCOOR(IREFM1+2) = (Y1 + Y2)/2 657 : ELSE 658 : XCOOR(IREFM1+1) = X2 659 : XCOOR(IREFM1+2) = Y2 660 : ENDIF 661 : 662 : * on remplit les valeurs RE de la matrice 663 : 664 : * SEGINI XMATRI 665 : * IXMATR = XMATRI 666 : IF(IAAA.EQ.1) THEN 667 : RE(1,1,ii)= 0.D0 668 : RE(2,1,ii)= 1.D0 669 : RE(2,2,ii)= 0.D0 670 : RE(1,2,ii)= RE(2,1,ii) 671 : RE(1,2,ii)= RE(3,1,ii) 672 : ELSE 673 : RE(1,1,ii)= 0.D0 674 : RE(2,1,ii)= 1.D0 675 : IF (IAAA.EQ.2) THEN 676 : RE(3,1,ii)= -1.D0 677 : ELSE 678 : COEF1 = X2/X1 679 : RE(3,1,ii)= -1.D0*COEF1 680 : ENDIF 681 : RE(2,2,ii)= 0.D0 682 : RE(3,2,ii)= 0.D0 683 : RE(3,3,ii)= 0.D0 684 : RE(1,2,ii)= RE(2,1,ii) 685 : RE(1,3,ii)= RE(3,1,ii) 686 : RE(2,3,ii)= RE(3,2,ii) 687 : ENDIF 688 : 689 : * SEGDES XMATRI 690 : * IMATTT(II) = IXMATR 691 : 150 CONTINUE 692 : SEGDES xMATRI 693 : SEGDES IPT1 694 : 140 CONTINUE 695 : 696 : 1000 CONTINUE 697 : SEGDES MRIGID 697 : CALL ECROBJ('RIGIDITE', KRIGI) 698 : IF (LP.EQ.0) SEGDES MELEME 699 : IF (IPM.NE.0) SEGDES IPT2 700 : RETURN 701 : END 702 : 703 :
© Cast3M 2003 - All rights reserved.
Disclaimer