1 : C ASSEM4 SOURCE PV 11/06/08 21:15:00 7002 2 : SUBROUTINE ASSEM4(IPOIRI,NOINC,SNOMIN,NOMAI,MMATRX, 3 : # INUINY,ITOPOY,INCTRY,IITOPY,NBNNMA,NLIGRA,SNTT,SNTO,DES1) 4 : 5 : ** CETTE SUBROUTINE EFFECTUE LA PREPARATION A L'ASSEMBLAGE DANS LE CAS DU CALCUL DU 6 : ** SUPER-ELEMENT 7 : 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : CHARACTER*4 CMOT 11 : 12 : -INC CCOPTIO 13 : -INC SMELEME 14 : -INC SMCOORD 15 : -INC SMRIGID 16 : -INC SMMATRI 17 : SEGMENT,IMIN(NNOE) 18 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) 19 : SEGMENT,INUINV(NNGLOB) 20 : SEGMENT,INUIN2(2*NNGLOB) 21 : SEGMENT,ITOPO(IENNO) 22 : SEGMENT,IITOP(NNOE+1) 23 : SEGMENT,INCTRR(NIRI) 24 : SEGMENT,INCTRA(NLIGRE) 25 : C 26 : C **** CES TABLEAUX SERVENT AU REPERAGE DE LA MATRICE POUR L'ASSEMBLAG 27 : C **** IL SERONT TOUS SUPPRIMES EN FIN D'ASSEMBLAGE. 28 : C 29 : C 30 : C **** MAXINC= MAXIMUM DE COMPOSANTES CONCERNANT UN NOEUD 31 : C 32 : C **** IITOP(K)=I LE 1ER ELEMENT TOUCHANT LE NOEUD K SE TROUVE EN 33 : C IEME POSITION DANS ITOPO 34 : C **** ITOPO(I)=L: LE 1ER ELEMENT TOUCHANT LE K EME NOEUD DE LA 35 : C ITOPO(I+1)=M MATRICE EST LE LIEME DE L'OBJET GEOMETRIE 36 : C DEFINI PAR LE POINTEUR M 37 : C **** INUINV(I)=J J EST LE NOUVEAU NUMERO DU NOEUD I 38 : C 39 : 40 : ** SEGMENTS DE TRAVAIL 41 : 42 : SEGMENT NOMAI(XCOOR(/1)/(IDIM+1)) 43 : SEGMENT NOINC(NNIN,ITA) 44 : SEGMENT SNOMIN 45 : CHARACTER*4 NOMIN(M) 46 : ENDSEGMENT 47 : SEGMENT SNTO 48 : INTEGER NTOTMA(NN) 49 : ENDSEGMENT 50 : C 51 : SEGMENT SNTT 52 : INTEGER NTTMAI(NN) 53 : ENDSEGMENT 54 : C 55 : SEGMENT ILOCAL(NBNUM) 56 : C 57 : ** NOMAI(I)<>0 SI LE NOEUD I EST MAITRE (I=N° ABSOLU) 58 : C 59 : ** NOINC(I,J)=1 SI L'INCONNUE I EXISTE POUR LE NOEUD J (J=N° LOCAL) 60 : C 61 : ** NOMIN(I)= INCO : L'INCONNUE N°I EST L'INCONNUE DE NOM 'INCO' 62 : ** CE SEGMENT NE CONTIENT QUE LES INCONNUES MAITRESSES 63 : ** NTOTMA : SEGMENT DES NOEUDS MAITRES POUR LESQUELS TOUTES LES INCONNUES 64 : ** SONT MAITRESSES 65 : ** NTTMAI : SEGMENT DES NOEUDS MAITRES QUI N'ONT PAS TOUTES LEURS INCONNUES 66 : ** MAITRESSES 67 : ** ILOCAL : SEGMENT DES NUMEROS LOCAUX 68 : 69 : 70 : * DATA MOALFA/'ALFA'/ 71 : CHARACTER*4 CNOHA 72 : DATA CNOHA/'NOHA'/ 73 : DATA IPOIN/1/ 74 : 75 : READ (CNOHA,FMT='(A4)') NOHA 76 : NNGLOB=XCOOR(/1)/(IDIM+1) 77 : 78 : MRIGID=IPOIRI 79 : SEGACT,MRIGID 80 : 81 : NNVA=IRIGEL(/2) 82 : NIRI=NNVA 83 : SEGINI,INCTRR 84 : MVA=IRIGEL(/1) 85 : MELEME=IRIGEL(1,1) 86 : SEGACT,MELEME 87 : IF(ITYPEL.NE.27) GO TO 801 88 : SEGDES MELEME 89 : C 90 : C **** ASSEMBLAGE DANS LE CAS DE L'ANALYSE MODALE. ON COMPTE LES POINTS 91 : C **** DANS ICPR 92 : C 93 : SEGINI,INUINV,ICPR 94 : IKI=0 95 : DO 700 I=1,NNVA 96 : MELEME=IRIGEL(1,I) 97 : SEGACT,MELEME 98 : NBNN=NUM(/1) 99 : NBELEM=NUM(/2) 100 : DO 701 I1=1,NBELEM 101 : DO 701 I2=1,NBNN 102 : IP1=NUM(I2,I1) 103 : IF(ICPR(IP1).NE.0) GO TO 701 104 : IKI=IKI+1 105 : ICPR(IP1)=IKI 106 : 701 CONTINUE 107 : SEGDES MELEME 108 : 700 CONTINUE 109 : C 110 : C **** FABRICATION DU TABLEAU INUINV 111 : C **** ON MET LES POINTS QUI ONT POUR INCONNUE ALFA EN TETE 112 : C 113 : NNOE=IKI 114 : NALFA=0 115 : NBETA=0 116 : DO 710 I=1,NNVA 117 : MELEME=IRIGEL(1,I) 118 : DESCR =IRIGEL(3,I) 119 : SEGACT,MELEME,DESCR 120 : NBNN=NUM(/1) 121 : NBELEM=NUM(/2) 122 : NLIGRE=LISINC(/2) 123 : DO 711 I1=1,NBELEM 124 : DO 711 I2=1,NBNN 125 : IP1=NUM(I2,I1) 126 : IF(ICPR(IP1).EQ.0) GO TO 711 127 : 715 CONTINUE 128 : NBETA=NBETA+1 129 : IKI=NNOE-NBETA+1 130 : 716 CONTINUE 131 : INUINV(IP1)=IKI 132 : ICPR(IP1)=0 133 : 711 CONTINUE 134 : SEGDES MELEME,DESCR 135 : 710 CONTINUE 136 : SEGSUP,ICPR 137 : ICDOUR=NNOE 138 : GO TO 800 139 : C 140 : C **** ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES 141 : C **** GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA OBJETS 142 : C **** GEOMETRIQUES ELEMENTAIRES. PUIS ON ENVOIE DANS NUMOPT QUI 143 : C **** FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU 144 : C **** NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR. 145 : C **** LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD 146 : C **** DE LA MATRICE, ETC... 147 : C 148 : 149 : 801 CONTINUE 150 : 151 : NUMDEB=INT(XCOOR(/1)/(IDIM+1)) 152 : MAXNUM=NUMDEB 153 : 154 : NBNUM=NUMDEB 155 : SEGINI,ILOCAL 156 : 157 : ** NUMEROTATION LOCALE DE TOUS LES NOEUDS 158 : IKOU=0 159 : SEGACT NOMAI 160 : SEGADJ NOMAI 161 : *** write (6,*) ' dimension de nomai ',nomai(/1),nnglob 162 : DO 50 I0=1,NNVA 163 : MELEME=IRIGEL(1,I0) 164 : SEGACT,MELEME 165 : DO 51 I2=1,NUM(/2) 166 : DO 51 I1=1,NUM(/1) 167 : IJ=NUM(I1,I2) 168 : IF (ILOCAL(IJ).NE.0.or.nomai(ij).ne.0) GOTO 51 169 : IKOU=IKOU+1 170 : ILOCAL(IJ)=IKOU 171 : 51 CONTINUE 172 : SEGDES MELEME 173 : 50 CONTINUE 174 : NNOE=IKOU 175 : DO 52 I=1,NOMAI(/1) 176 : IF(NOMAI(I).NE.0.AND.ILOCAL(I).EQ.0) THEN 177 : NNOE=NNOE+1 178 : ILOCAL(I)=ikou+nomai(i) 179 : ENDIF 180 : 52 CONTINUE 181 : SEGDES NOMAI 182 : C 183 : C RECHERCHE DE LA VALEUR PAR DEFAUT DE L'HARMONIQUE DANS LE CAS 184 : C DE L'UTILISATION DE " OPTION MODE FOUR NOHAR " 185 : C 186 : DO 230 IRI=1,NNVA 187 : IHARIR=IRIGEL(5,IRI) 188 : IF(IHARIR.NE.NOHA) THEN 189 : IARDEF = IHARIR 190 : GO TO 231 191 : ENDIF 192 : 230 CONTINUE 192 : CALL ERREUR ( 21) 193 : RETURN 194 : 231 CONTINUE 195 : DO 232 IRI=1,NNVA 196 : IF( IRIGEL(5,IRI).EQ.NOHA) GO TO 232 197 : IF( IRIGEL(5,IRI).EQ.IARDEF ) GO TO 232 197 : CALL ERREUR (21) 198 : RETURN 199 : 232 CONTINUE 200 : C 201 : C **** RECHERCHE DE LA VALEUR MAXINC QUI PERMET DE DIMENSIONNER INCPOS 202 : C 203 : SEGINI,MIDUA 204 : SEGINI,MIMIK 205 : SEGINI,MHARK 206 : DESCR=IRIGEL(3,1) 207 : SEGACT,DESCR 208 : IMIK(**)=LISINC(1) 209 : IAAR=IRIGEL(5,1) 210 : IF(IAAR.EQ.NOHA) IAAR = IARDEF 211 : IHAR(**)= IAAR 212 : IDUA(**)=LISDUA(1) 213 : MAXINC=1 214 : DO 323 IRI=1,NNVA 215 : DESCR=IRIGEL(3,IRI) 216 : IHARIR=IRIGEL(5,IRI) 217 : IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF 218 : SEGACT,DESCR 219 : NLIGRE=LISINC(/2) 220 : DO 326 I=1,NLIGRE 221 : DO 324 J=1,MAXINC 222 : IF(IMIK(J).NE.LISINC(I)) GO TO 324 223 : IF(IHAR(J).EQ.IHARIR) GO TO 326 224 : 324 CONTINUE 225 : MAXINC=MAXINC+1 226 : IHAR(**)=IHARIR 227 : IMIK(**)=LISINC(I) 228 : IDUA(**)=LISDUA(I) 229 : 326 CONTINUE 230 : SEGDES,DESCR 231 : 323 CONTINUE 232 : NDUA=IDUA(/2) 233 : 234 : C 235 : C **** INITIALISATION DE INCPOS ET DE INCTRA. 236 : C 237 : MAXI=MAXINC 238 : SEGINI,MINCPO 239 : DO 329 IRI=1,NNVA 240 : DESCR=IRIGEL(3,IRI) 241 : IHARIR=IRIGEL(5,1) 242 : IF(IHARIR.EQ.NOHA ) IHARIR = IARDEF 243 : SEGACT,DESCR 244 : MELEME=IRIGEL(1,IRI) 245 : SEGACT,MELEME 246 : NLIGRE=LISINC(/2) 247 : SEGINI,INCTRA 248 : INCTRR(IRI)=INCTRA 249 : N2=NUM(/2) 250 : IADS=XCOOR(/1)/(IDIM+1) 251 : DO 334 J=1,NLIGRE 252 : DO 333 K=1,MAXINC 253 : IF(LISINC(J).NE.IMIK(K)) GO TO 333 254 : IF(IHAR(K).EQ.IHARIR) GO TO 332 255 : 333 CONTINUE 256 : 332 CONTINUE 257 : INCTRA(J)=K 258 : DO 331 I=1,N2 259 : IJ=ILOCAL(NUM(NOELEP(J),I)) 260 : 331 INCPO(K,IJ)=1 261 : 334 CONTINUE 262 : SEGDES,DESCR 263 : SEGDES,INCTRA 264 : 329 CONTINUE 265 : C 266 : SEGACT,SNOMIN 267 : SEGACT,NOMAI 268 : SEGACT,NOINC 269 : DO 3301 I=1,NOMAI(/1) 270 : IF(NOMAI(I).EQ.0) GOTO 3301 271 : N1=NOMAI(I) 272 : DO 3302 J=1,NOMIN(/2) 273 : IF(NOINC(J,N1).EQ.0) GOTO 3302 274 : DO 3303 K=1,IMIK(/2) 275 : IF(NOMIN(J).EQ.IMIK(K)) GO TO 3304 276 : 3303 CONTINUE 277 : 3304 CONTINUE 278 : INCPO(K,ILOCAL(I))=1 279 : 3302 CONTINUE 280 : 3301 CONTINUE 281 : C 282 : C 283 : MAXPOD=MAXINC*NNOE+1 284 : MAXPO=MAXPOD 285 : NBNNMA=0 286 : DO 299 I=1,INCPO(/1) 287 : DO 2991 J=1,INCPO(/2) 288 : NBNNMA=NBNNMA+INCPO(I,J) 289 : 2991 CONTINUE 290 : 299 CONTINUE 291 : C 292 : C ** ON EFFECTUE UN TRI DES NOEUDS MAITRES POUR DISTINGUER LES NOEUDS 293 : C ** "TOTALEMENT MAITRES" DES NOEUDS "NON TOTALEMENT MAITRES" 294 : C 295 : NLIGRA=0 296 : DO 30 I=1,NOMAI(/1) 297 : IF (NOMAI(I).EQ.0) GOTO 30 298 : 32 CONTINUE 299 : NINCMA=0 300 : NINC = 0 301 : DO 33 J=1,INCPO(/1) 302 : N2=J 303 : IF (INCPO(J,ILOCAL(I)).NE.1) GOTO 33 304 : NINC=NINC+1 305 : DO 34 JJ=1,NOMIN(/2) 306 : N3=JJ 307 : IF (IMIK(J).EQ.NOMIN(JJ)) GOTO 35 308 : ** IF (IMIK(J).EQ.NOMIN(JJ).AND.IHAR(J).EQ.IHARMA(JJ)) GOTO 35 309 : 34 CONTINUE 310 : GOTO 33 311 : 35 CONTINUE 312 : IF (NOINC(N3,NOMAI(I)).EQ.1) THEN 313 : INCPO(N2,ILOCAL(I))=MAXPOD 314 : NINCMA=NINCMA+1 315 : NLIGRA=NLIGRA+1 316 : NBNNMA=NBNNMA-1 317 : ENDIF 318 : 33 CONTINUE 319 : IF(NINCMA.GT.0) THEN 320 : IF(NINCMA.EQ.NINC) THEN 321 : NTOTMA(**)=ILOCAL(I) 322 : DO 3333 J=1,INCPO(/1) 323 : IF(INCPO(J,ILOCAL(I)).EQ.MAXPOD) 324 : & INCPO(J,ILOCAL(I))=1 325 : 3333 CONTINUE 326 : ELSE 327 : NTTMAI(**)=ILOCAL(I) 328 : ENDIF 329 : ENDIF 330 : 30 CONTINUE 331 : NODDEB=NNOE 332 : SEGDES NOINC 333 : C 334 : C **** ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES 335 : C **** GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA+1 OBJETS 336 : C **** GEOMETRIQUES ELEMENTAIRES. LE PREMIER SOUS-OBJET CONTIENT 337 : C **** LES NOEUDS TOTALEMENT MAITRES (S'IL Y EN A), QUI SERONT 338 : C **** PLACES EN FIN DE NUMEROTATION. ON APPELLE NUMOPT2 (OU NUMOPT) 339 : C **** QUI FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU 340 : C **** NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR. 341 : C **** LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD 342 : C **** DE LA MATRICE, ETC... 343 : C 344 : C on met d'abord en tete un point bidon pour etre coherent 345 : C avec le precontionnement dans numopt 346 : C 347 : IF(NTOTMA(/1).NE.0) THEN 348 : NBNN=1 349 : NBSOUS=0 350 : NBREF=0 351 : NBELEM=1 352 : SEGINI,IPT5 353 : IPT5.ITYPEL=28 354 : DO 221 J=1,ILOCAL(/1) 355 : IF (ILOCAL(J).EQ.NTOTMA(1)) GOTO 222 356 : 221 CONTINUE 356 : CALL ERREUR(5) 357 : 222 CONTINUE 358 : IPT5.NUM(1,1)=J 359 : NBELEM=NTOTMA(/1) 360 : SEGINI,IPT3 361 : IPT3.ITYPEL=28 362 : DO 200 I=1,NTOTMA(/1) 363 : DO 201 J=1,ILOCAL(/1) 364 : IF (ILOCAL(J).EQ.NTOTMA(I)) GOTO 202 365 : 201 CONTINUE 365 : CALL ERREUR(5) 366 : RETURN 367 : 202 CONTINUE 368 : IPT3.NUM(1,I)=J 369 : 200 CONTINUE 370 : 371 : ELSE 372 : 373 : IKK=1 374 : 722 CONTINUE 375 : MELEME=IRIGEL(1,IKK) 376 : SEGACT,MELEME 377 : DESCR=IRIGEL(3,IKK) 378 : SEGACT,DESCR 379 : NLIGRE=LISINC(/2) 380 : DO 720 K=1,NLIGRE 381 : IF(LISINC(K).NE.'LX ') GO TO 721 382 : 720 CONTINUE 383 : SEGDES,MELEME 384 : SEGDES,DESCR 385 : IKK=IKK+1 386 : IF(IKK.LE.NNVA) GO TO 722 387 : DO 4862 I=1,NNVA 388 : MELEME= IRIGEL(1,I) 389 : SEGACT MELEME 390 : IF(ITYPEL.EQ.22) THEN 391 : DESCR=IRIGEL(3,I ) 392 : SEGACT,DESCR 393 : K = 3 394 : GO TO 4863 395 : ELSE 396 : SEGDES MELEME 397 : ENDIF 398 : 4862 CONTINUE 399 : K=1 400 : MELEME= IRIGEL(1,1) 401 : DESCR= IRIGEL(3,1) 402 : SEGACT MELEME,DESCR 403 : 4863 CONTINUE 404 : 721 IA=NOELEP(K) 405 : I1=NUM(IA,1) 406 : NBSOUS=0 407 : NBNN=1 408 : NBREF=0 409 : NBELEM=1 410 : SEGDES,MELEME,DESCR 411 : SEGINI,IPT3 412 : IPT3.ITYPEL=1 413 : IPT3.NUM(1,1)=I1 414 : ipt5=ipt3 415 : ENDIF 416 : SEGDES IPT3 417 : NBSOUS=NNVA+2 418 : NBREF=0 419 : NBNN=0 420 : NBELEM=0 421 : SEGINI,IPT2 422 : IPT2.LISOUS(1)=IPT5 423 : IPT2.LISOUS(2)=IPT3 424 : NOSOUS=3 425 : DO 210 I=1,NNVA 426 : IPT2.LISOUS(NOSOUS)=IRIGEL(1,I) 427 : NOSOUS=NOSOUS+1 428 : 210 CONTINUE 429 : SEGDES IPT2 430 : 431 : NNGLOB=ILOCAL(/1) 432 : SEGINI,INUINV 433 : DO 450 I=1,NNGLOB 434 : INUINV(I)=ILOCAL(I) 435 : 450 CONTINUE 436 : 436 : CALL NUMOPT(IPT2,INUINV,NNOE) 437 : segact inuinv*mod 438 : IF(NTOTMA(/1).NE.0) THEN 439 : * on remet les noeuds totalement maitre a la fin, ce que numopt ne fait 440 : * pas 441 : nbtmai=ntotma(/1) 442 : segact ipt3 443 : do i=1,nbtmai 444 : ** inuinv(ipt3.num(1,i))= inuinv(ipt3.num(1,i))+nnglob 445 : inuinv(ipt3.num(1,i))= ipt3.num(1,i)+nnglob 446 : enddo 447 : segini inuin2 448 : do i=1,nnglob 449 : if (inuinv(i).ne.0) inuin2(inuinv(i))=i 450 : enddo 451 : icour=0 452 : do 803 i=1,2*nnglob 453 : if (inuin2(i).eq.0) goto 803 454 : icour=icour+1 455 : inuin2(icour)=inuin2(i) 456 : 803 continue 457 : do i=1,nnglob 458 : inuinv(i)=0 459 : enddo 460 : do i=1,nnglob 461 : if (inuin2(i).ne.0) inuinv(inuin2(i))=i 462 : enddo 463 : segsup inuin2 464 : ENDIF 465 : 466 : 467 : 468 : 800 CONTINUE 469 : 470 : ** ON APPLIQUE LA NOUVELLE NUMEROTATION A INCPO ET A NTTMAI 471 : 472 : SEGINI,MIPO1=MINCPO 473 : DO 600 I=1,NNGLOB 474 : IF (INUINV(I).EQ.0) GOTO 600 475 : DO 610 II=1,MAXINC 476 : INCPO(II,INUINV(I))=MIPO1.INCPO(II,ILOCAL(I)) 477 : 610 CONTINUE 478 : 600 CONTINUE 479 : 480 : SEGSUP,MIPO1 481 : DO 615 I=1,NTTMAI(/1) 482 : DO 616 II=1,ILOCAL(/1) 483 : IF (NTTMAI(I).EQ.ILOCAL(II)) THEN 484 : NTTMAI(I)=INUINV(II) 485 : GOTO 615 486 : ENDIF 487 : 616 CONTINUE 488 : 615 CONTINUE 489 : 490 : DO 617 I=1,NTOTMA(/1) 491 : DO 618 II=1,ILOCAL(/1) 492 : IF (NTOTMA(I).EQ.ILOCAL(II)) THEN 493 : NTOTMA(I)=INUINV(II) 494 : GOTO 617 495 : ENDIF 496 : 618 CONTINUE 497 : 617 CONTINUE 498 : C 499 : C **** CREATION D'UN OBJET GEOMETRIE (IPT1) QU'IL FAUDRA CHANGER EN CAS DE 500 : C **** RENUMEROTATION GENERALE. ON PROFITE DE LA BOUCLE POUR CREER LE 501 : C **** TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I (NU- 502 : C **** MEROTATION LOCALE). 503 : C 504 : SEGINI,IMIN 505 : NBSOUS=0 506 : NBREF=0 507 : NBNN=1 508 : NBELEM=NNOE 509 : SEGINI,IPT1 510 : IPT1.ITYPEL=IPOIN 511 : DO 316 IRI=1,NNVA 512 : MELEME=IRIGEL(1,IRI) 513 : SEGACT,MELEME 514 : N1=NUM(/1) 515 : N2=NUM(/2) 516 : DO 317 I=1,N2 517 : DO 317 J=1,N1 518 : K=NUM(J,I) 519 : M=INUINV(K) 520 : IMIN(M)=IMIN(M)+1 521 : IPT1.NUM(1,M)=K 522 : 317 CONTINUE 523 : SEGDES,MELEME 524 : 316 CONTINUE 525 : DO 3161 I=1,NOMAI(/1) 526 : IF(NOMAI(I).EQ.0) GO TO 3161 527 : IPT1.NUM(1,INUINV(I))=I 528 : 3161 CONTINUE 529 : 530 : 531 : C **** INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER 532 : C **** DANS ITOPO . 533 : C 534 : SEGINI,IITOP 535 : IITOP(1)=1 536 : DO 318 I=1,NNOE 537 : IITOP(I+1)=IMIN(I)* 2 + IITOP(I) 538 : 318 CONTINUE 539 : DO 319 I=1,NNOE 540 : 319 IMIN(I)=0 541 : IENNO=IITOP(NNOE+1) 542 : SEGINI,ITOPO 543 : DO 321 IRI=1,NNVA 544 : MELEME=IRIGEL(1,IRI) 545 : SEGACT,MELEME 546 : N1=NUM(/1) 547 : N2=NUM(/2) 548 : DO 322 I=1,N2 549 : DO 322 J=1,N1 550 : K=NUM(J,I) 551 : M=INUINV(K) 552 : IMIN(M)=IMIN(M)+1 553 : IUY= 2* ( IMIN(M)-1 ) + IITOP(M) 554 : ITOPO(IUY)=I 555 : ITOPO(IUY+1)=IRI 556 : 322 CONTINUE 557 : SEGDES,MELEME 558 : 321 CONTINUE 559 : C 560 : C *** NUMEROTATION DES INCONNUES DE INCPO 561 : C 562 : NA=0 563 : 564 : DO 337 I=1,NNOE 565 : DO 335 K=1,MAXINC 566 : IF(INCPO(K,I).EQ.0) GO TO 335 567 : IF (INCPO(K,I).LT.MAXPOD) THEN 568 : NA=NA+1 569 : INCPO(K,I)=NA 570 : ENDIF 571 : 335 CONTINUE 572 : 337 CONTINUE 573 : DO 339 I=1,NTTMAI(/1) 574 : N1=NTTMAI(I) 575 : DO 338 K=1,MAXINC 576 : IF(INCPO(K,N1).EQ.0) GO TO 338 577 : IF (INCPO(K,N1).EQ.MAXPOD) THEN 578 : NA=NA+1 579 : INCPO(K,N1)=NA 580 : ENDIF 581 : 338 CONTINUE 582 : 339 CONTINUE 583 : C 584 : C CREATION DU DESCRIPTEUR DE LA RIGIDITE EQUIVALENTE 585 : C 586 : NLIGRD=NLIGRA 587 : NLIGRP=NLIGRA 588 : SEGINI,DES1 589 : DO 341 IGLOB=1,NOMAI(/1) 590 : IF(NOMAI(IGLOB).EQ.0) GOTO 341 591 : ILOC=INUINV(IGLOB) 592 : DO 342 I=1,INCPO(/1) 593 : IF(INCPO(I,ILOC).GT.NBNNMA) THEN 594 : ICOL=INCPO(I,ILOC)-NBNNMA 595 : DES1.NOELEP(ICOL)=NOMAI(IGLOB) 596 : DES1.NOELED(ICOL)=NOMAI(IGLOB) 597 : DES1.LISINC(ICOL)=IMIK(I) 598 : DES1.LISDUA(ICOL)=IDUA(I) 599 : ENDIF 600 : 342 CONTINUE 601 : 341 CONTINUE 602 : 603 : SEGDES DES1 604 : 605 : SEGDES,MIDUA,MIMIK,MHARK 606 : 607 : SEGDES,MRIGID 608 : 609 : SEGDES,ITOPO 610 : SEGDES,IITOP 611 : SEGDES,INUINV 612 : SEGDES,IPT1 613 : SEGDES,MINCPO 614 : SEGSUP,IMIN 615 : SEGDES,INCTRR 616 : INCTRY=INCTRR 617 : SEGINI,MMATRI 618 : NENS=0 619 : IGEOMA=IPT1 620 : IIDUA=MIDUA 621 : IINCPO=MINCPO 622 : IIMIK=MIMIK 623 : IHARK=MHARK 624 : INUINY=INUINV 625 : ITOPOY=ITOPO 626 : IITOPY=IITOP 627 : MMATRX=MMATRI 628 : SEGDES,MMATRI 629 : SEGDES,ILOCAL 630 : SEGDES,MELEME 631 : SEGDES,DESCR 632 : SEGDES,SNTT 633 : SEGDES,SNTO 634 : SEGDES NOMAI 635 : SEGDES SNOMIN 636 : RETURN 637 : END 638 : 639 : 640 : 641 : 642 : 643 : 644 : 645 : 646 : 647 : 648 : 649 : 650 : 651 : 652 : 653 : 654 : 655 :
© Cast3M 2003 - All rights reserved.
Disclaimer